Compare commits

...
Author SHA1 Message Date
andy aa12f7d709 Merge trunk 2016-12-13 01:27:25 +00:00
andy a7909595ec Commit changes received from Brad Lanam via email 2016-12-12 04:42:52 +00:00
andy 0cd0bb6862 Avoid "warning: format '%llu' expects argument of type 'long long unsigned int', but argument 2 has type 'long unsigned int'" on platforms where TCL_WIDE_INT_IS_LONG. Warning introduced by check-in [e3ba334a42] which was merged to trunk by [eac13870dc]. This fix also was made by [418b169207] which has not yet been merged to trunk. 2016-12-02 21:08:15 +00:00
dgp 0714cd9321 Added long comment explaining history and work in progress making bytearray
interfaces usable.
2016-12-02 18:18:59 +00:00
dgp e9d4e1005e Relocate the cmdEpoch bumps during command deletion so that command resolution
caching works properly in deletion callbacks (destructors!) and delete traces.
2016-12-02 15:39:31 +00:00
jan.nijtmans 74c17b45b2 Implement %ll (WideInt) handling for Tcl_ObjPrintf(). Use it in some places. (now without edit-error in tcl.h, thanks Don!) 2016-12-02 14:52:11 +00:00
dgp c4e63fa109 Repair what appears to be a stray edit error. This restores ability to
build on a TCL_WIDE_INT_IS_LONG platform, but leaves code in tclStringObj.c
raising compiler warnings.  Suspect things still need some reconciliation
in the TCL_WIDE_INT_IS_LONG scenario.
2016-12-02 14:17:40 +00:00
jan.nijtmans ef88cbd89e Implement %ll (WideInt) handling for Tcl_ObjPrintf(). Use it in some places.
Moved to feature branch temporarily.  Breaks build.
2016-12-02 13:50:29 +00:00
dgp 674aeae3b0 Remove dup line. 2016-12-02 13:26:08 +00:00
dgp 72c1f925db Reports from NSF that command epoch bumping isn't properly timed.
http://paste.tclers.tk/4030
Since the epoch should bump to indicate when Tcl_FindCommand() would
produce a different result from the cached value, the bump ought to be
connected to the state change that would have that effect.  This checkin
appears to be the more correct answer, and it makes the Delete path get
into agreement with the Rename path.  Review would be good.
2016-12-01 20:13:10 +00:00
dgp e42f5d61b2 So long as we register only one, we can have multiple Tcl_ObjTypes with
the same name.  This smooths migration. See obj-2.2 and tclsqlite usage.
2016-12-01 17:25:40 +00:00
dgp a8e3472731 Created a new "proper bytearray" Tcl_ObjType so we can use bytearrays
as bytearrays without all this fussing about over purity.
2016-12-01 13:20:47 +00:00
jan.nijtmans 95d020a657 compatability -> compatibility 2016-12-01 11:44:23 +00:00
jan.nijtmans 6d7abfd8a9 compatability -> compatibility 2016-12-01 11:42:07 +00:00
jan.nijtmans bbaecb023a compatability -> compatibility 2016-12-01 11:39:40 +00:00
dgp c25e21b7bb Route all [string repeat] operations through a common implementation.
Code that to preserve bytearrays, eliminate unnecessary string rep
generation, increase efficiency, and encapsulate access to internal rep
details.
2016-11-30 03:08:24 +00:00
dgp 3489a76210 Where feasible, convert concatenation panics into errors. 2016-11-29 18:46:41 +00:00
jan.nijtmans 357515037a Minor simplifications. Eliminate FUNCPRT from regexp engine. Fix compile-error (non-debug) in tclDictObj.c, from previous commit 2016-11-29 13:03:15 +00:00
jan.nijtmans a435d9e14b more internal use of size_t (in stead of int) 2016-11-29 11:10:10 +00:00
jan.nijtmans df537d0dfb Eliminate some macros that are no longer used/needed. 2016-11-25 11:47:54 +00:00
andy 1000af34fa Allow [array names -regexp] to use backreferences. This capability was broken by [71270e9141]. See also bug [1366683]. 2016-11-25 07:31:46 +00:00
andy d37425bc05 Remove spurious article in comments 2016-11-25 01:39:13 +00:00
andy 5e9f624428 Partially backout [ef4da65408] because AppendPrintfToObjVA() (used indirectly by [tcl::unsupported::disassemble]) does not yet support wide and bignum arguments. This fixes a SIGSEGV in compile.test and makes [disassemble] work again. 2016-11-24 19:21:12 +00:00
dkf 7d753e316a Implementation of [array for] from Brad Lanam. See https://github.com/flightaware/Tcl-bounties/issues/12 for details. 2016-11-24 13:47:47 +00:00
jan.nijtmans c2f9601344 Make compileEpoch "unsigned int", and start counting at 1. 2016-11-24 13:33:32 +00:00
jan.nijtmans c8d9ab8790 typos 2016-11-24 10:26:28 +00:00
dkf f096df2170 Corrections to misleading comments. 2016-11-22 15:04:28 +00:00
jan.nijtmans 990d6fd6f1 More internal use of size_t in stead of int. 2016-11-21 10:15:24 +00:00
dkf da608f8c61 Minor: fix the indentation of comments. 2016-11-18 15:51:27 +00:00
jan.nijtmans c58016090f Fix mp_cnt_lsb() signature, so it matches the signature used in Tcl 2016-11-18 10:53:45 +00:00
jan.nijtmans e7f46501e2 Fix mp_cnt_lsb() signature, so it matches the signature used in Tcl. Add two missing "static" keywords in tclUnixNotfy.c. Remove some more files in libtommath directory which are not useful for Tcl. 2016-11-18 10:23:24 +00:00
jan.nijtmans 13a2801fd7 Fix [e6f27aa56fa51bfc1752ce768bf0d301c60bfd2c|e6f27aa56f]: Update libtommath to 1.0 2016-11-18 09:50:37 +00:00
andy 995aaf8bfd Remove extra space in documentation for [file stat] 2016-11-18 03:34:32 +00:00
jan.nijtmans d7da846591 Fix libtommath's mp_radix_size() function such that it returns 2 for single-digit numbers. Add testcases for mp_radix_size() and mp_iseven(). Undo useless change in bn_mp_add_d.c (bring back libtommath's version). 2016-11-17 16:26:50 +00:00
jan.nijtmans 2287394ba1 Fix libtommath's mp_radix_size() function such that it returns 2 for single-digit numbers. Add testcases for mp_radix_size() and mp_iseven(). Undo useless change in bn_mp_add_d.c (bring back libtommath's version). 2016-11-17 16:24:37 +00:00
jan.nijtmans 8d1caeae4d Fix libtommath's mp_radix_size() function such that it returns 2 for single-digit numbers. Add testcases for mp_radix_size() and mp_iseven(). Undo useless change in bn_mp_add_d.c (bring back libtommath's version). 2016-11-17 16:12:14 +00:00
jan.nijtmans 1be35f340f Restore bn_mp_radix_size.c to exact copy of libtommath-1.0 version: Since the radix_size of "9" should return 2, not 3. Add test-case to prove that. 2016-11-17 15:30:32 +00:00
jan.nijtmans ca471eb748 Restore bn_mp_add_d.c to exact copy of libtommath-1.0 version: Since the mp_clamp() function already restores the sign of it's argument to positive if c->used ==0, it is not necessary to do that twice. Therefore, the original version of the code is correct. 2016-11-17 13:18:17 +00:00
jan.nijtmans 538960215f Add test-case for mp_iseven(). If mp_iseven(0) ever returns 0, we will be warned that we are using the wrong mp_iseven() function. 2016-11-17 11:38:13 +00:00
jan.nijtmans 1375c96d2f Bring in fix for mp_iseven().... almost missed that .... This should be given a dedicated test-case. Now everything taken from "gahr-ticket-e6f27aa56f" branch is handled. 2016-11-17 11:03:39 +00:00
jan.nijtmans 8f07b4a94c Merge trunk. Re-generate tclTomMath.h. Use faster exponentiation-function from libtommath 1.0 (in tclExecute.c). 2016-11-17 10:46:09 +00:00
jan.nijtmans 2edb1dcd83 Remove subdirectories of "libtommath", and various individual related files, not taking any part in the Tcl build. Makes the Tcl distribution smaller without sacrificing anything.
And remove the TCL_TOMMATH define, which was never used for anything.
2016-11-17 09:33:08 +00:00
jan.nijtmans 37f6932c0a Remove subdirectories of "libtommath", and various individual related files, not taking any part in the Tcl build. Makes the Tcl distribution smaller without sacrificing anything. 2016-11-17 09:24:05 +00:00
jan.nijtmans 9e7c15f53e merge trunk 2016-11-16 15:59:40 +00:00
jan.nijtmans f850132635 (experimental) Upgrade to libtommath 1.0 (actually by merging all changes between libtommath 0.42.0 and 1.0). Still to be tested thourougly, before doing anything with it. 2016-11-16 15:22:26 +00:00
jan.nijtmans f10147dbfe import libtommath 1.0 2016-11-16 13:04:26 +00:00
jan.nijtmans 0dd529776d Use more "size_t" in stead of "int" internall. Also eliminate a lot of type-casts which are not necessary any more. 2016-11-16 10:55:40 +00:00
dkf ea1423a2ab See Itcl Bug [1b28657c0e]. Make methodNameType honor the Tcl_ObjType contract. 2016-11-15 13:33:35 +00:00
dkf 5b71bf5ea8 See Itcl Bug [1b28657c0e]. Make methodNameType honor the Tcl_ObjType contract. 2016-11-15 13:32:51 +00:00
dkf a5538d84c4 Slightly more efficient version as this is Hot Path code. 2016-11-15 13:31:02 +00:00
dgp addd1694e0 See Itcl Bug [1b28657c0e]. The methodNameType fails to honor the Tcl_ObjType
contract. Need dkf review on suitability of this fix.
2016-11-14 17:01:37 +00:00
jan.nijtmans 7cdd87e4f1 Merge core-8-6-branch 2016-11-14 14:26:38 +00:00
jan.nijtmans 0b9cb76206 Better fix for the usability of TCL_NO_DEPRECATED on MacOSX 2016-11-14 14:25:13 +00:00
jan.nijtmans 99fd1215e2 Better fix for the usability of TCL_NO_DEPRECATED on MacOSX. 2016-11-14 14:20:13 +00:00
venkat 6e380ef6e9 Merge tzdata2016i from IETF 2016-11-12 11:19:52 +00:00
venkat ae6e14e33c Merge tzdata2016i from IETF 2016-11-12 11:19:26 +00:00
venkat bc5ffbb3b2 Update to tzdata2016i from IETF 2016-11-12 11:18:31 +00:00
jan.nijtmans 92b58040dd Fix harmless gcc warning message: using "unsigned" doesn't serve any purpose, actually. 2016-11-11 14:53:58 +00:00
jan.nijtmans fcc907b2a6 Fix [79614fb8b61983ac8ef30ea8752c310465798fc7|79614fb8b6]: "glob", "encoding system" and encoding-free filesystems 2016-11-11 10:58:54 +00:00
jan.nijtmans 25ba428ff9 Fix [79614fb8b61983ac8ef30ea8752c310465798fc7|79614fb8b6]: "glob", "encoding system" and encoding-free filesystems 2016-11-11 10:55:45 +00:00
jan.nijtmans 2020e9be61 Fix [79614fb8b61983ac8ef30ea8752c310465798fc7|79614fb8b6]: "glob", "encoding system" and encoding-free filesystems 2016-11-11 10:53:10 +00:00
jan.nijtmans 6497c6c6ee On OSX, there is a conflict with the "define panic" and definitions in "mach.h". 2016-11-10 14:21:41 +00:00
jan.nijtmans 31647bcceb On OSX, there is a conflict with the "define panic" and definitions in "mach.h". 2016-11-10 14:19:28 +00:00
dgp 3555752d45 Route all [string last] operations through a common implementation. 2016-11-08 02:56:11 +00:00
dgp 37fb43ad48 Purge disabled code. 2016-11-07 20:18:30 +00:00
dgp cd2858d1d0 Refactor to channel all [string first] functions through a single implementation. 2016-11-07 20:11:11 +00:00
dgp 790b302275 Optimize case of all single-byte chars. 2016-11-07 20:04:22 +00:00
dgp dc11ffbbdb Consolidate the "find empty string" cases. 2016-11-07 19:41:15 +00:00
dgp 1571dc01bb Implement direct eval [string first] with the refactored engine. 2016-11-07 19:28:25 +00:00
dgp 4dc2505e43 First draft refactoring the [string first] functionality. 2016-11-04 21:29:30 +00:00
dgp 18a2ebc51d [824752f10e] Use LIST_MAX instead of INT_MAX for unknown number of elements to the end of the list. 2016-11-04 14:56:19 +00:00
dgp da3723c942 [8245752f10e] Use LIST_MAX instead of INT_MAX for unknown number of elements
to the end of the list.
2016-11-04 14:54:38 +00:00
dgp 27ef344b9c merge mark 2016-11-04 14:49:22 +00:00
dgp 885ced5608 [824752f10e] More robust, portable check for integer overflow. 2016-11-04 14:48:36 +00:00
dgp b1fe66323b close fork 2016-11-04 14:42:14 +00:00
dgp a188ceee21 [824752f10e] More robust, portable check for integer overflow. 2016-11-04 14:40:54 +00:00
dgp eb87ed60f6 close fork 2016-11-04 14:39:00 +00:00
dgp bc94a394c9 [824752f10e] More robust, portable check for integer overflow. 2016-11-04 14:37:50 +00:00
gahr 46d871617f merge core-8-5-branch ([824752f10e] Avoid calling Tcl_SetObjResult if interp is NULL) 2016-11-04 14:24:42 +00:00
gahr d654ce6429 merge core-8-5-branch ([824752f10e] Avoid calling Tcl_SetObjResult if interp is NULL) 2016-11-04 14:23:43 +00:00
gahr 452f14ebb5 [824752f10e] Avoid calling Tcl_SetObjResult if interp is NULL 2016-11-04 14:21:04 +00:00
jan.nijtmans 0a7d5ef6ed Fix the generated copyright sections in the HTML help file 2016-11-04 11:51:22 +00:00
jan.nijtmans f785a01764 Fix the generated copyright sections in the HTML help file. 2016-11-04 11:50:22 +00:00
jan.nijtmans 274f081025 Make packages msgcat and tcltest work unmodified in "novem". Make more test-cases work unmodified in "novem". 2016-11-04 11:38:09 +00:00
jan.nijtmans 76ed3d5b55 Make packages msgcat and tcltest work unmodified in "novem". 2016-11-04 11:32:44 +00:00
jan.nijtmans fba10e8615 merge core-8-6-branch (http package version update) 2016-11-02 12:45:47 +00:00
jan.nijtmans 1f0c1b800d Update http version number to 2.8.10, due to [838e99a76d] 2016-11-02 12:44:32 +00:00
jan.nijtmans a7e97de50a Update http version number to 2.7.14, due to [838e99a76d] 2016-11-02 12:41:04 +00:00
Joe Mistachkin ea11870f5b Fix the generated copyright sections in the HTML help file. 2016-11-02 01:42:49 +00:00
dgp 95b511bac2 Refactor to channel all [string cat] functions through a single implementation. 2016-11-01 16:18:08 +00:00
dgp 17e1ea228c Replace indexing with pointer increments. 2016-11-01 15:42:50 +00:00
dgp 53abdcc518 Trim away obsolete code. 2016-11-01 15:12:07 +00:00
dgp d963b1acb7 Expand all the cases of the [string cat] engine. 2016-11-01 15:07:30 +00:00
dgp 04432d4dd1 Reduce copies in the pure binary implementation of [string cat]. 2016-10-31 18:10:21 +00:00
dgp 3e4f5907b6 Complete the "pure binary" implementation of the [string cat] engine. 2016-10-31 16:15:16 +00:00
dgp 4a159c5199 merge trunk 2016-10-31 14:18:03 +00:00
dgp b53cf6d38c Coverage tests for INST_STR_CONCAT1 byterarray ops. 2016-10-31 14:17:31 +00:00
dkf 779b8dad76 [253ba6e818] Improved description of [variable] behaviour. 2016-10-30 16:52:50 +00:00
dkf cd428c1a44 [253ba6e818] Improved description of [variable] behaviour. 2016-10-30 16:16:29 +00:00
dkf 16dbe3f5a2 [1ae12987cb] Ensure that deleting the [history] command deletes its storage. 2016-10-30 08:31:21 +00:00
dkf 7b989f0312 [1ae12987cb] Ensure that deleting the [history] command deletes its storage. 2016-10-30 08:22:13 +00:00
dkf 994e1d8062 One more place where the internal API change can be used easily. 2016-10-30 05:07:47 +00:00
dkf de8e3be492 [b26e38a3e4] Ensure that compressing streams manage buffers correctly in all cases. 2016-10-30 05:05:46 +00:00
dkf d44a63b65b [b26e38a3e4] Ensure that compressing streams manage buffers correctly in all cases. 2016-10-30 05:04:54 +00:00
dkf 423d995e0d Fix the bug. Make use of zlib API in this area more like a Tcl API with wrapper function. 2016-10-30 05:02:46 +00:00
dkf 5c37d95180 Added test for bug 2016-10-29 21:03:25 +00:00
dgp 970922295a WIP 2016-10-28 20:33:55 +00:00
dgp 31690ce7fb revise [dict append] to make use of common [string cat] engine. 2016-10-28 16:55:44 +00:00
dgp 630d4b9211 merge trunk 2016-10-28 15:47:07 +00:00
dgp 7faf4f27a4 Add optimization to [dict append]. 2016-10-28 15:46:49 +00:00
dgp dd1c28a788 When appropriate, implement [join] with the common [string cat] engine. 2016-10-28 14:59:27 +00:00
dgp afd6d5649f Add obvious optimizations to [join] implementation. 2016-10-28 14:45:54 +00:00
dgp e9d7b07476 merge trunk 2016-10-28 14:28:40 +00:00
dgp b8ffbb14c4 Add warning commentary making important assumptions explicit. 2016-10-28 14:27:59 +00:00
dgp 39dbbd57af Add warning commentary making important assumptions explicit. 2016-10-28 14:26:18 +00:00
dgp bbfc83c86f Add warning commentary making important assumptions explicit. 2016-10-28 14:23:25 +00:00
dgp d31beb3e7f merge trunk 2016-10-28 14:06:36 +00:00
dgp aa3b157338 Add obvious optimization to Tcl_GetCharLength(). 2016-10-28 14:06:15 +00:00
dgp bf27b64405 Convert INST_STR_CONCAT1 to the common string cat implementation. 2016-10-27 20:06:36 +00:00
dgp 76b6b03be7 Start bringing all string cat operations into one place so it can be coded
correctly one time instead of badly multiple times.
2016-10-27 19:39:49 +00:00
venkat c205f272f7 Merge timezone data tzdata2016h 2016-10-26 08:04:36 +00:00
venkat 0551ecffd6 Merge timezone data tzdata2016h 2016-10-26 08:04:10 +00:00
venkat 13967f965d Update timezone data to tzdata2016h from IETF 2016-10-26 08:03:17 +00:00
dgp 79ff282b02 merge 8.6 2016-10-21 13:12:16 +00:00
dgp 9afdf28497 Repair recently opened memleak. 2016-10-20 20:02:19 +00:00
dgp bfae5bf492 EVIL HACKs are bad. Unnecessary ones are intolerable. Bad tests cause trouble. 2016-10-20 17:54:47 +00:00
dgp 925bd5794e Use memcmp where possible. 2016-10-18 19:16:35 +00:00
dgp ae54e070a1 [eb6b68c1a9] Simple fix for [string replace] error demonstrated by new test. 2016-10-14 19:29:52 +00:00
dgp 8b894ab295 [eb6b68c1a9] Simple fix for [string replace] error demonstrated by new test. 2016-10-14 19:28:46 +00:00
dgp e35292f314 Merge INST_STR_REPLACE fixes and improvements. 2016-10-13 16:56:23 +00:00
dgp 7f0e6652c7 Another streamline. 2016-10-13 16:50:06 +00:00
dgp 7634bdaef2 Stop invading the String internals to work around a bug. Fix it instead. 2016-10-13 16:43:05 +00:00
dgp 9cb330963b Streamline the substring copying case of [string replace] bytecode execution. 2016-10-13 15:37:45 +00:00
dgp 4dc1a8a588 merge TclParseNumber fixes 2016-10-12 13:47:32 +00:00
dgp 66f257a588 [be003d570f] TclParseNumber() failed to fully implement TCL_PARSE_BINARY_ONLY. 2016-10-12 13:46:14 +00:00
dgp 36825d23b9 [be003d570f] TclParseNumber() failed to fully implement TCL_PARSE_OCTAL_ONLY. 2016-10-12 13:42:40 +00:00
dgp 326e0a8fdf Add a test too. 2016-10-12 13:38:28 +00:00
dgp 29fdaa6dcd [be003d570f] TclParseNumber() failed to fully implement TCL_PARSE_OCTAL_ONLY. 2016-10-12 13:31:07 +00:00
dkf ae0ad313fd [74bc0e44f5] Doc tweak. 2016-10-12 09:58:12 +00:00
dkf ec64cc0418 [74bc0e44f5] Doc tweak. 2016-10-12 09:57:49 +00:00
dkf c482675d84 [74bc0e44f5] Doc tweak. 2016-10-12 09:57:15 +00:00
jan.nijtmans 7dd13b72b6 Fix [3cc1d91345]: duplicate calls to TclpFreeAllocCache() on thread exists 2016-10-11 21:52:57 +00:00
jan.nijtmans 54c0881e9d Fix [3cc1d91345]: duplicate calls to TclpFreeAllocCache() on thread exists 2016-10-11 21:43:44 +00:00
jan.nijtmans d81daf76bd Fix [3cc1d91345]: duplicate calls to TclpFreeAllocCache() on thread exists 2016-10-11 21:35:27 +00:00
dkf 11e9b6a9a5 [62b36e326c] Noted edge case in behaviour of [concat] with empty arguments. 2016-10-09 16:02:38 +00:00
dkf 8fe7f3fcdf [62b36e326c] Noted edge case in behaviour of [concat] with empty arguments. 2016-10-09 16:02:16 +00:00
dkf f3e9f9caa3 [62b36e326c] Noted edge case in behaviour of [concat] with empty arguments. 2016-10-09 16:01:53 +00:00
dkf 28d5ff4eb5 [7114ac6141] Improve testing and docs of Tcl_GetInt and Tcl_GetDouble. No behaviour change. 2016-10-09 15:22:20 +00:00
dkf 71c2d1a883 [7114ac6141] Improve testing and docs of Tcl_GetInt and Tcl_GetDouble. No behaviour change. 2016-10-09 15:21:26 +00:00
dkf c8597887e4 Be more accurate about scan's %i 2016-10-09 12:03:30 +00:00
ferrieux 05009534ee Be more accurate about scan's %i 2016-10-09 10:35:24 +00:00
dkf f50a4eed54 [74bc0e44f5] Document result of [http::unregister]. 2016-10-08 17:10:40 +00:00
dkf 90813dfce8 [74bc0e44f5] Document result of [http::unregister]. 2016-10-08 17:10:21 +00:00
dkf a16868a54c [74bc0e44f5] Document result of [http::unregister]. 2016-10-08 17:10:02 +00:00
dkf c4eac3e8eb [838e99a76d] Ensure that encodings are handled with application/xml and friends. 2016-10-08 16:41:51 +00:00
dkf 7b78869343 [838e99a76d] Ensure that encodings are handled with application/xml and friends. 2016-10-08 16:40:35 +00:00
dkf ab8a39e6b9 [838e99a76d] Ensure that encodings are handled with application/xml and friends. 2016-10-08 16:38:42 +00:00
dgp 870f61c05d Update [string map] tests to get illustration of need for pure dict
restriction up to date with ordered dicts.
2016-10-07 18:52:57 +00:00
pooryorick 6585306973 Fix typos in expr documentation. 2016-10-05 04:53:49 +00:00
pooryorick b1d510f1db Rewrite expr documentation. Among other things, fixes [ef5373e6fa0617ee]. 2016-10-05 00:05:55 +00:00
dkf 111f52e7ed [4d5ae7d88a] Stop crashes with asynchronous connects to hosts without addresses. 2016-10-04 19:12:33 +00:00
dkf 6548fc4ad1 [4d5ae7d88a] Stop crashes with asynchronous connects to hosts without addresses. 2016-10-04 19:11:07 +00:00
max a629b0ba31 When opening a server socket on an ephemeral port, make sure that the
port number that gets picked for IPv4 is also available on IPv6. If
not, start all over for up to ten times to find a port number that is
available on both protocols.
2016-10-04 13:31:49 +00:00
jan.nijtmans 29b9de871c (cherry-pick): Fix [2bf561854c55a], interp alias to command whose name is the empty string. 2016-10-03 14:53:32 +00:00
gahr c4f7e08fc6 [4d5ae7d88a] Restore default-to-error logic in TcpConnect 2016-09-27 20:06:49 +00:00
gahr ed326ae9b5 Merge trunk 2016-06-10 12:10:41 +00:00
gahr 99ac77fd22 [e6f27aa56f] Add files I missed in my previous commit 2016-03-13 17:23:31 +00:00
gahr 32d41dcbb5 [e6f27aa56f] Initial import of libtommath-1.0
This commit brings in libtommath-1.0, as of tag v1.0 of the upstream repository
at https://github.com/libtom/libtommath.

Only the top-level directory has been imported: the demo, etc, logs, mtest,
pics, pre_gen, and tombc directories have been removed from our repo.

The stubs tables have been regenerated to accomodate for the new function:
mp_expt_d_ex(mp_int *a, mp_digit b, mp_int *c, int fast);
See https://github.com/libtom/libtommath/commit/e9b1837 for details.

Only the unix build system has been modified for now. Windows and Mac OSX will
come later.
2016-03-11 17:13:38 +00:00
jan.nijtmans a3eb84e8cb Import of tommath 0.42.0 2011-03-14 12:08:07 +00:00
jan.nijtmans d5b999af66 Import of libtommath 0.41
Import of libtommath 0.41
2011-03-14 11:59:15 +00:00
jan.nijtmans 4878f1b6a4 Import of libtommath 0.40 2011-03-14 11:51:58 +00:00
jan.nijtmans c5e0f27a28 re-import ltm-0.39, with original RCS-ID's 2011-03-14 09:36:26 +00:00
340 changed files with 16707 additions and 44812 deletions
+16
View File
@@ -17,6 +17,22 @@
*/tclsh*
*/tcltest*
*/versions.vc
libtommath/bn.ilg
libtommath/bn.ind
libtommath/pretty.build
libtommath/tommath.src
libtommath/*.pdf
libtommath/*.pl
libtommath/*.sh
libtommath/tombc/*
libtommath/pre_gen/*
libtommath/pics/*
libtommath/mtest/*
libtommath/logs/*
libtommath/etc/*
libtommath/demo/*
libtommath/*.out
libtommath/*.tex
unix/autoMkindex.tcl
unix/dltest.marker
unix/tcl.pc
+1 -1
View File
@@ -414,7 +414,7 @@
Tcl_IsChannelExisting, and Tcl_ClearChannelHandlers to conform to the
new stacked channel implementation. Their stub slots were also moved
to give preference to the new 8.3.2 stub functions. This will cause an
incompatability with 8.4a1 only.
incompatibility with 8.4a1 only.
(StopCopy): fixed a bug introduced by a partial fix in 8.3.2 that
didn't set nonBlocking correctly when resetting the flags for the
write side. [Bug: 6261]
+3 -3
View File
@@ -847,7 +847,7 @@
exit.
* tests/exec.test: marked exec-18.1 unixOnly until the Windows
incompatability (in the test, not the core) can be resolved.
incompatibility (in the test, not the core) can be resolved.
* tests/http.test (http-3.11): added close $fp that was causing an
error on Windows because the file was not closed before deleting.
@@ -3642,7 +3642,7 @@
* compat/strtoll.c (strtoll):
* compat/strtoull.c (strtoull):
* unix/tclUnixPort.h:
* win/tclWinPort.h: Const-ing 64-bit compatability declarations. Note
* win/tclWinPort.h: Const-ing 64-bit compatibility declarations. Note
that the return pointer is non-const because it is entirely legal for
the functions to be called from somewhere that owns the string being
passed. Fixes problem reported by Larry Virden.
@@ -3779,7 +3779,7 @@
There are a lot of changes from this TIP, so please see
http://purl.org/tcl/tip/72.html for discussion of
backward-compatability issues, but the main ones modifications are in:
backward-compatibility issues, but the main ones modifications are in:
* generic/tcl.h: New types.
* generic/tcl.decls: New public functions.
+2 -2
View File
@@ -947,7 +947,7 @@
declarations match and will end up using the declarations in the
public code from now on because of #include ordering. Keeping the old
declarations in tclInt.decls; there's no need to gratuitously break
compatability for those extensions which are already clients of the
compatibility for those extensions which are already clients of the
namespace code.
2003-08-23 Zoran Vasiljevic <zoran@archiwrae.com>
@@ -1278,7 +1278,7 @@
* generic/tclVar.c (Tcl_ArrayObjCmd, TclArraySet): Made [array get]
and [array set] work with dictionaries, producing them and consuming
them. Note that for compatability reasons, you will never get a dict
them. Note that for compatibility reasons, you will never get a dict
from feeding a string literal to [array set] since that alters the
trace behaviour of "multi-key" sets. [Bug 759935]
+1 -1
View File
@@ -1356,7 +1356,7 @@
2004-10-07 Donal K. Fellows <donal.k.fellows@man.ac.uk>
* *.3: Convert CONST to const and VOID to void so we document how
people should actually use the Tcl API and not the compatability hacks
people should actually use the Tcl API and not the compatibility hacks
that it has to have.
* doc/man.macros, *.3: Update .AS macro so it can know how wide to
+1 -1
View File
@@ -106,5 +106,5 @@ closedir(
close(dirp->dd_fd);
dirp->dd_fd = -1;
dirp->dd_loc = 0;
ckfree((char *) dirp);
ckfree(dirp);
}
+1 -1
View File
@@ -100,7 +100,7 @@ waitpid(
} else {
prevPtr->nextPtr = waitPtr->nextPtr;
}
ckfree((char *) waitPtr);
ckfree(waitPtr);
return result;
}
+23 -8
View File
@@ -51,27 +51,42 @@ in the interpreter's result, and nothing is stored at *\fIintPtr\fR
or *\fIdoublePtr\fR or *\fIboolPtr\fR.
.PP
\fBTcl_GetInt\fR expects \fIsrc\fR to consist of a collection
of integer digits, optionally signed and optionally preceded by
white space. If the first two characters of \fIsrc\fR
of integer digits, optionally signed and optionally preceded and
followed by white space. If the first two characters of \fIsrc\fR
after the optional white space and sign are
.QW 0x
.QW \fB0x\fR
then \fIsrc\fR is expected to be in hexadecimal 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
.QW \fB0b\fR
then \fIsrc\fR is expected to be in binary form; otherwise,
if the first such character is
.QW 0
.QW \fB0\fR
then \fIsrc\fR
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
decimal point; a sequence of digits; the letter
.QW e ;
decimal point
.QW \fB.\fR ;
a sequence of digits; the letter
.QW \fBe\fR ;
a signed decimal exponent; and more white space.
Any of the fields may be omitted, except that
the digits either before or after the decimal point must be present
and if the
.QW e
is present then it must be followed by the exponent number.
.QW \fBe\fR
is present then it must be followed by the exponent number. If there
are no fields apart from the sign and initial sequence of digits
(i.e., no decimal point or exponent indicator), that
initial sequence of digits should take one of the forms that
\fBTcl_GetInt\fR supports, described above. The use of
.QW \fB,\fR
as a decimal point is not supported nor should any other sort of
inter-digit separator be present.
.PP
\fBTcl_GetBoolean\fR expects \fIsrc\fR to specify a boolean
value. If \fIsrc\fR is any of \fB0\fR, \fBfalse\fR,
+7
View File
@@ -47,6 +47,13 @@ been the return value from a previous invocation of
Returns 1 if \fIarrayName\fR is an array variable, 0 if there
is no variable by that name or if it is a scalar variable.
.TP
\fBarray for {\fIkeyVariable ?valueVariable?\fB} \fIarrayName body\fR
The first argument is a one or two element list of variable names for the
key and value of each entry in the array. The second argument is the
array name to iterate over. The third argument is the body to execute
for each key and value returned.
The ordering of the returned keys is undefined.
.TP
\fBarray get \fIarrayName\fR ?\fIpattern\fR?
Returns a list containing pairs of elements. The first
element in each pair is the name of an element in \fIarrayName\fR
+1
View File
@@ -20,6 +20,7 @@ This command joins each of its arguments together with spaces after
trimming leading and trailing white-space from each of them. If all of the
arguments are lists, this has the same effect as concatenating them
into a single list.
Arguments that are empty (after trimming) are ignored entirely.
It permits any number of arguments;
if no \fIarg\fRs are supplied, the result is an empty string.
.SH EXAMPLES
+171 -214
View File
@@ -17,14 +17,14 @@ expr \- Evaluate an expression
.BE
.SH DESCRIPTION
.PP
Concatenates \fIarg\fRs (adding separator spaces between them),
evaluates the result as a Tcl expression, and returns the value.
The operators permitted in Tcl expressions include a subset of
Concatenates \fIarg\fRs, separated by a space, into an expression, and evaluates
that expression, returning its value.
The operators permitted in an expression include a subset of
the operators permitted in C expressions. For those operators
common to both Tcl and C, Tcl applies the same meaning and precedence
as the corresponding C operators.
Expressions almost always yield numeric results
(integer or floating-point values).
The value of an expression is often a numeric result, either an integer or a
floating-point value, but may also be a non-numeric value.
For example, the expression
.PP
.CS
@@ -32,78 +32,68 @@ For example, the expression
.CE
.PP
evaluates to 14.2.
Tcl expressions differ from C expressions in the way that
operands are specified. Also, Tcl expressions support
non-numeric operands and string comparisons, as well as some
Expressions differ from C expressions in the way that
operands are specified. Expressions also support
non-numeric operands, string comparisons, and some
additional operators not found in C.
.PP
When an expression evaluates to an integer, the value is the decimal form of
the integer, and when an expression evaluates to a floating-point number, the
value is the form produced by the \fB%g\fR format specifier of Tcl's
\fBformat\fR command.
.SS OPERANDS
.PP
A Tcl expression consists of a combination of operands, operators,
parentheses and commas.
White space may be used between the operands and operators and
parentheses (or commas); it is ignored by the expression's instructions.
Where possible, operands are interpreted as integer values.
Integer values may be specified in decimal (the normal case), in binary
(if the first two characters of the operand are \fB0b\fR), in octal
(if the first two characters of the operand are \fB0o\fR), or in hexadecimal
(if the first two characters of the operand are \fB0x\fR). For
compatibility with older Tcl releases, an octal integer value is also
indicated simply when the first character of the operand is \fB0\fR,
whether or not the second character is also \fBo\fR.
If an operand does not have one of the integer formats given
above, then it is treated as a floating-point number if that is
possible. Floating-point numbers may be specified in any of several
common formats making use of the decimal digits, the decimal point \fB.\fR,
the characters \fBe\fR or \fBE\fR indicating scientific notation, and
the sign characters \fB+\fR or \fB\-\fR. For example, all of the
following are valid floating-point numbers: 2.1, 3., 6e4, 7.91e+16.
Also recognized as floating point values are the strings \fBInf\fR
and \fBNaN\fR making use of any case for each character.
If no numeric interpretation is possible (note that all literal
operands that are not numeric or boolean must be quoted with either
braces or with double quotes), then an operand is left as a string
(and only a limited set of operators may be applied to it).
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
(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
compatibility with older Tcl releases, an operand that begins with \fB0\fR is
interpreted as an octal integer even if the second character is not \fBo\fR.
A floating-point number may be specified in any of several
common decimal formats, and may use the decimal point \fB.\fR,
\fBe\fR or \fBE\fR for scientific notation, and
the sign characters \fB+\fR and \fB\-\fR. The
following are all valid floating-point numbers: 2.1, 3., 6e4, 7.91e+16.
The strings \fBInf\fR
and \fBNaN\fR, in any combination of case, are also recognized as floating point
values. An operand that doesn't have a numeric interpretation must be quoted
with either braces or with double quotes.
.PP
Operands may be specified in any of the following ways:
An operand may be specified in any of the following ways:
.IP [1]
As a numeric value, either integer or floating-point.
.IP [2]
As a boolean value, using any form understood by \fBstring is\fR
\fBboolean\fR.
.IP [3]
As a Tcl variable, using standard \fB$\fR notation.
The variable's value will be used as the operand.
As a variable, using standard \fB$\fR notation.
The value of the variable is then the value of the operand.
.IP [4]
As a string enclosed in double-quotes.
The expression parser will perform backslash, variable, and
command substitutions on the information between the quotes,
and use the resulting value as the operand
Backslash, variable, and command substitution are performed as described in
\fBTcl\fR.
.IP [5]
As a string enclosed in braces.
The characters between the open brace and matching close brace
will be used as the operand without any substitutions.
The operand is treated as a braced value as described in \fBTcl\fR.
.IP [6]
As a Tcl command enclosed in brackets.
The command will be executed and its result will be used as
the operand.
Command substitution is performed as described in \fBTcl\fR.
.IP [7]
As a mathematical function whose arguments have any of the above
forms for operands, such as \fBsin($x)\fR. See \fBMATH FUNCTIONS\fR below for
As a mathematical function such as \fBsin($x)\fR, whose arguments have any of the above
forms for operands. See \fBMATH FUNCTIONS\fR below for
a discussion of how mathematical functions are handled.
.PP
Where the above substitutions occur (e.g. inside quoted strings), they
are performed by the expression's instructions.
However, the command parser may already have performed one round of
substitution before the expression processor was called.
As discussed below, it is usually best to enclose expressions
in braces to prevent the command parser from performing substitutions
on the contents.
Because \fBexpr\fR parses and performs substitutions on values that have
already been parsed and substituted by \fBTcl\fR, it is usually best to enclose
expressions in braces to avoid the first round of substitutions by
\fBTcl\fR.
.PP
For some examples of simple expressions, suppose the variable
\fBa\fR has the value 3 and
the variable \fBb\fR has the value 6.
Then the command on the left side of each of the lines below
will produce the value on the right side of the line:
Below are some examples of simple expressions where the value of \fBa\fR is 3
and the value of \fBb\fR is 6. The command on the left side of each line
produces the value on the right side.
.PP
.CS
.ta 6c
@@ -114,34 +104,41 @@ will produce the value on the right side of the line:
.CE
.SS OPERATORS
.PP
The valid operators (most of which are also available as commands in
the \fBtcl::mathop\fR namespace; see the \fBmathop\fR(n) manual page
for details) are listed below, grouped in decreasing order of precedence:
For operators having both a numeric mode and a string mode, the numeric mode is
chosen when all operands have a numeric interpretation. The integer
interpretation of an operand is preferred over the floating-point
interpretation. To ensure string operations on arbitrary values it is generally a
good idea to use \fBeq\fR, \fBne\fR, or the \fBstring\fR command instead of
more versatile operators such as \fB==\fR.
.PP
Unless otherwise specified, operators accept non-numeric operands. The value
of a boolean operation is 1 if true, 0 otherwise. See also \fBstring is\fR
\fBboolean\fR. The valid operators, most of which are also available as
commands in the \fBtcl::mathop\fR namespace (see \fBmathop\fR(n)), are listed
below, grouped in decreasing order of precedence:
.TP 20
\fB\-\0\0+\0\0~\0\0!\fR
.
Unary minus, unary plus, bit-wise NOT, logical NOT. None of these operators
may be applied to string operands, and bit-wise NOT may be
applied only to integers.
Unary minus, unary plus, bit-wise NOT, logical NOT. These operators
may only be applied to numeric operands, and bit-wise NOT may only be
applied to integers.
.TP 20
\fB**\fR
.
Exponentiation. Valid for any numeric operands.
Exponentiation. Valid for numeric operands.
.TP 20
\fB*\0\0/\0\0%\fR
.
Multiply, divide, remainder. None of these operators may be
applied to string operands, and remainder may be applied only
to integers.
The remainder always has the same sign as the divisor and
an absolute value smaller than the absolute value of the divisor.
Multiply and divide, which are valid for numeric operands, and remainder, which
is valid for integers. The remainder, an absolute value smaller than the
absolute value of the divisor, has the same sign as the divisor.
.RS
.PP
When applied to integers, the division and remainder operators can be
considered to partition the number line into a sequence of equal-sized
adjacent non-overlapping pieces where each piece is the size of the divisor;
the division result identifies which piece the dividend lies within, and the
remainder result identifies where within that piece the dividend lies. A
When applied to integers, division and remainder can be
considered to partition the number line into a sequence of
adjacent non-overlapping pieces, where each piece is the size of the divisor;
the quotient identifies which piece the dividend lies within, and the
remainder identifies where within that piece the dividend lies. A
consequence of this is that the result of
.QW "-57 \fB/\fR 10"
is always -6, and the result of
@@ -151,177 +148,157 @@ is always 3.
.TP 20
\fB+\0\0\-\fR
.
Add and subtract. Valid for any numeric operands.
Add and subtract. Valid for numeric operands.
.TP 20
\fB<<\0\0>>\fR
.
Left and right shift. Valid for integer operands only.
Left and right shift. Valid for integers.
A right shift always propagates the sign bit.
.TP 20
\fB<\0\0>\0\0<=\0\0>=\fR
.
Boolean less, greater, less than or equal, and greater than or equal.
Each operator produces 1 if the condition is true, 0 otherwise.
These operators may be applied to strings as well as numeric operands,
in which case string comparison is used.
Boolean less than, greater than, less than or equal, and greater than or equal.
.TP 20
\fB==\0\0!=\fR
.
Boolean equal and not equal. Each operator produces a zero/one result.
Valid for all operand types.
Boolean equal and not equal.
.TP 20
\fBeq\0\0ne\fR
.
Boolean string equal and string not equal. Each operator produces a
zero/one result. The operand types are interpreted only as strings.
Boolean string equal and string not equal.
.TP 20
\fBin\0\0ni\fR
.
List containment and negated list containment. Each operator produces
a zero/one result and treats its first argument as a string and its
second argument as a Tcl list. The \fBin\fR operator indicates
whether the first argument is a member of the second argument list;
the \fBni\fR operator inverts the sense of the result.
List containment and negated list containment. The first argument is
interpreted as a string, the second as a list. \fBin\fR tests for membership
in the list, and \fBni\fR is the inverse.
.TP 20
\fB&\fR
.
Bit-wise AND. Valid for integer operands only.
Bit-wise AND. Valid for integer operands.
.TP 20
\fB^\fR
.
Bit-wise exclusive OR. Valid for integer operands only.
Bit-wise exclusive OR. Valid for integer operands.
.TP 20
\fB|\fR
.
Bit-wise OR. Valid for integer operands only.
Bit-wise OR. Valid for integer operands.
.TP 20
\fB&&\fR
.
Logical AND. Produces a 1 result if both operands are non-zero,
0 otherwise.
Valid for boolean and numeric (integers or floating-point) operands only.
Logical AND. If both operands are true, the result is 1, or 0 otherwise.
.TP 20
\fB||\fR
.
Logical OR. Produces a 0 result if both operands are zero, 1 otherwise.
Valid for boolean and numeric (integers or floating-point) operands only.
Logical OR. If both operands are false, the result is 0, or 1 otherwise.
.TP 20
\fIx\fB?\fIy\fB:\fIz\fR
.
If-then-else, as in C. If \fIx\fR
evaluates to non-zero, then the result is the value of \fIy\fR.
Otherwise the result is the value of \fIz\fR.
The \fIx\fR operand must have a boolean or numeric value.
If-then-else, as in C. If \fIx\fR is false , the result is the value of
\fIy\fR. Otherwise the result is the value of \fIz\fR.
.PP
See the C manual for more details on the results
produced by each operator.
The exponentiation operator promotes types like the multiply and
divide operators, and produces a result that is the same as the output
of the \fBpow\fR function (after any type conversions.)
All of the binary operators but exponentiation group left-to-right
within the same precedence level; exponentiation groups right-to-left. For example, the command
The exponentiation operator promotes types in the same way that the multiply
and divide operators do, and the result is is the same as the result of
\fBpow\fR.
Exponentiation groups right-to-left within a precedence level. Other binary
operators group left-to-right. For example, the value of
.PP
.CS
\fBexpr\fR {4*2 < 7}
.CE
.PP
returns 0, while
is 0, while the value of
.PP
.CS
\fBexpr\fR {2**3**2}
.CE
.PP
returns 512.
is 512.
.PP
The \fB&&\fR, \fB||\fR, and \fB?:\fR operators have
As in C, \fB&&\fR, \fB||\fR, and \fB?:\fR feature
.QW "lazy evaluation" ,
just as in C, which means that operands are not evaluated if they are
not needed to determine the outcome. For example, in the command
which means that operands are not evaluated if they are
not needed to determine the outcome. For example, in
.PP
.CS
\fBexpr\fR {$v ? [a] : [b]}
.CE
.PP
only one of
.QW \fB[a]\fR
or
.QW \fB[b]\fR
will actually be evaluated,
depending on the value of \fB$v\fR. Note, however, that this is
only true if the entire expression is enclosed in braces; otherwise
the Tcl parser will evaluate both
.QW \fB[a]\fR
and
.QW \fB[b]\fR
before invoking the \fBexpr\fR command.
only one of \fB[a]\fR or \fB[b]\fR is evaluated,
depending on the value of \fB$v\fR. This is not true of the normal Tcl parser,
so it is normally recommended to enclose the arguments to \fBexpr\fR in braces.
Without braces, as in
\fBexpr\fR $v ? [a] : [b]
both \fB[a]\fR and \fB[b]\fR are evaluated before \fBexpr\fR is even called.
.PP
For more details on the results
produced by each operator, see the documentation for C.
.SS "MATH FUNCTIONS"
.PP
When the expression parser encounters a mathematical function
such as \fBsin($x)\fR, it replaces it with a call to an ordinary
Tcl function in the \fBtcl::mathfunc\fR namespace. The processing
of an expression such as:
A mathematical function such as \fBsin($x)\fR is replaced with a call to an ordinary
Tcl command in the \fBtcl::mathfunc\fR namespace. The evaluation
of an expression such as
.PP
.CS
\fBexpr\fR {sin($x+$y)}
.CE
.PP
is the same in every way as the processing of:
is the same in every way as the evaluation of
.PP
.CS
\fBexpr\fR {[tcl::mathfunc::sin [\fBexpr\fR {$x+$y}]]}
.CE
.PP
which in turn is the same as the processing of:
which in turn is the same as the evaluation of
.PP
.CS
tcl::mathfunc::sin [\fBexpr\fR {$x+$y}]
.CE
.PP
The executor will search for \fBtcl::mathfunc::sin\fR using the usual
rules for resolving functions in namespaces. Either
\fB::tcl::mathfunc::sin\fR or \fB[namespace
current]::tcl::mathfunc::sin\fR will satisfy the request, and others
may as well (depending on the current \fBnamespace path\fR setting).
\fBtcl::mathfunc::sin\fR is resolved as described in
\fBNAMESPACE RESOLUTION\fR in the \fBnamespace\fR(n) documentation. Given the
default value of \fBnamespace path\fR, \fB[namespace
current]::tcl::mathfunc::sin\fR or \fB::tcl::mathfunc::sin\fR are the typical
resolutions.
.PP
Some mathematical functions have several arguments, separated by commas like in C. Thus:
As in C, a mathematical function may accept multiple arguments separated by commas. Thus,
.PP
.CS
\fBexpr\fR {hypot($x,$y)}
.CE
.PP
ends up as
becomes
.PP
.CS
tcl::mathfunc::hypot $x $y
.CE
.PP
See the \fBmathfunc\fR(n) manual page for the math functions that are
See the \fBmathfunc\fR(n) documentation for the math functions that are
available by default.
.SS "TYPES, OVERFLOW, AND PRECISION"
.PP
All internal computations involving integers are done calling on the
LibTomMath multiple precision integer library as required so that all
integer calculations are performed exactly. Note that in Tcl releases
prior to 8.5, integer calculations were performed with one of the C types
When needed to guarantee exact performance, internal computations involving
integers use the LibTomMath multiple precision integer library. In Tcl releases
prior to 8.5, integer calculations were performed using one of the C types
\fIlong int\fR or \fITcl_WideInt\fR, causing implicit range truncation
in those calculations where values overflowed the range of those types.
Any code that relied on these implicit truncations will need to explicitly
add \fBint()\fR or \fBwide()\fR function calls to expressions at the points
where such truncation is required to take place.
Any code that relied on these implicit truncations should instead call
\fBint()\fR or \fBwide()\fR, which do truncate.
.PP
All internal computations involving floating-point are
done with the C type \fIdouble\fR.
When converting a string to floating-point, exponent overflow is
Internal floating-point computations are
performed using the \fIdouble\fR C type.
When converting a string to floating-point value, exponent overflow is
detected and results in the \fIdouble\fR value of \fBInf\fR or
\fB\-Inf\fR as appropriate. Floating-point overflow and underflow
are detected to the degree supported by the hardware, which is generally
pretty reliable.
fairly reliable.
.PP
Conversion among internal representations for integer, floating-point,
and string operands is done automatically as needed.
For arithmetic computations, integers are used until some
floating-point number is introduced, after which floating-point is used.
For example,
Conversion among internal representations for integer, floating-point, and
string operands is done automatically as needed. For arithmetic computations,
integers are used until some floating-point number is introduced, after which
floating-point values are used. For example,
.PP
.CS
\fBexpr\fR {5 / 4}
@@ -335,82 +312,62 @@ returns 1, while
.CE
.PP
both return 1.25.
Floating-point values are always returned with a
A floating-point result can be distinguished from an integer result by the
presence of either
.QW \fB.\fR
or an
or
.QW \fBe\fR
so that they will not look like integer values. For example,
.PP
. For example,
.PP
.CS
\fBexpr\fR {20.0/5.0}
.CE
.PP
returns \fB4.0\fR, not \fB4\fR.
.SS "STRING OPERATIONS"
.PP
String values may be used as operands of the comparison operators,
although the expression evaluator tries to do comparisons as integer
or floating-point when it can,
i.e., when all arguments to the operator allow numeric interpretations,
except in the case of the \fBeq\fR and \fBne\fR operators.
If one of the operands of a comparison is a string and the other
has a numeric value, a canonical string representation of the numeric
operand value is generated to compare with the string operand.
Canonical string representation for integer values is a decimal string
format. Canonical string representation for floating-point values
is that produced by the \fB%g\fR format specifier of Tcl's
\fBformat\fR command. For example, the commands
.PP
.CS
\fBexpr\fR {"0x03" > "2"}
\fBexpr\fR {"0y" > "0x12"}
.CE
.PP
both return 1. The first comparison is done using integer
comparison, and the second is done using string comparison.
Because of Tcl's tendency to treat values as numbers whenever
possible, it is not generally a good idea to use operators like \fB==\fR
when you really want string comparison and the values of the
operands could be arbitrary; it is better in these cases to use
the \fBeq\fR or \fBne\fR operators, or the \fBstring\fR command instead.
.SH "PERFORMANCE CONSIDERATIONS"
.PP
Enclose expressions in braces for the best speed and the smallest
storage requirements.
This allows the Tcl bytecode compiler to generate the best code.
.PP
As mentioned above, expressions are substituted twice:
once by the Tcl parser and once by the \fBexpr\fR command.
For example, the commands
Where an expression contains syntax that Tcl would otherwise perform
substitutions on, enclosing an expression in braces or otherwise quoting it
so that it's a static value allows the Tcl compiler to generate bytecode for
the expression, resulting in better speed and smaller storage requirements.
This also avoids issues that can arise if Tcl is allowed to perform
substitution on the value before \fBexpr\fR is called.
.PP
In the following example, the value of the expression is 11 because the Tcl parser first
substitutes \fB$b\fR and \fBexpr\fR then substitutes \fB$a\fR. Enclosing the
expression in braces would result in a syntax error.
.CS
set a 3
set b {$a + 2}
\fBexpr\fR $b*4
.CE
.PP
return 11, not a multiple of 4.
This is because the Tcl parser will first substitute \fB$a + 2\fR for
the variable \fBb\fR,
then the \fBexpr\fR command will evaluate the expression \fB$a + 2*4\fR.
.PP
Most expressions do not require a second round of substitutions.
Either they are enclosed in braces or, if not,
their variable and command substitutions yield numbers or strings
that do not themselves require substitutions.
However, because a few unbraced expressions
need two rounds of substitutions,
the bytecode compiler must emit
additional instructions to handle this situation.
The most expensive code is required for
unbraced expressions that contain command substitutions.
These expressions must be implemented by generating new code
each time the expression is executed.
When the expression is unbraced to allow the substitution of a function or
operator, consider using the commands documented in the \fBmathfunc\fR(n) or
\fBmathop\fR(n) manual pages directly instead.
When an expression is generated at runtime, like the one above is, the bytcode
compiler must ensure that new code is generated each time the expression
is evaluated. This is the most costly kind of expression from a performance
perspective. In such cases, consider directly using the commands described in
the \fBmathfunc\fR(n) or \fBmathop\fR(n) documentation instead of \fBexpr\fR.
Most expressions are not formed at runtime, but are literal strings or contain
substitutions that don't introduce other substitutions. To allow the bytecode
compiler to work with an expression as a string literal at compilation time,
ensure that it contains no substitutions or that it is enclosed in braces or
otherwise quoted to prevent Tcl from performing substitutions, allowing
\fBexpr\fR to perform them instead.
.SH EXAMPLES
.PP
A numeric comparison whose result is 1:
.CS
\fBexpr\fR {"0x03" > "2"}
.CE
.PP
A string comparison whose result is 1:
.CS
\fBexpr\fR {"0y" > "0x12"}
.CE
.PP
Define a procedure that computes an
.QW interesting
mathematical function:
@@ -444,8 +401,8 @@ each other:
puts "a and b are [\fBexpr\fR {$a eq $b ? {equal} : {different}}]"
.CE
.PP
Set a variable to whether an environment variable is both defined at
all and also set to a true boolean value:
Set a variable indicating whether an environment variable is defined and has
value of true:
.PP
.CS
set isTrue [\fBexpr\fR {
+1 -1
View File
@@ -390,7 +390,7 @@ that use the third component do not attempt to perform tilde
substitution.
.RE
.TP
\fBfile stat \fIname varName\fR
\fBfile stat \fIname varName\fR
.
Invokes the \fBstat\fR kernel call on \fIname\fR, and uses the variable
given by \fIvarName\fR to hold information returned from the kernel call.
+4 -1
View File
@@ -418,7 +418,10 @@ set token [::http::geturl https://my.secure.site/]
\fB::http::unregister\fR \fIproto\fR
.
This procedure unregisters a protocol handler that was previously
registered via \fB::http::register\fR.
registered via \fB::http::register\fR, returning a two-item list of
the default port and handler command that was previously installed
(via \fB::http::register\fR) if there was such a handler, and an error if
there was no such handler.
.SH ERRORS
The \fB::http::geturl\fR procedure will raise errors in the following cases:
invalid command line options,
+1 -3
View File
@@ -123,9 +123,7 @@ with conversion character \fBu\fR.
.TP
\fBi\fR
.
The input substring must be an integer. The base (i.e. decimal, binary,
octal, or hexadecimal) is determined in the same fashion as described in
\fBexpr\fR. The integer value is stored in the variable,
The input substring must be an integer. The base (i.e. decimal, octal, or hexadecimal) is determined by the C convention (leading 0 for octal; prefix 0x for hexadecimal). The integer value is stored in the variable,
truncated as required by the size modifier value.
.TP
\fBc\fR
+6 -1
View File
@@ -45,7 +45,8 @@ linked to the corresponding namespace variables (and therefore these
variables are listed by \fBinfo vars\fR.)
In this way the \fBvariable\fR command resembles the \fBglobal\fR command,
although the \fBglobal\fR command
only links to variables in the global namespace.
resolves variable names with respect to the global namespace instead
of the current namespace of the procedure.
If any \fIvalue\fRs are given,
they are used to modify the values of the associated namespace variables.
If a namespace variable does not exist,
@@ -98,3 +99,7 @@ namespace eval foo {
global(n), namespace(n), upvar(n)
.SH KEYWORDS
global, namespace, procedure, variable
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:
+3 -3
View File
@@ -457,7 +457,7 @@ next(
if (ATEOS()) {
FAILW(REG_EESCAPE);
}
(DISCARD)lexescape(v);
(void)lexescape(v);
switch (v->nexttype) { /* not all escapes okay here */
case PLAIN:
return 1;
@@ -716,7 +716,7 @@ next(
}
RETV(PLAIN, *v->now++);
}
(DISCARD)lexescape(v);
(void)lexescape(v);
if (ISERR()) {
FAILW(REG_EESCAPE);
}
@@ -1143,7 +1143,7 @@ skip(
/*
- newline - return the chr for a newline
* This helps confine use of CHR to this source file.
^ static chr newline(NOPARMS);
^ static chr newline(void);
*/
static chr
newline(void)
+1 -1
View File
@@ -1227,7 +1227,7 @@ cmp(
const chr *x, const chr *y, /* strings to compare */
size_t len) /* exact length of comparison */
{
return memcmp(VS(x), VS(y), len*sizeof(chr));
return memcmp((void*)(x), (void*)(y), len*sizeof(chr));
}
/*
+2 -2
View File
@@ -843,7 +843,7 @@ moveins(
/*
- copyins - copy in arcs of a state to another state
^ static VOID copyins(struct nfa *, struct state *, struct state *, int);
^ static void copyins(struct nfa *, struct state *, struct state *, int);
*/
static void
copyins(
@@ -1100,7 +1100,7 @@ moveouts(
/*
- copyouts - copy out arcs of a state to another state
^ static VOID copyouts(struct nfa *, struct state *, struct state *, int);
^ static void copyouts(struct nfa *, struct state *, struct state *, int);
*/
static void
copyouts(
+6 -6
View File
@@ -82,7 +82,7 @@ static int lexescape(struct vars *);
static int lexdigits(struct vars *, int, int, int);
static int brenext(struct vars *, pchr);
static void skip(struct vars *);
static chr newline(NOPARMS);
static chr newline(void);
static chr chrnamed(struct vars *, const chr *, const chr *, pchr);
/* === regc_color.c === */
static void initcm(struct vars *, struct colormap *);
@@ -341,13 +341,13 @@ compile(
re->re_info = 0; /* bits get set during parse */
re->re_csize = sizeof(chr);
re->re_guts = NULL;
re->re_fns = VS(&functions);
re->re_fns = (void*)(&functions);
/*
* More complex setup, malloced things.
*/
re->re_guts = VS(MALLOC(sizeof(struct guts)));
re->re_guts = (void*)(MALLOC(sizeof(struct guts)));
if (re->re_guts == NULL) {
return freev(v, REG_ESPACE);
}
@@ -434,7 +434,7 @@ compile(
* Can sacrifice main NFA now, so use it as work area.
*/
(DISCARD) optimize(v->nfa, debug);
(void) optimize(v->nfa, debug);
CNOERR();
makesearch(v, v->nfa);
CNOERR();
@@ -1920,10 +1920,10 @@ nfatree(
assert(t != NULL && t->begin != NULL);
if (t->left != NULL) {
(DISCARD) nfatree(v, t->left, f);
(void) nfatree(v, t->left, f);
}
if (t->right != NULL) {
(DISCARD) nfatree(v, t->right, f);
(void) nfatree(v, t->right, f);
}
return nfanode(v, t, f);
+3 -4
View File
@@ -36,10 +36,9 @@
* Overrides for regguts.h definitions, if any.
*/
#define FUNCPTR(name, args) (*name)args
#define MALLOC(n) VS(attemptckalloc(n))
#define FREE(p) ckfree(VS(p))
#define REALLOC(p,n) VS(attemptckrealloc(VS(p),n))
#define MALLOC(n) (void*)(attemptckalloc(n))
#define FREE(p) ckfree((void*)(p))
#define REALLOC(p,n) (void*)(attemptckrealloc((void*)(p),n))
/*
* Do not insert extras between the "begin" and "end" lines - this chunk is
+2 -2
View File
@@ -44,7 +44,7 @@ struct sset { /* state set */
unsigned hash; /* hash of bitvector */
#define HASH(bv, nw) (((nw) == 1) ? *(bv) : hash(bv, nw))
#define HIT(h,bv,ss,nw) ((ss)->hash == (h) && ((nw) == 1 || \
memcmp(VS(bv), VS((ss)->states), (nw)*sizeof(unsigned)) == 0))
memcmp((void*)(bv), (void*)((ss)->states), (nw)*sizeof(unsigned)) == 0))
int flags;
#define STARTER 01 /* the initial state set */
#define POSTSTATE 02 /* includes the goal state */
@@ -268,7 +268,7 @@ exec(
if (st == REG_OKAY && v->pmatch != pmatch && nmatch > 0) {
zapallsubs(pmatch, nmatch);
n = (nmatch < v->nmatch) ? nmatch : v->nmatch;
memcpy(VS(pmatch), VS(v->pmatch), n*sizeof(regmatch_t));
memcpy((void*)(pmatch), (void*)(v->pmatch), n*sizeof(regmatch_t));
}
/*
+4 -30
View File
@@ -49,41 +49,15 @@
#include <assert.h>
#endif
/* voids */
#ifndef VOID
#define VOID void /* for function return values */
#endif
#ifndef DISCARD
#define DISCARD void /* for throwing values away */
#endif
#ifndef PVOID
#define PVOID void * /* generic pointer */
#endif
#ifndef VS
#define VS(x) ((void*)(x)) /* cast something to generic ptr */
#endif
#ifndef NOPARMS
#define NOPARMS void /* for empty parm lists */
#endif
/* function-pointer declarator */
#ifndef FUNCPTR
#if __STDC__ >= 1
#define FUNCPTR(name, args) (*name)args
#else
#define FUNCPTR(name, args) (*name)()
#endif
#endif
/* memory allocation */
#ifndef MALLOC
#define MALLOC(n) malloc(n)
#endif
#ifndef REALLOC
#define REALLOC(p, n) realloc(VS(p), n)
#define REALLOC(p, n) realloc(p, n)
#endif
#ifndef FREE
#define FREE(p) free(VS(p))
#define FREE(p) free(p)
#endif
/* want size of a char in bits, and max value in bounded quantifiers */
@@ -408,7 +382,7 @@ struct subre {
*/
struct fns {
void FUNCPTR(free, (regex_t *));
void (*free) (regex_t *);
};
/*
@@ -425,7 +399,7 @@ struct guts {
struct cnfa search; /* for fast preliminary search */
int ntree; /* number of subre's, plus one */
struct colormap cmap;
int FUNCPTR(compare, (const chr *, const chr *, size_t));
int (*compare) (const chr *, const chr *, size_t);
struct subre *lacons; /* lookahead-constraint vector */
int nlacons; /* size of lacons */
};
+13
View File
@@ -2324,6 +2324,19 @@ declare 630 {
Tcl_Obj *compressionDictionaryObj)
}
# TIP #421
declare 632 {
void Tcl_ArrayObjFirst(Tcl_Interp *interp,
Tcl_Obj *arrayObj,
Tcl_ArraySearch *searchPtr)
}
declare 633 {
int Tcl_ArrayObjNext(Tcl_Interp *interp,
Tcl_ArraySearch *searchPtr,
Tcl_Obj **keyPtrPtr,
Tcl_Obj **valuePtrPtr)
}
# ----- BASELINE -- FOR -- 8.6.0 ----- #
##############################################################################
+41 -7
View File
@@ -831,19 +831,20 @@ typedef struct Tcl_Obj {
union { /* The internal representation: */
long longValue; /* - an long integer value. */
double doubleValue; /* - a double-precision floating value. */
void *otherValuePtr; /* - another, type-specific value,
not used internally any more. */
void *otherValuePtr; /* - another, type-specific value, not used
* internally any more. */
Tcl_WideInt wideValue; /* - a long long value. */
struct { /* - internal rep as two pointers.
* the main use of which is a bignum's
* Many uses in Tcl, including a bignum's
* tightly packed fields, where the alloc,
* used and signum flags are packed into
* ptr2 with everything else hung off ptr1. */
* ptr2 with everything else hung off
* ptr1. */
void *ptr1;
void *ptr2;
} twoPtrValue;
struct { /* - internal rep as a pointer and a long,
not used internally any more. */
* not used internally any more. */
void *ptr;
unsigned long value;
} ptrAndLongRep;
@@ -1319,9 +1320,9 @@ typedef struct Tcl_HashSearch {
* TCL_CUSTOM_PTR_KEYS: The keys are pointers to arbitrary types, the
* pointer is stored in the entry.
*
* While maintaining binary compatability the above have to be distinct values
* While maintaining binary compatibility the above have to be distinct values
* as they are used to differentiate between old versions of the hash table
* which don't have a typePtr and new ones which do. Once binary compatability
* which don't have a typePtr and new ones which do. Once binary compatibility
* is discarded in favour of making more wide spread changes TCL_STRING_KEYS
* can be the same as TCL_CUSTOM_TYPE_KEYS, and TCL_ONE_WORD_KEYS can be the
* same as TCL_CUSTOM_PTR_KEYS because they simply determine how the key is
@@ -1333,6 +1334,37 @@ typedef struct Tcl_HashSearch {
#define TCL_CUSTOM_TYPE_KEYS (-2)
#define TCL_CUSTOM_PTR_KEYS (-1)
/*
* The following structure describes an enumerative search in progress on an
* array variable; this are invoked with options to the "array" command.
*/
# define TCL_ARRAYSEARCH_FOR_VALUE 0x0001
typedef struct ArraySearch {
Tcl_Obj *name; /* Name of this search */
int id; /* Integer id used to distinguish among
* multiple concurrent searches for the same
* array. */
struct Var *varPtr; /* Pointer to array variable that's being
* searched. */
Tcl_Obj *arrayNameObj; /* Name of the array variable in the current
* resolution context. Usually NULL except for
* in "array for". */
int flags; /* Used by 'array for' to check if the
* value is wanted. */
Tcl_HashSearch search; /* Info kept by the hash module about progress
* through the array. */
Tcl_HashEntry *nextEntry; /* Non-null means this is the next element to
* be enumerated (it's leftover from the
* Tcl_FirstHashEntry call or from an "array
* anymore" command). NULL means must call
* Tcl_NextHashEntry to get value to
* return. */
struct ArraySearch *nextPtr;/* Next in list of all active searches for
* this variable, or NULL if this is the last
* one. */
} Tcl_ArraySearch;
/*
* Structure definition for information used to keep track of searches through
* dictionaries. These fields should not be accessed by code outside
@@ -2619,7 +2651,9 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
# define Tcl_Ckrealloc Tcl_Realloc
# define Tcl_Return Tcl_SetResult
# define Tcl_TildeSubst Tcl_TranslateFileName
#if !defined(__APPLE__) /* On OSX, there is a conflict with "mach/mach.h" */
# define panic Tcl_Panic
#endif
# define panicVA Tcl_PanicVA
#endif /* !TCL_NO_DEPRECATED */
+27 -21
View File
@@ -588,7 +588,7 @@ Tcl_CreateInterp(void)
iPtr->cmdCount = 0;
TclInitLiteralTable(&iPtr->literalTable);
iPtr->compileEpoch = 0;
iPtr->compileEpoch = 1;
iPtr->compiledProcPtr = NULL;
iPtr->resolverPtr = NULL;
iPtr->evalFlags = 0;
@@ -966,11 +966,11 @@ Tcl_CreateInterp(void)
Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);
if (TclTommath_Init(interp) != TCL_OK) {
Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
}
if (TclOOInit(interp) != TCL_OK) {
Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
}
/*
@@ -980,7 +980,7 @@ Tcl_CreateInterp(void)
#ifdef HAVE_ZLIB
if (TclZlibInit(interp) != TCL_OK) {
Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
}
#endif
@@ -1635,7 +1635,7 @@ DeleteInterpProc(
}
Tcl_DeleteHashTable(iPtr->lineLAPtr);
ckfree((char *) iPtr->lineLAPtr);
ckfree(iPtr->lineLAPtr);
iPtr->lineLAPtr = NULL;
if (iPtr->lineLABCPtr->numEntries && !TclInExit()) {
@@ -2403,7 +2403,7 @@ TclInvokeStringCommand(
TclStackAlloc(interp, (unsigned)(objc + 1) * sizeof(char *));
for (i = 0; i < objc; i++) {
argv[i] = Tcl_GetString(objv[i]);
argv[i] = TclGetString(objv[i]);
}
argv[objc] = 0;
@@ -2657,7 +2657,7 @@ TclRenameCommand(
}
Tcl_DStringAppend(&newFullName, newTail, -1);
cmdPtr->refCount++;
CallCommandTraces(iPtr, cmdPtr, Tcl_GetString(oldFullName),
CallCommandTraces(iPtr, cmdPtr, TclGetString(oldFullName),
Tcl_DStringValue(&newFullName), TCL_TRACE_RENAME);
Tcl_DStringFree(&newFullName);
@@ -3023,13 +3023,6 @@ Tcl_DeleteCommandFromToken(
ImportRef *refPtr, *nextRefPtr;
Tcl_Command importCmd;
/*
* Bump the command epoch counter. This will invalidate all cached
* references that point to this command.
*/
cmdPtr->cmdEpoch++;
/*
* The code here is tricky. We can't delete the hash table entry before
* invoking the deletion callback because there are cases where the
@@ -3052,6 +3045,14 @@ Tcl_DeleteCommandFromToken(
Tcl_DeleteHashEntry(cmdPtr->hPtr);
cmdPtr->hPtr = NULL;
}
/*
* Bump the command epoch counter. This will invalidate all cached
* references that point to this command.
*/
cmdPtr->cmdEpoch++;
return 0;
}
@@ -3154,6 +3155,13 @@ Tcl_DeleteCommandFromToken(
if (cmdPtr->hPtr != NULL) {
Tcl_DeleteHashEntry(cmdPtr->hPtr);
cmdPtr->hPtr = NULL;
/*
* Bump the command epoch counter. This will invalidate all cached
* references that point to this command.
*/
cmdPtr->cmdEpoch++;
}
/*
@@ -3400,8 +3408,7 @@ TclCleanupCommand(
register Command *cmdPtr) /* Points to the Command structure to
* be freed. */
{
cmdPtr->refCount--;
if (cmdPtr->refCount <= 0) {
if (cmdPtr->refCount-- <= 1) {
ckfree(cmdPtr);
}
}
@@ -3523,7 +3530,7 @@ OldMathFuncProc(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"argument to math function didn't have numeric value",
-1));
TclCheckBadOctal(interp, Tcl_GetString(valuePtr));
TclCheckBadOctal(interp, TclGetString(valuePtr));
ckfree(args);
return TCL_ERROR;
}
@@ -5578,8 +5585,7 @@ TclArgumentRelease(
}
cfwPtr = Tcl_GetHashValue(hPtr);
cfwPtr->refCount--;
if (cfwPtr->refCount > 0) {
if (cfwPtr->refCount-- > 1) {
continue;
}
@@ -7884,7 +7890,7 @@ MathFuncWrongNumArgs(
int found, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Actual parameter vector. */
{
const char *name = Tcl_GetString(objv[0]);
const char *name = TclGetString(objv[0]);
const char *tail = name + strlen(name);
while (tail > name+1) {
@@ -8817,7 +8823,7 @@ TclNRInterpCoroutine(
if (!COR_IS_SUSPENDED(corPtr)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"coroutine \"%s\" is already running",
Tcl_GetString(objv[0])));
TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", NULL);
return TCL_ERROR;
}
+131 -43
View File
@@ -155,35 +155,108 @@ static const EnsembleImplMap decodeMap[] = {
};
/*
* The following object type represents an array of bytes. An array of bytes
* is not equivalent to an internationalized string. Conceptually, a string is
* an array of 16-bit quantities organized as a sequence of properly formed
* UTF-8 characters, while a ByteArray is an array of 8-bit quantities.
* Accessor functions are provided to convert a ByteArray to a String or a
* String to a ByteArray. Two or more consecutive bytes in an array of bytes
* may look like a single UTF-8 character if the array is casually treated as
* a string. But obtaining the String from a ByteArray is guaranteed to
* produced properly formed UTF-8 sequences so that there is a one-to-one map
* between bytes and characters.
* The following object types represent an array of bytes. The intent is
* to allow arbitrary binary data to pass through Tcl as a Tcl value
* without loss or damage. Such values are useful for things like
* encoded strings or Tk images to name just two.
*
* Converting a ByteArray to a String proceeds by casting each byte in the
* array to a 16-bit quantity, treating that number as a Unicode character,
* and storing the UTF-8 version of that Unicode character in the String. For
* ByteArrays consisting entirely of values 1..127, the corresponding String
* representation is the same as the ByteArray representation.
* It's strange to have two Tcl_ObjTypes in place for this task when
* one would do, so a bit of detail and history how we got to this point
* and where we might go from here.
*
* Converting a String to a ByteArray proceeds by getting the Unicode
* representation of each character in the String, casting it to a byte by
* truncating the upper 8 bits, and then storing the byte in the ByteArray.
* Converting from ByteArray to String and back to ByteArray is not lossy, but
* converting an arbitrary String to a ByteArray may be.
* A bytearray is an ordered sequence of bytes. Each byte is an integer
* value in the range [0-255]. To be a Tcl value type, we need a way to
* encode each value in the value set as a Tcl string. The simplest
* encoding is to represent each byte value as the same codepoint value.
* A bytearray of N bytes is encoded into a Tcl string of N characters
* where the codepoint of each character is the value of corresponding byte.
* This approach creates a one-to-one map between all bytearray values
* and a subset of Tcl string values.
*
* When converting a Tcl string value to the bytearray internal rep, the
* question arises what to do with strings outside that subset? That is,
* those Tcl strings containing at least one codepoint greater than 255?
* The obviously correct answer is to raise an error! That string value
* does not represent any valid bytearray value. Full Stop. The
* setFromAnyProc signature has a completion code return value for just
* this reason, to reject invalid inputs.
*
* Unfortunately this was not the path taken by the authors of the
* original tclByteArrayType. They chose to accept all Tcl string values
* as acceptable string encodings of the bytearray values that result
* from masking away the high bits of any codepoint value at all. This
* meant that every bytearray value had multiple accepted string
* representations.
*
* The implications of this choice are truly ugly. When a Tcl value has
* a string representation, we are required to accept that as the true
* value. Bytearray values that possess a string representation cannot
* be processed as bytearrays because we cannot know which true value
* that bytearray represents. The consequence is that we drag around
* an internal rep that we cannot make any use of. This painful price
* is extracted at any point after a string rep happens to be generated
* for the value. This happens even when the troublesome codepoints
* outside the byte range never show up. This happens rather routinely
* in normal Tcl operations unless we burden the script writer with the
* cognitive burden of avoiding it. The price is also paid by callers
* of the C interface. The routine
*
* unsigned char *Tcl_GetByteArrayFromObj(objPtr, lenPtr)
*
* has a guarantee to always return a non-NULL value, but that value
* points to a byte sequence that cannot be used by the caller to
* process the Tcl value absent some sideband testing that objPtr
* is "pure". Tcl offers no public interface to perform this test,
* so callers either break encapsulation or are unavoidably buggy. Tcl
* has defined a public interface that cannot be used correctly. The
* Tcl source code itself suffers the same problem, and has been buggy,
* but progressively less so as more and more portions of the code have
* been retrofitted with the required "purity testing". The set of values
* able to pass the purity test can be increased via the introduction of
* a "canonical" flag marker, but the only way the broken interface itself
* can be discarded is to start over and define the Tcl_ObjType properly.
* Bytearrays should simply be usable as bytearrays without a kabuki
* dance of testing.
*
* The Tcl_ObjType "properByteArrayType" is (nearly) a correct
* implementation of bytearrays. Any Tcl value with the type
* properByteArrayType can have its bytearray value fetched and
* used with confidence that acting on that value is equivalent to
* acting on the true Tcl string value. This still implies a side
* testing burden -- past mistakes will not let us avoid that
* immediately, but it is at least a conventional test of type, and
* can be implemented entirely by examining the objPtr fields, with
* no need to query the intrep, as a canonical flag would require.
*
* Until Tcl_GetByteArrayFromObj() and Tcl_SetByteArrayLength() can
* be revised to admit the possibility of returning NULL when the true
* value is not a valid bytearray, we need a mechanism to retain
* compatibility with the deployed callers of the broken interface.
* That's what the retained "tclByteArrayType" provides. In those
* unusual circumstances where we convert an invalid bytearray value
* to a bytearray type, it is to this legacy type. Essentially any
* time this legacy type gets used, it's a signal of a bug being ignored.
* A TIP should be drafted to remove this connection to the broken past
* so that Tcl 9 will no longer have any trace of it. Prescribing a
* migration path will be the key element of that work. The internal
* changes now in place are the limit of what can be done short of
* interface repair. They provide a great expansion of the histories
* over which bytearray values can be useful in the meanwhile.
*/
static const Tcl_ObjType properByteArrayType = {
"bytearray",
FreeByteArrayInternalRep,
DupByteArrayInternalRep,
UpdateStringOfByteArray,
NULL
};
const Tcl_ObjType tclByteArrayType = {
"bytearray",
FreeByteArrayInternalRep,
DupByteArrayInternalRep,
UpdateStringOfByteArray,
NULL,
SetByteArrayFromAny
};
@@ -211,6 +284,12 @@ typedef struct ByteArray {
#define SET_BYTEARRAY(objPtr, baPtr) \
(objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (baPtr)
int
TclIsPureByteArray(
Tcl_Obj * objPtr)
{
return (objPtr->typePtr == &properByteArrayType);
}
/*
*----------------------------------------------------------------------
@@ -341,7 +420,7 @@ Tcl_SetByteArrayObj(
if ((bytes != NULL) && (length > 0)) {
memcpy(byteArrayPtr->bytes, bytes, (size_t) length);
}
objPtr->typePtr = &tclByteArrayType;
objPtr->typePtr = &properByteArrayType;
SET_BYTEARRAY(objPtr, byteArrayPtr);
}
@@ -371,7 +450,8 @@ Tcl_GetByteArrayFromObj(
{
ByteArray *baPtr;
if (objPtr->typePtr != &tclByteArrayType) {
if ((objPtr->typePtr != &properByteArrayType)
&& (objPtr->typePtr != &tclByteArrayType)) {
SetByteArrayFromAny(NULL, objPtr);
}
baPtr = GET_BYTEARRAY(objPtr);
@@ -414,7 +494,8 @@ Tcl_SetByteArrayLength(
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength");
}
if (objPtr->typePtr != &tclByteArrayType) {
if ((objPtr->typePtr != &properByteArrayType)
&& (objPtr->typePtr != &tclByteArrayType)) {
SetByteArrayFromAny(NULL, objPtr);
}
@@ -450,29 +531,35 @@ SetByteArrayFromAny(
Tcl_Interp *interp, /* Not used. */
Tcl_Obj *objPtr) /* The object to convert to type ByteArray. */
{
int length;
int length, improper = 0;
const char *src, *srcEnd;
unsigned char *dst;
ByteArray *byteArrayPtr;
Tcl_UniChar ch;
if (objPtr->typePtr != &tclByteArrayType) {
src = TclGetStringFromObj(objPtr, &length);
srcEnd = src + length;
byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
src += Tcl_UtfToUniChar(src, &ch);
*dst++ = UCHAR(ch);
}
byteArrayPtr->used = dst - byteArrayPtr->bytes;
byteArrayPtr->allocated = length;
TclFreeIntRep(objPtr);
objPtr->typePtr = &tclByteArrayType;
SET_BYTEARRAY(objPtr, byteArrayPtr);
if (objPtr->typePtr == &properByteArrayType) {
return TCL_OK;
}
if (objPtr->typePtr == &tclByteArrayType) {
return TCL_OK;
}
src = TclGetStringFromObj(objPtr, &length);
srcEnd = src + length;
byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
src += Tcl_UtfToUniChar(src, &ch);
improper = improper || (ch > 255);
*dst++ = UCHAR(ch);
}
byteArrayPtr->used = dst - byteArrayPtr->bytes;
byteArrayPtr->allocated = length;
TclFreeIntRep(objPtr);
objPtr->typePtr = improper ? &tclByteArrayType : &properByteArrayType;
SET_BYTEARRAY(objPtr, byteArrayPtr);
return TCL_OK;
}
@@ -535,7 +622,7 @@ DupByteArrayInternalRep(
memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);
SET_BYTEARRAY(copyPtr, copyArrayPtr);
copyPtr->typePtr = &tclByteArrayType;
copyPtr->typePtr = srcPtr->typePtr;
}
/*
@@ -642,7 +729,8 @@ TclAppendBytesToByteArray(
/* Append zero bytes is a no-op. */
return;
}
if (objPtr->typePtr != &tclByteArrayType) {
if ((objPtr->typePtr != &properByteArrayType)
&& (objPtr->typePtr != &tclByteArrayType)) {
SetByteArrayFromAny(NULL, objPtr);
}
byteArrayPtr = GET_BYTEARRAY(objPtr);
+27 -28
View File
@@ -34,14 +34,14 @@
*/
typedef struct MemTag {
int refCount; /* Number of mem_headers referencing this
size_t refCount; /* Number of mem_headers referencing this
* tag. */
char string[1]; /* Actual size of string will be as large as
* needed for actual tag. This must be the
* last field in the structure. */
} MemTag;
#define TAG_SIZE(bytesInString) ((unsigned) ((TclOffset(MemTag, string) + 1) + bytesInString))
#define TAG_SIZE(bytesInString) ((TclOffset(MemTag, string) + 1) + bytesInString)
static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set
* by "memory tag" command). */
@@ -52,14 +52,14 @@ static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set
* to help detect chunk under-runs.
*/
#define LOW_GUARD_SIZE (8 + (32 - (sizeof(long) + sizeof(int)))%8)
#define LOW_GUARD_SIZE (8 + (32 - (sizeof(size_t) + sizeof(int)))%8)
struct mem_header {
struct mem_header *flink;
struct mem_header *blink;
MemTag *tagPtr; /* Tag from "memory tag" command; may be
* NULL. */
const char *file;
long length;
size_t length;
int line;
unsigned char low_guard[LOW_GUARD_SIZE];
/* Aligns body on 8-byte boundary, plus
@@ -251,10 +251,10 @@ ValidateMemory(
}
if (guard_failed) {
TclDumpMemoryInfo((ClientData) stderr, 0);
fprintf(stderr, "low guard failed at %lx, %s %d\n",
(long unsigned) memHeaderP->body, file, line);
fprintf(stderr, "low guard failed at %p, %s %d\n",
memHeaderP->body, file, line);
fflush(stderr); /* In case name pointer is bad. */
fprintf(stderr, "%ld bytes allocated at (%s %d)\n", memHeaderP->length,
fprintf(stderr, "%" TCL_LL_MODIFIER "d bytes allocated at (%s %d)\n", (Tcl_WideInt) memHeaderP->length,
memHeaderP->file, memHeaderP->line);
Tcl_Panic("Memory validation failure");
}
@@ -273,11 +273,11 @@ ValidateMemory(
if (guard_failed) {
TclDumpMemoryInfo((ClientData) stderr, 0);
fprintf(stderr, "high guard failed at %lx, %s %d\n",
(long unsigned) memHeaderP->body, file, line);
fprintf(stderr, "high guard failed at %p, %s %d\n",
memHeaderP->body, file, line);
fflush(stderr); /* In case name pointer is bad. */
fprintf(stderr, "%ld bytes allocated at (%s %d)\n",
memHeaderP->length, memHeaderP->file,
fprintf(stderr, "%" TCL_LL_MODIFIER "d bytes allocated at (%s %d)\n",
(Tcl_WideInt)memHeaderP->length, memHeaderP->file,
memHeaderP->line);
Tcl_Panic("Memory validation failure");
}
@@ -359,10 +359,10 @@ Tcl_DumpActiveMemory(
Tcl_MutexLock(ckallocMutexPtr);
for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
address = &memScanP->body[0];
fprintf(fileP, "%8lx - %8lx %7ld @ %s %d %s",
(long unsigned) address,
(long unsigned) address + memScanP->length - 1,
memScanP->length, memScanP->file, memScanP->line,
fprintf(fileP, "%8" TCL_LL_MODIFIER "x - %8" TCL_LL_MODIFIER "x %7" TCL_LL_MODIFIER "d @ %s %d %s",
(Tcl_WideInt)(size_t)address,
(Tcl_WideInt)((size_t)address + memScanP->length - 1),
(Tcl_WideInt)memScanP->length, memScanP->file, memScanP->line,
(memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string);
(void) fputc('\n', fileP);
}
@@ -458,8 +458,8 @@ Tcl_DbCkalloc(
}
if (alloc_tracing) {
fprintf(stderr,"ckalloc %lx %u %s %d\n",
(long unsigned int) result->body, size, file, line);
fprintf(stderr,"ckalloc %p %u %s %d\n",
result->body, size, file, line);
}
if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
@@ -547,8 +547,8 @@ Tcl_AttemptDbCkalloc(
}
if (alloc_tracing) {
fprintf(stderr,"ckalloc %lx %u %s %d\n",
(long unsigned int) result->body, size, file, line);
fprintf(stderr,"ckalloc %p %u %s %d\n",
result->body, size, file, line);
}
if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
@@ -612,8 +612,8 @@ Tcl_DbCkfree(
memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);
if (alloc_tracing) {
fprintf(stderr, "ckfree %lx %ld %s %d\n",
(long unsigned int) memp->body, memp->length, file, line);
fprintf(stderr, "ckfree %p %" TCL_LL_MODIFIER "d %s %d\n",
memp->body, (Tcl_WideInt) memp->length, file, line);
}
if (validate_memory) {
@@ -623,7 +623,7 @@ Tcl_DbCkfree(
Tcl_MutexLock(ckallocMutexPtr);
ValidateMemory(memp, file, line, TRUE);
if (init_malloced_bodies) {
memset(ptr, GUARD_VALUE, (size_t) memp->length);
memset(ptr, GUARD_VALUE, memp->length);
}
total_frees++;
@@ -631,8 +631,7 @@ Tcl_DbCkfree(
current_bytes_malloced -= memp->length;
if (memp->tagPtr != NULL) {
memp->tagPtr->refCount--;
if ((memp->tagPtr->refCount == 0) && (curTagPtr != memp->tagPtr)) {
if ((memp->tagPtr->refCount-- <= 1) && (curTagPtr != memp->tagPtr)) {
TclpFree((char *) memp->tagPtr);
}
}
@@ -675,7 +674,7 @@ Tcl_DbCkrealloc(
int line)
{
char *newPtr;
unsigned int copySize;
size_t copySize;
struct mem_header *memp;
if (ptr == NULL) {
@@ -689,7 +688,7 @@ Tcl_DbCkrealloc(
memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);
copySize = size;
if (copySize > (unsigned int) memp->length) {
if (copySize > memp->length) {
copySize = memp->length;
}
newPtr = Tcl_DbCkalloc(size, file, line);
@@ -706,7 +705,7 @@ Tcl_AttemptDbCkrealloc(
int line)
{
char *newPtr;
unsigned int copySize;
size_t copySize;
struct mem_header *memp;
if (ptr == NULL) {
@@ -720,7 +719,7 @@ Tcl_AttemptDbCkrealloc(
memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);
copySize = size;
if (copySize > (unsigned int) memp->length) {
if (copySize > memp->length) {
copySize = memp->length;
}
newPtr = Tcl_AttemptDbCkalloc(size, file, line);
+37 -9
View File
@@ -2155,8 +2155,8 @@ Tcl_JoinObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
int listLen, i;
Tcl_Obj *resObjPtr, *joinObjPtr, **elemPtrs;
int listLen;
Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs;
if ((objc < 2) || (objc > 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
@@ -2173,19 +2173,47 @@ Tcl_JoinObjCmd(
return TCL_ERROR;
}
if (listLen == 0) {
/* No elements to join; default empty result is correct. */
return TCL_OK;
}
if (listLen == 1) {
/* One element; return it */
Tcl_SetObjResult(interp, elemPtrs[0]);
return TCL_OK;
}
joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
Tcl_IncrRefCount(joinObjPtr);
resObjPtr = Tcl_NewObj();
for (i = 0; i < listLen; i++) {
if (i > 0) {
Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
if (Tcl_GetCharLength(joinObjPtr) == 0) {
TclStringCatObjv(interp, /* inPlace */ 0, listLen, elemPtrs,
&resObjPtr);
} else {
int i;
resObjPtr = Tcl_NewObj();
for (i = 0; i < listLen; i++) {
if (i > 0) {
/*
* NOTE: This code is relying on Tcl_AppendObjToObj() **NOT**
* to shimmer joinObjPtr. If it did, then the case where
* objv[1] and objv[2] are the same value would not be safe.
* Accessing elemPtrs would crash.
*/
Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
}
Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);
}
Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);
}
Tcl_DecrRefCount(joinObjPtr);
Tcl_SetObjResult(interp, resObjPtr);
return TCL_OK;
if (resObjPtr) {
Tcl_SetObjResult(interp, resObjPtr);
return TCL_OK;
}
return TCL_ERROR;
}
/*
+36 -198
View File
@@ -323,7 +323,7 @@ Tcl_RegexpObjCmd(
if (match == 0) {
/*
* We want to set the value of the intepreter result only when
* We want to set the value of the interpreter result only when
* this is the first time through the loop.
*/
@@ -1176,8 +1176,7 @@ StringFirstCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_UniChar *needleStr, *haystackStr;
int match, start, needleLen, haystackLen;
int start = 0;
if (objc < 3 || objc > 4) {
Tcl_WrongNumArgs(interp, 1, objv,
@@ -1185,82 +1184,23 @@ StringFirstCmd(
return TCL_ERROR;
}
/*
* We are searching haystackStr for the sequence needleStr.
*/
match = -1;
start = 0;
haystackLen = -1;
needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
if (objc == 4) {
/*
* If a startIndex is specified, we will need to fast forward to that
* point in the string before we think about a match.
*/
int size = Tcl_GetCharLength(objv[2]);
if (TclGetIntForIndexM(interp, objv[3], haystackLen-1,
&start) != TCL_OK){
if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &start)) {
return TCL_ERROR;
}
/*
* Reread to prevent shimmering problems.
*/
needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
if (start >= haystackLen) {
goto str_first_done;
} else if (start > 0) {
haystackStr += start;
haystackLen -= start;
} else if (start < 0) {
/*
* Invalid start index mapped to string start; Bug #423581
*/
if (start < 0) {
start = 0;
}
}
/*
* If the length of the needle is more than the length of the haystack, it
* cannot be contained in there so we can avoid searching. [Bug 2960021]
*/
if (needleLen > 0 && needleLen <= haystackLen) {
register Tcl_UniChar *p, *end;
end = haystackStr + haystackLen - needleLen + 1;
for (p = haystackStr; p < end; p++) {
/*
* Scan forward to find the first character.
*/
if ((*p == *needleStr) && (TclUniCharNcmp(needleStr, p,
(unsigned long) needleLen) == 0)) {
match = p - haystackStr;
break;
}
if (start >= size) {
Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
return TCL_OK;
}
}
/*
* Compute the character index of the matching string by counting the
* number of characters before the match.
*/
if ((match != -1) && (objc == 4)) {
match += start;
}
str_first_done:
Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
Tcl_SetObjResult(interp, Tcl_NewIntObj(TclStringFind(objv[1],
objv[2], start)));
return TCL_OK;
}
@@ -1289,76 +1229,31 @@ StringLastCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_UniChar *needleStr, *haystackStr, *p;
int match, start, needleLen, haystackLen;
int last = INT_MAX - 1;
if (objc < 3 || objc > 4) {
Tcl_WrongNumArgs(interp, 1, objv,
"needleString haystackString ?startIndex?");
"needleString haystackString ?lastIndex?");
return TCL_ERROR;
}
/*
* We are searching haystackString for the sequence needleString.
*/
match = -1;
start = 0;
haystackLen = -1;
needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
if (objc == 4) {
/*
* If a startIndex is specified, we will need to restrict the string
* range to that char index in the string
*/
int size = Tcl_GetCharLength(objv[2]);
if (TclGetIntForIndexM(interp, objv[3], haystackLen-1,
&start) != TCL_OK){
if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &last)) {
return TCL_ERROR;
}
/*
* Reread to prevent shimmering problems.
*/
needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
if (start < 0) {
goto str_last_done;
} else if (start < haystackLen) {
p = haystackStr + start + 1 - needleLen;
} else {
p = haystackStr + haystackLen - needleLen;
if (last < 0) {
Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
return TCL_OK;
}
} else {
p = haystackStr + haystackLen - needleLen;
}
/*
* If the length of the needle is more than the length of the haystack, it
* cannot be contained in there so we can avoid searching. [Bug 2960021]
*/
if (needleLen > 0 && needleLen <= haystackLen) {
for (; p >= haystackStr; p--) {
/*
* Scan backwards to find the first character.
*/
if ((*p == *needleStr) && !memcmp(needleStr, p,
sizeof(Tcl_UniChar) * (size_t)needleLen)) {
match = p - haystackStr;
break;
}
if (last >= size) {
last = size - 1;
}
}
str_last_done:
Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
Tcl_SetObjResult(interp, Tcl_NewIntObj(TclStringLast(objv[1],
objv[2], last)));
return TCL_OK;
}
@@ -1873,7 +1768,7 @@ StringMapCmd(
/*
* This test is tricky, but has to be that way or you get other strange
* inconsistencies (see test string-10.20 for illustration why!)
* inconsistencies (see test string-10.20.1 for illustration why!)
*/
if (objv[objc-2]->typePtr == &tclDictType && objv[objc-2]->bytes == NULL){
@@ -2223,9 +2118,7 @@ StringReptCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *string1;
char *string2;
int count, index, length1, length2;
int count;
Tcl_Obj *resultPtr;
if (objc != 3) {
@@ -2243,70 +2136,15 @@ StringReptCmd(
if (count == 1) {
Tcl_SetObjResult(interp, objv[1]);
goto done;
return TCL_OK;
} else if (count < 1) {
goto done;
}
string1 = TclGetStringFromObj(objv[1], &length1);
if (length1 <= 0) {
goto done;
return TCL_OK;
}
/*
* Only build up a string that has data. Instead of building it up with
* repeated appends, we just allocate the necessary space once and copy
* the string value in.
*
* We have to worry about overflow [Bugs 714106, 2561746].
* At this point we know 1 <= length1 <= INT_MAX and 2 <= count <= INT_MAX.
* We need to keep 2 <= length2 <= INT_MAX.
*/
if (count > INT_MAX/length1) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"result exceeds max size for a Tcl value (%d bytes)",
INT_MAX));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
if (TCL_OK != TclStringRepeat(interp, objv[1], count, &resultPtr)) {
return TCL_ERROR;
}
length2 = length1 * count;
/*
* Include space for the NUL.
*/
string2 = attemptckalloc((unsigned) length2 + 1);
if (string2 == NULL) {
/*
* Alloc failed. Note that in this case we try to do an error message
* since this is a case that's most likely when the alloc is large and
* that's easy to do with this API. Note that if we fail allocating a
* short string, this will likely keel over too (and fatally).
*/
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"string size overflow, out of memory allocating %u bytes",
length2 + 1));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
return TCL_ERROR;
}
for (index = 0; index < count; index++) {
memcpy(string2 + (length1 * index), string1, (size_t) length1);
}
string2[length2] = '\0';
/*
* We have to directly assign this instead of using Tcl_SetStringObj (and
* indirectly TclInitStringRep) because that makes another copy of the
* data.
*/
TclNewObj(resultPtr);
resultPtr->bytes = string2;
resultPtr->length = length2;
Tcl_SetObjResult(interp, resultPtr);
done:
return TCL_OK;
}
@@ -2855,7 +2693,7 @@ StringCatCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int i;
int code;
Tcl_Obj *objResultPtr;
if (objc < 2) {
@@ -2872,16 +2710,16 @@ StringCatCmd(
Tcl_SetObjResult(interp, objv[1]);
return TCL_OK;
}
objResultPtr = objv[1];
if (Tcl_IsShared(objResultPtr)) {
objResultPtr = Tcl_DuplicateObj(objResultPtr);
}
for(i = 2;i < objc;i++) {
Tcl_AppendObjToObj(objResultPtr, objv[i]);
}
Tcl_SetObjResult(interp, objResultPtr);
return TCL_OK;
code = TclStringCatObjv(interp, /* inPlace */ 1, objc-1, objv+1,
&objResultPtr);
if (code == TCL_OK) {
Tcl_SetObjResult(interp, objResultPtr);
return TCL_OK;
}
return code;
}
/*
+218 -11
View File
@@ -49,6 +49,9 @@ static int CompileEachloopCmd(Tcl_Interp *interp,
static int CompileDictEachCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr, int collect);
static int CompileArrayEachCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
/*
* The structures below define the AuxData types defined in this file.
@@ -287,6 +290,221 @@ TclCompileArrayExistsCmd(
return TCL_OK;
}
int
TclCompileArrayForCmd(
Tcl_Interp *interp, /* Used for looking up stuff. */
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. */
{
return CompileArrayEachCmd(interp, parsePtr, cmdPtr, envPtr);
}
int
CompileArrayEachCmd(
Tcl_Interp *interp, /* Used for looking up stuff. */
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. */
)
{
DefineLineInformation;
Tcl_Token *varsTokenPtr, *arrayTokenPtr, *bodyTokenPtr;
int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange;
int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset;
int numVars, endTargetOffset;
const char **argv;
Tcl_DString buffer;
/*
* There must be three arguments after the command.
*/
if (parsePtr->numWords != 4) {
return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
varsTokenPtr = TokenAfter(parsePtr->tokenPtr);
arrayTokenPtr = TokenAfter(varsTokenPtr);
bodyTokenPtr = TokenAfter(arrayTokenPtr);
if (varsTokenPtr->type != TCL_TOKEN_SIMPLE_WORD ||
arrayTokenPtr->type != TCL_TOKEN_SIMPLE_WORD ||
bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
/*
* Check we've got one or two variables and that they are local variables.
* Then extract their indices in the LVT.
*/
Tcl_DStringInit(&buffer);
TclDStringAppendToken(&buffer, &varsTokenPtr[1]);
if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars,
&argv) != TCL_OK) {
Tcl_DStringFree(&buffer);
return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
Tcl_DStringFree(&buffer);
/*
* both
* array for {k} a {}
* array for {k v} a {}
* are supported.
*/
if (numVars != 1 && numVars != 2) {
ckfree(argv);
return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
nameChars = strlen(argv[0]);
keyVarIndex = LocalScalar(argv[0], nameChars, envPtr);
valueVarIndex = -1;
if (numVars == 2) {
nameChars = strlen(argv[1]);
valueVarIndex = LocalScalar(argv[1], nameChars, envPtr);
}
ckfree(argv);
if ((keyVarIndex < 0) || (numVars == 2 && valueVarIndex < 0)) {
return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
/*
* Allocate a temporary variable to store the iterator reference. The
* variable will contain a Tcl_ArraySearch reference which will be
* allocated by INST_ARRAY_FIRST and disposed when the variable is unset
* (at which point it should also have been finished with).
*/
infoIndex = AnonymousLocal(envPtr);
if (infoIndex < 0) {
return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
/*
* Preparation complete; issue instructions. Note that this code issues
* fixed-sized jumps. That simplifies things a lot!
*/
/*
* Get the array and start the iteration. No catching of errors at
* this point.
*/
CompileWord(envPtr, arrayTokenPtr, interp, 2);
/*
* Now we catch errors from here on
*/
TclEmitInstInt4( INST_ARRAY_FIRST, infoIndex, envPtr);
catchRange = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
TclEmitInstInt4( INST_BEGIN_CATCH4, catchRange, envPtr);
ExceptionRangeStarts(envPtr, catchRange);
/*
* Set up the loop exception targets.
*/
loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
ExceptionRangeStarts(envPtr, loopRange);
/*
* Inside the iteration, fetch and write the loop variables.
*/
bodyTargetOffset = CurrentOffset(envPtr);
TclEmitInstInt4( INST_ARRAY_NEXT, infoIndex, envPtr);
emptyTargetOffset = CurrentOffset(envPtr);
Emit14Inst( INST_STORE_SCALAR, keyVarIndex, envPtr);
TclEmitOpcode( INST_POP, envPtr);
if (valueVarIndex != -1) {
Emit14Inst( INST_STORE_SCALAR, valueVarIndex, envPtr);
}
TclEmitOpcode( INST_POP, envPtr);
/*
* Compile the loop body itself. It should be stack-neutral.
*/
BODY(bodyTokenPtr, 3);
TclEmitOpcode( INST_POP, envPtr);
/*
* Both exception target ranges (error and loop) end here.
*/
ExceptionRangeEnds(envPtr, loopRange);
ExceptionRangeEnds(envPtr, catchRange);
/*
* Continue (or just normally process) by getting the next pair of items
* from the dictionary and jumping back to the code to write them into
* variables if there is another pair.
*/
TclAdjustStackDepth(-1, envPtr);
ExceptionRangeTarget(envPtr, loopRange, continueOffset);
TclEmitInstInt4( INST_ARRAY_NEXT, infoIndex, envPtr);
jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr);
/*
* checks the 'done' boolean on the stack and if false,
* goes back to the top of the loop
*/
TclEmitInstInt4( INST_JUMP_FALSE4, jumpDisplacement, envPtr);
endTargetOffset = CurrentOffset(envPtr);
TclEmitInstInt1( INST_JUMP1, 0, envPtr);
/*
* Error handler "finally" clause, which force-terminates the iteration
* and rethrows the error.
*/
ExceptionRangeTarget(envPtr, catchRange, catchOffset);
TclEmitOpcode( INST_END_CATCH, envPtr);
TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr);
TclEmitInt4( infoIndex, envPtr);
TclEmitOpcode( INST_RETURN_STK, envPtr);
/*
* Otherwise we're done and we
* need to pop the bogus key/value pair (pushed to keep stack calculations
* easy!) Note that we skip the END_CATCH. [Bug 1382528]
*/
jumpDisplacement = CurrentOffset(envPtr) - emptyTargetOffset;
TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement,
envPtr->codeStart + emptyTargetOffset);
jumpDisplacement = CurrentOffset(envPtr) - endTargetOffset;
TclUpdateInstInt1AtPc(INST_JUMP1, jumpDisplacement,
envPtr->codeStart + endTargetOffset);
TclEmitOpcode( INST_POP, envPtr);
TclEmitOpcode( INST_POP, envPtr);
ExceptionRangeTarget(envPtr, loopRange, breakOffset);
TclFinalizeLoopExceptionRange(envPtr, loopRange);
TclEmitOpcode( INST_END_CATCH, envPtr);
/*
* Final stage of the command (normal case) is that we push an empty
* object (or push the accumulator as the result object). This is done
* last to promote peephole optimization when it's dropped immediately.
*/
TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr);
TclEmitInt4( infoIndex, envPtr);
PushStringLiteral(envPtr, "");
return TCL_OK;
}
int
TclCompileArraySetCmd(
Tcl_Interp *interp, /* Used for looking up stuff. */
@@ -3206,17 +3424,6 @@ TclCompileFormatCmd(
*/
TclEmitInstInt1(INST_STR_CONCAT1, i, envPtr);
} else {
/*
* EVIL HACK! Force there to be a string representation in the case
* where there's just a "%s" in the format; case covered by the test
* format-20.1 (and it is horrible...)
*/
TclEmitOpcode(INST_DUP, envPtr);
PushStringLiteral(envPtr, "");
TclEmitOpcode(INST_STR_EQ, envPtr);
TclEmitOpcode(INST_POP, envPtr);
}
return TCL_OK;
}
+4 -4
View File
@@ -1902,10 +1902,10 @@ TclCompileSwitchCmd(
}
if (numWords % 2) {
abort:
ckfree((char *) bodyToken);
ckfree((char *) bodyTokenArray);
ckfree((char *) bodyLines);
ckfree((char *) bodyContLines);
ckfree(bodyToken);
ckfree(bodyTokenArray);
ckfree(bodyLines);
ckfree(bodyContLines);
return TCL_ERROR;
}
} else if (numWords % 2 || numWords == 0) {
+10 -7
View File
@@ -522,7 +522,6 @@ InstructionDesc const tclInstructionTable[] = {
{"arrayMakeImm", 5, 0, 1, {OPERAND_LVT4}},
/* Forces the variable indexed by opnd to be an array. Does not touch
* the stack. */
{"invokeReplace", 6, INT_MIN, 2, {OPERAND_UINT4,OPERAND_UINT1}},
/* Invoke command named objv[0], replacing the first two words with
* the word at the top of the stack;
@@ -653,7 +652,11 @@ InstructionDesc const tclInstructionTable[] = {
{"lappendListStk", 1, -1, 0, {OPERAND_NONE}},
/* Lappend list to general variable.
* Stack: ... varName list => ... listVarContents */
{"arrayFirst", 5, 0, 1, {OPERAND_LVT4}},
/* Set up iteration over the array
* no stack effect */
{"arrayNext", 5, +3, 1, {OPERAND_LVT4}},
/* Stack: key value done */
{NULL, 0, 0, 0, {OPERAND_NONE}}
};
@@ -1002,7 +1005,7 @@ void
TclReleaseByteCode(
register ByteCode *codePtr)
{
if (--codePtr->refCount) {
if (codePtr->refCount-- > 1) {
return;
}
@@ -1380,14 +1383,14 @@ ReleaseCmdWordData(
Tcl_DecrRefCount(eclPtr->path);
}
for (i=0 ; i<eclPtr->nuloc ; i++) {
ckfree((char *) eclPtr->loc[i].line);
ckfree(eclPtr->loc[i].line);
}
if (eclPtr->loc != NULL) {
ckfree((char *) eclPtr->loc);
ckfree(eclPtr->loc);
}
ckfree((char *) eclPtr);
ckfree(eclPtr);
}
/*
@@ -1801,7 +1804,7 @@ CompileCmdLiteral(
extraLiteralFlags |= LITERAL_UNSHARED;
}
bytes = Tcl_GetStringFromObj(cmdObj, &numBytes);
bytes = TclGetStringFromObj(cmdObj, &numBytes);
cmdLitIdx = TclRegisterLiteral(envPtr, bytes, numBytes, extraLiteralFlags);
if (cmdPtr) {
+6 -3
View File
@@ -417,7 +417,7 @@ typedef struct ByteCode {
* procs are specific to an interpreter so the
* code emitted will depend on the
* interpreter. */
int compileEpoch; /* Value of iPtr->compileEpoch when this
unsigned int compileEpoch; /* Value of iPtr->compileEpoch when this
* ByteCode was compiled. Used to invalidate
* code when, e.g., commands with compile
* procs are redefined. */
@@ -821,8 +821,11 @@ typedef struct ByteCode {
#define INST_LAPPEND_LIST_ARRAY_STK 187
#define INST_LAPPEND_LIST_STK 188
#define INST_ARRAY_FIRST 189
#define INST_ARRAY_NEXT 190
/* The last opcode */
#define LAST_INST_OPCODE 188
#define LAST_INST_OPCODE 190
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
@@ -1241,7 +1244,7 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData,
int dd = (depth); \
if (dd != (envPtr)->currStackDepth) { \
Tcl_Panic("bad stack depth computations: is %i, should be %i", \
(envPtr)->currStackDepth, dd); \
(envPtr)->currStackDepth, dd); \
} \
} while (0)
+4 -4
View File
@@ -232,7 +232,7 @@ QueryConfigObjCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj("package not known", -1));
Tcl_SetErrorCode(interp, "TCL", "FATAL", "PKGCFG_BASE",
Tcl_GetString(pkgName), NULL);
TclGetString(pkgName), NULL);
return TCL_ERROR;
}
@@ -247,7 +247,7 @@ QueryConfigObjCmd(
|| val == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("key not known", -1));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONFIG",
Tcl_GetString(objv[2]), NULL);
TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
@@ -333,9 +333,9 @@ QueryConfigDelete(
Tcl_DictObjRemove(NULL, pDB, pkgName);
Tcl_DecrRefCount(pkgName);
if (cdPtr->encoding) {
ckfree((char *)cdPtr->encoding);
ckfree(cdPtr->encoding);
}
ckfree((char *)cdPtr);
ckfree(cdPtr);
}
/*
+17
View File
@@ -1816,6 +1816,15 @@ EXTERN int Tcl_FSUnloadFile(Tcl_Interp *interp,
EXTERN void Tcl_ZlibStreamSetCompressionDictionary(
Tcl_ZlibStream zhandle,
Tcl_Obj *compressionDictionaryObj);
/* Slot 631 is reserved */
/* 632 */
EXTERN void Tcl_ArrayObjFirst(Tcl_Interp *interp,
Tcl_Obj *arrayObj,
Tcl_ArraySearch *searchPtr);
/* 633 */
EXTERN int Tcl_ArrayObjNext(Tcl_Interp *interp,
Tcl_ArraySearch *searchPtr,
Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr);
typedef struct {
const struct TclPlatStubs *tclPlatStubs;
@@ -2482,6 +2491,9 @@ typedef struct TclStubs {
void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */
int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
void (*reserved631)(void);
void (*tcl_ArrayObjFirst) (Tcl_Interp *interp, Tcl_Obj *arrayObj, Tcl_ArraySearch *searchPtr); /* 632 */
int (*tcl_ArrayObjNext) (Tcl_Interp *interp, Tcl_ArraySearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr); /* 633 */
} TclStubs;
extern const TclStubs *tclStubsPtr;
@@ -3774,6 +3786,11 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_FSUnloadFile) /* 629 */
#define Tcl_ZlibStreamSetCompressionDictionary \
(tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */
/* Slot 631 is reserved */
#define Tcl_ArrayObjFirst \
(tclStubsPtr->tcl_ArrayObjFirst) /* 632 */
#define Tcl_ArrayObjNext \
(tclStubsPtr->tcl_ArrayObjNext) /* 633 */
#endif /* defined(USE_TCL_STUBS) */
+45 -20
View File
@@ -142,7 +142,7 @@ typedef struct Dict {
* the entries in the order that they are
* created. */
int epoch; /* Epoch counter */
int refcount; /* Reference counter (see above) */
size_t refCount; /* Reference counter (see above) */
Tcl_Obj *chain; /* Linked list used for invalidating the
* string representations of updated nested
* dictionaries. */
@@ -392,7 +392,7 @@ DupDictInternalRep(
newDict->epoch = 0;
newDict->chain = NULL;
newDict->refcount = 1;
newDict->refCount = 1;
/*
* Store in the object.
@@ -427,8 +427,7 @@ FreeDictInternalRep(
{
Dict *dict = DICT(dictPtr);
dict->refcount--;
if (dict->refcount <= 0) {
if (dict->refCount-- <= 1) {
DeleteDict(dict);
}
dictPtr->typePtr = NULL;
@@ -713,7 +712,7 @@ SetDictFromAny(
TclFreeIntRep(objPtr);
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
dict->refCount = 1;
DICT(objPtr) = dict;
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = &tclDictType;
@@ -1117,7 +1116,7 @@ Tcl_DictObjFirst(
searchPtr->dictionaryPtr = (Tcl_Dict) dict;
searchPtr->epoch = dict->epoch;
searchPtr->next = cPtr->nextPtr;
dict->refcount++;
dict->refCount++;
if (keyPtrPtr != NULL) {
*keyPtrPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
}
@@ -1231,8 +1230,7 @@ Tcl_DictObjDone(
if (searchPtr->epoch != -1) {
searchPtr->epoch = -1;
dict = (Dict *) searchPtr->dictionaryPtr;
dict->refcount--;
if (dict->refcount <= 0) {
if (dict->refCount-- <= 1) {
DeleteDict(dict);
}
}
@@ -1384,7 +1382,7 @@ Tcl_NewDictObj(void)
InitChainTable(dict);
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
dict->refCount = 1;
DICT(dictPtr) = dict;
dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
dictPtr->typePtr = &tclDictType;
@@ -1434,7 +1432,7 @@ Tcl_DbNewDictObj(
InitChainTable(dict);
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
dict->refCount = 1;
DICT(dictPtr) = dict;
dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
dictPtr->typePtr = &tclDictType;
@@ -2282,7 +2280,7 @@ DictAppendCmd(
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
int i, allocatedDict = 0;
int allocatedDict = 0;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?");
@@ -2305,17 +2303,44 @@ DictAppendCmd(
return TCL_ERROR;
}
if (valuePtr == NULL) {
TclNewObj(valuePtr);
} else if (Tcl_IsShared(valuePtr)) {
valuePtr = Tcl_DuplicateObj(valuePtr);
if ((objc > 3) || (valuePtr == NULL)) {
/* Only go through append activites when something will change. */
Tcl_Obj *appendObjPtr = NULL;
if (objc > 3) {
/* Something to append */
if (objc == 4) {
appendObjPtr = objv[3];
} else if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1,
objc-3, objv+3, &appendObjPtr)) {
return TCL_ERROR;
}
}
if (appendObjPtr == NULL) {
/* => (objc == 3) => (valuePtr == NULL) */
TclNewObj(valuePtr);
} else if (valuePtr == NULL) {
valuePtr = appendObjPtr;
appendObjPtr = NULL;
}
if (appendObjPtr) {
if (Tcl_IsShared(valuePtr)) {
valuePtr = Tcl_DuplicateObj(valuePtr);
}
Tcl_AppendObjToObj(valuePtr, appendObjPtr);
}
Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
}
for (i=3 ; i<objc ; i++) {
Tcl_AppendObjToObj(valuePtr, objv[i]);
}
Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
/*
* Even if nothing changed, we still overwrite so that variable
* trace expectations are met.
*/
resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
TCL_LEAVE_ERR_MSG);
+13 -12
View File
@@ -305,7 +305,7 @@ Tcl_GetEncodingFromObj(
Tcl_Obj *objPtr,
Tcl_Encoding *encodingPtr)
{
const char *name = Tcl_GetString(objPtr);
const char *name = TclGetString(objPtr);
if (objPtr->typePtr != &encodingType) {
Tcl_Encoding encoding = Tcl_GetEncoding(interp, name);
@@ -705,7 +705,7 @@ Tcl_GetDefaultEncodingDir(void)
}
Tcl_ListObjIndex(NULL, searchPath, 0, &first);
return Tcl_GetString(first);
return TclGetString(first);
}
/*
@@ -977,7 +977,7 @@ Tcl_GetEncodingNames(
* Side effects:
* The reference count of the new system encoding is incremented. The
* reference count of the old system encoding is decremented and it may
* be freed.
* be freed. All VFS cached information is invalidated.
*
*------------------------------------------------------------------------
*/
@@ -1008,6 +1008,7 @@ Tcl_SetSystemEncoding(
FreeEncoding(systemEncoding);
systemEncoding = encoding;
Tcl_MutexUnlock(&encodingMutex);
Tcl_FSMountsChanged(NULL);
return TCL_OK;
}
@@ -1518,10 +1519,10 @@ OpenEncodingFileChannel(
}
}
if (!verified) {
const char *dirString = Tcl_GetString(directory);
const char *dirString = TclGetString(directory);
for (i=0; i<numDirs && !verified; i++) {
if (strcmp(dirString, Tcl_GetString(dir[i])) == 0) {
if (strcmp(dirString, TclGetString(dir[i])) == 0) {
verified = 1;
}
}
@@ -1762,7 +1763,7 @@ LoadTableEncoding(
const char *p;
Tcl_ReadChars(chan, objPtr, 3 + 16 * (16 * 4 + 1), 0);
p = Tcl_GetString(objPtr);
p = TclGetString(objPtr);
hi = (staticHex[UCHAR(p[0])] << 4) + staticHex[UCHAR(p[1])];
dataPtr->toUnicode[hi] = pageMemPtr;
p += 2;
@@ -3599,11 +3600,11 @@ unilen(
static void
InitializeEncodingSearchPath(
char **valuePtr,
int *lengthPtr,
size_t *lengthPtr,
Tcl_Encoding *encodingPtr)
{
const char *bytes;
int i, numDirs, numBytes;
int i, numDirs;
Tcl_Obj *libPathObj, *encodingObj, *searchPathObj;
TclNewLiteralStringObj(encodingObj, "encoding");
@@ -3633,11 +3634,11 @@ InitializeEncodingSearchPath(
if (*encodingPtr) {
((Encoding *)(*encodingPtr))->refCount++;
}
bytes = TclGetStringFromObj(searchPathObj, &numBytes);
bytes = TclGetString(searchPathObj);
*lengthPtr = numBytes;
*valuePtr = ckalloc(numBytes + 1);
memcpy(*valuePtr, bytes, (size_t) numBytes + 1);
*lengthPtr = searchPathObj->length;
*valuePtr = ckalloc(*lengthPtr + 1);
memcpy(*valuePtr, bytes, *lengthPtr + 1);
Tcl_DecrRefCount(searchPathObj);
}
+2 -2
View File
@@ -1605,7 +1605,7 @@ TclMakeEnsemble(
Tcl_DStringFree(&buf);
Tcl_DStringFree(&hiddenBuf);
if (nameParts != NULL) {
ckfree((char *) nameParts);
ckfree(nameParts);
}
return ensemble;
}
@@ -3135,7 +3135,7 @@ TclCompileEnsemble(
* any extra elements that might have been appended by failing
* pathways above.
*/
(void) Tcl_ListObjReplace(NULL, replaced, depth-1, INT_MAX, 0, NULL);
(void) Tcl_ListObjReplace(NULL, replaced, depth-1, LIST_MAX, 0, NULL);
/*
* TODO: Reconsider whether we ought to call CompileToInvokedCommand()
+159 -272
View File
@@ -19,7 +19,6 @@
#include "tclCompile.h"
#include "tclOOInt.h"
#include "tommath.h"
#include "tclStringRep.h"
#include <math.h>
#include <assert.h>
@@ -767,6 +766,7 @@ static void IllegalExprOperandType(Tcl_Interp *interp,
static void InitByteCodeExecution(Tcl_Interp *interp);
static inline int wordSkip(void *ptr);
static void ReleaseDictIterator(Tcl_Obj *objPtr);
static void ReleaseArrayIterator(Tcl_Obj *objPtr);
/* Useful elsewhere, make available in tclInt.h or stubs? */
static Tcl_Obj ** StackAllocWords(Tcl_Interp *interp, int numWords);
static Tcl_Obj ** StackReallocWords(Tcl_Interp *interp, int numWords);
@@ -799,6 +799,11 @@ static const Tcl_ObjType dictIteratorType = {
ReleaseDictIterator,
NULL, NULL, NULL
};
static const Tcl_ObjType arrayIteratorType = {
"arrayIterator",
ReleaseArrayIterator,
NULL, NULL, NULL
};
/*
*----------------------------------------------------------------------
@@ -838,6 +843,45 @@ ReleaseDictIterator(
objPtr->typePtr = NULL;
}
/*
*----------------------------------------------------------------------
*
* ReleaseArrayIterator --
*
* This takes apart an array iterator that is stored in the given Tcl
* object.
*
* Results:
* None.
*
* Side effects:
* Deallocates memory, marks the object as being untyped.
*
*----------------------------------------------------------------------
*/
static void
ReleaseArrayIterator(
Tcl_Obj *objPtr)
{
Tcl_ArraySearch *searchPtr;
Tcl_Obj *arrayPtr;
/*
* First kill the search, and then release the reference to the dictionary
* that we were holding.
*/
searchPtr = objPtr->internalRep.twoPtrValue.ptr1;
ckfree(searchPtr);
arrayPtr = objPtr->internalRep.twoPtrValue.ptr2;
TclDecrRefCount(arrayPtr);
objPtr->typePtr = NULL;
}
/*
*----------------------------------------------------------------------
@@ -1275,7 +1319,7 @@ TclStackFree(
Tcl_Obj **markerPtr, *marker;
if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
ckfree((char *) freePtr);
ckfree(freePtr);
return;
}
@@ -2538,7 +2582,7 @@ TEBCresume(
/* FIXME: What is the right thing to trace? */
fprintf(stdout, "%d: (%u) yielding to [%.30s]\n",
iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
Tcl_GetString(valuePtr));
TclGetString(valuePtr));
}
fflush(stdout);
}
@@ -2685,154 +2729,18 @@ TEBCresume(
NEXT_INST_F(5, 0, 0);
}
case INST_STR_CONCAT1: {
int appendLen = 0;
char *bytes, *p;
Tcl_Obj **currPtr;
int onlyb = 1;
case INST_STR_CONCAT1:
opnd = TclGetUInt1AtPtr(pc+1);
/*
* Detect only-bytearray-or-null case.
*/
for (currPtr=&OBJ_AT_DEPTH(opnd-1); currPtr<=&OBJ_AT_TOS; currPtr++) {
if (((*currPtr)->typePtr != &tclByteArrayType)
&& ((*currPtr)->bytes != tclEmptyStringRep)) {
onlyb = 0;
break;
} else if (((*currPtr)->typePtr == &tclByteArrayType) &&
((*currPtr)->bytes != NULL)) {
onlyb = 0;
break;
}
}
/*
* Compute the length to be appended.
*/
if (onlyb) {
for (currPtr = &OBJ_AT_DEPTH(opnd-2);
appendLen >= 0 && currPtr <= &OBJ_AT_TOS; currPtr++) {
if ((*currPtr)->bytes != tclEmptyStringRep) {
Tcl_GetByteArrayFromObj(*currPtr, &length);
appendLen += length;
}
}
} else {
for (currPtr = &OBJ_AT_DEPTH(opnd-2);
appendLen >= 0 && currPtr <= &OBJ_AT_TOS; currPtr++) {
bytes = TclGetStringFromObj(*currPtr, &length);
if (bytes != NULL) {
appendLen += length;
}
}
}
if (appendLen < 0) {
/* TODO: convert panic to error ? */
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
/*
* If nothing is to be appended, just return the first object by
* dropping all the others from the stack; this saves both the
* computation and copy of the string rep of the first object,
* enabling the fast '$x[set x {}]' idiom for 'K $x [set x {}]'.
*/
if (appendLen == 0) {
TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
NEXT_INST_V(2, (opnd-1), 0);
}
/*
* If the first object is shared, we need a new obj for the result;
* otherwise, we can reuse the first object. In any case, make sure it
* has enough room to accomodate all the concatenated bytes. Note that
* if it is unshared its bytes are copied by ckrealloc, so that we set
* the loop parameters to avoid copying them again: p points to the
* end of the already copied bytes, currPtr to the second object.
*/
objResultPtr = OBJ_AT_DEPTH(opnd-1);
if (!onlyb) {
bytes = TclGetStringFromObj(objResultPtr, &length);
if (length + appendLen < 0) {
/* TODO: convert panic to error ? */
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded",
INT_MAX);
}
#ifndef TCL_COMPILE_DEBUG
if (bytes != tclEmptyStringRep && !Tcl_IsShared(objResultPtr)) {
TclFreeIntRep(objResultPtr);
objResultPtr->bytes = ckrealloc(bytes, length+appendLen+1);
objResultPtr->length = length + appendLen;
p = TclGetString(objResultPtr) + length;
currPtr = &OBJ_AT_DEPTH(opnd - 2);
} else
#endif
{
p = ckalloc(length + appendLen + 1);
TclNewObj(objResultPtr);
objResultPtr->bytes = p;
objResultPtr->length = length + appendLen;
currPtr = &OBJ_AT_DEPTH(opnd - 1);
}
/*
* Append the remaining characters.
*/
for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
bytes = TclGetStringFromObj(*currPtr, &length);
if (bytes != NULL) {
memcpy(p, bytes, (size_t) length);
p += length;
}
}
*p = '\0';
} else {
bytes = (char *) Tcl_GetByteArrayFromObj(objResultPtr, &length);
if (length + appendLen < 0) {
/* TODO: convert panic to error ? */
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded",
INT_MAX);
}
#ifndef TCL_COMPILE_DEBUG
if (!Tcl_IsShared(objResultPtr)) {
bytes = (char *) Tcl_SetByteArrayLength(objResultPtr,
length + appendLen);
p = bytes + length;
currPtr = &OBJ_AT_DEPTH(opnd - 2);
} else
#endif
{
TclNewObj(objResultPtr);
bytes = (char *) Tcl_SetByteArrayLength(objResultPtr,
length + appendLen);
p = bytes;
currPtr = &OBJ_AT_DEPTH(opnd - 1);
}
/*
* Append the remaining characters.
*/
for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
if ((*currPtr)->bytes != tclEmptyStringRep) {
bytes = (char *) Tcl_GetByteArrayFromObj(*currPtr,&length);
memcpy(p, bytes, (size_t) length);
p += length;
}
}
if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1,
opnd, &OBJ_AT_DEPTH(opnd-1), &objResultPtr)) {
TRACE_ERROR(interp);
goto gotError;
}
TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
NEXT_INST_V(2, opnd, 1);
}
case INST_CONCAT_STK:
/*
@@ -4317,6 +4225,60 @@ TEBCresume(
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
NEXT_INST_V(pcAdjustment, cleanup, 1);
{
int done;
Tcl_Obj *arrayObj, *statePtr, *keyPtr, *valuePtr;
Tcl_Obj *emptyPtr;
Tcl_ArraySearch *searchPtr;
case INST_ARRAY_FIRST:
pcAdjustment = 1;
opnd = TclGetUInt4AtPtr(pc+1);
TRACE(("%u => ", opnd));
arrayObj = POP_OBJECT();
searchPtr = ckalloc(sizeof(Tcl_ArraySearch));
Tcl_ArrayObjFirst(interp, arrayObj, searchPtr);
TclNewObj(statePtr);
statePtr->typePtr = &arrayIteratorType;
statePtr->internalRep.twoPtrValue.ptr1 = searchPtr;
statePtr->internalRep.twoPtrValue.ptr2 = arrayObj;
varPtr = LOCAL(opnd);
if (varPtr->value.objPtr) {
if (varPtr->value.objPtr->typePtr == &arrayIteratorType) {
Tcl_Panic("mis-issued arrayFirst!");
}
TclDecrRefCount(varPtr->value.objPtr);
}
varPtr->value.objPtr = statePtr;
Tcl_IncrRefCount(statePtr);
NEXT_INST_F(1, 0, 0); /*### ??? */
case INST_ARRAY_NEXT:
opnd = TclGetUInt4AtPtr(pc+1);
TRACE(("%u => ", opnd));
statePtr = (*LOCAL(opnd)).value.objPtr;
if (statePtr == NULL || statePtr->typePtr != &arrayIteratorType) {
Tcl_Panic("mis-issued dictNext!");
}
searchPtr = statePtr->internalRep.twoPtrValue.ptr1;
done = Tcl_ArrayObjNext(interp, searchPtr, &keyPtr, &valuePtr);
if (done) {
TclNewObj(emptyPtr);
PUSH_OBJECT(emptyPtr);
PUSH_OBJECT(emptyPtr);
} else {
if (valuePtr != NULL) {
PUSH_OBJECT(valuePtr);
} else {
PUSH_OBJECT(emptyPtr);
}
PUSH_OBJECT(keyPtr);
}
TRACE_APPEND(("\"%.30s\" \"%.30s\" %d\n",
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done));
JUMP_PEEPHOLE_F(done, 5, 0); /* ### ??? */
}
case INST_ARRAY_MAKE_IMM:
opnd = TclGetUInt4AtPtr(pc+1);
pcAdjustment = 5;
@@ -5711,17 +5673,6 @@ TEBCresume(
length3 = Tcl_GetCharLength(value3Ptr);
/*
* Remove substring. In-place.
*/
if (length3 == 0 && !Tcl_IsShared(valuePtr) && toIdx == length) {
TclDecrRefCount(value3Ptr);
Tcl_SetObjLength(valuePtr, fromIdx);
TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
/*
* See if we can splice in place. This happens when the number of
* characters being replaced is the same as the number of characters
@@ -5731,51 +5682,29 @@ TEBCresume(
if (length3 - 1 == toIdx - fromIdx) {
unsigned char *bytes1, *bytes2;
/*
* Flush the info in the string internal rep that refers to the
* about-to-be-invalidated UTF-8 rep. This indicates that a new
* buffer needs to be allocated, and assumes that the value is
* already of tclStringTypePtr type, which should be true provided
* we call it after Tcl_GetUnicodeFromObj.
*/
#define MarkStringInternalRepForFlush(objPtr) \
(GET_STRING(objPtr)->allocated = 0)
if (Tcl_IsShared(valuePtr)) {
objResultPtr = Tcl_DuplicateObj(valuePtr);
if (TclIsPureByteArray(objResultPtr)
&& TclIsPureByteArray(value3Ptr)) {
bytes1 = Tcl_GetByteArrayFromObj(objResultPtr, NULL);
bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL);
memcpy(bytes1 + fromIdx, bytes2, length3);
} else {
ustring1 = Tcl_GetUnicodeFromObj(objResultPtr, NULL);
ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL);
memcpy(ustring1 + fromIdx, ustring2,
length3 * sizeof(Tcl_UniChar));
MarkStringInternalRepForFlush(objResultPtr);
}
Tcl_InvalidateStringRep(objResultPtr);
TclDecrRefCount(value3Ptr);
TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
} else {
if (TclIsPureByteArray(valuePtr)
&& TclIsPureByteArray(value3Ptr)) {
bytes1 = Tcl_GetByteArrayFromObj(valuePtr, NULL);
bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL);
memcpy(bytes1 + fromIdx, bytes2, length3);
} else {
ustring1 = Tcl_GetUnicodeFromObj(valuePtr, NULL);
ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL);
memcpy(ustring1 + fromIdx, ustring2,
length3 * sizeof(Tcl_UniChar));
MarkStringInternalRepForFlush(valuePtr);
}
Tcl_InvalidateStringRep(valuePtr);
TclDecrRefCount(value3Ptr);
TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
objResultPtr = valuePtr;
}
if (TclIsPureByteArray(objResultPtr)
&& TclIsPureByteArray(value3Ptr)) {
bytes1 = Tcl_GetByteArrayFromObj(objResultPtr, NULL);
bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL);
memcpy(bytes1 + fromIdx, bytes2, length3);
} else {
ustring1 = Tcl_GetUnicodeFromObj(objResultPtr, NULL);
ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL);
memcpy(ustring1 + fromIdx, ustring2,
length3 * sizeof(Tcl_UniChar));
}
Tcl_InvalidateStringRep(objResultPtr);
TclDecrRefCount(value3Ptr);
TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
if (objResultPtr == valuePtr) {
NEXT_INST_F(1, 0, 0);
} else {
NEXT_INST_F(1, 1, 1);
}
}
@@ -5791,54 +5720,38 @@ TEBCresume(
* Remove substring using copying.
*/
if (length3 == 0) {
if (fromIdx > 0) {
objResultPtr = Tcl_NewUnicodeObj(ustring1, fromIdx);
if (toIdx < length) {
Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
length - toIdx);
}
objResultPtr = NULL;
if (fromIdx > 0) {
objResultPtr = Tcl_NewUnicodeObj(ustring1, fromIdx);
}
if (length3 > 0) {
if (objResultPtr) {
Tcl_AppendObjToObj(objResultPtr, value3Ptr);
} else if (Tcl_IsShared(value3Ptr)) {
objResultPtr = Tcl_DuplicateObj(value3Ptr);
} else {
objResultPtr = value3Ptr;
}
}
if (toIdx < length) {
if (objResultPtr) {
Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
length - toIdx);
} else {
objResultPtr = Tcl_NewUnicodeObj(ustring1 + toIdx + 1,
length - toIdx);
}
TclDecrRefCount(value3Ptr);
TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
}
/*
* Splice string pieces by full copying.
*/
if (fromIdx > 0) {
objResultPtr = Tcl_NewUnicodeObj(ustring1, fromIdx);
Tcl_AppendObjToObj(objResultPtr, value3Ptr);
if (toIdx < length) {
Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
length - toIdx);
}
} else if (Tcl_IsShared(value3Ptr)) {
objResultPtr = Tcl_DuplicateObj(value3Ptr);
if (toIdx < length) {
Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
length - toIdx);
}
} else {
/*
* Be careful with splicing the stack in this case; we have a
* refCount:1 object in value3Ptr and we want to append to it and
* make it be the refCount:1 object at the top of the stack
* afterwards. [Bug 82e7f67325]
*/
if (toIdx < length) {
Tcl_AppendUnicodeToObj(value3Ptr, ustring1 + toIdx + 1,
length - toIdx);
}
if (objResultPtr == NULL) {
/* This has to be the case [string replace $s 0 end {}] */
/* which has result {} which is same as value3Ptr. */
objResultPtr = value3Ptr;
}
if (objResultPtr == value3Ptr) {
/* See [Bug 82e7f67325] */
TclDecrRefCount(OBJ_AT_TOS);
OBJ_AT_TOS = value3Ptr;
TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
TclDecrRefCount(valuePtr);
OBJ_AT_TOS = value3Ptr; /* Tricky! */
NEXT_INST_F(1, 0, 0);
}
TclDecrRefCount(value3Ptr);
@@ -5906,20 +5819,7 @@ TEBCresume(
NEXT_INST_V(1, 3, 1);
case INST_STR_FIND:
ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length); /* Haystack */
ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */
match = -1;
if (length2 > 0 && length2 <= length) {
end = ustring1 + length - length2 + 1;
for (p=ustring1 ; p<end ; p++) {
if ((*p == *ustring2) &&
memcmp(ustring2,p,sizeof(Tcl_UniChar)*length2) == 0) {
match = p - ustring1;
break;
}
}
}
match = TclStringFind(OBJ_UNDER_TOS, OBJ_AT_TOS, 0);
TRACE(("%.20s %.20s => %d\n",
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
@@ -5927,23 +5827,10 @@ TEBCresume(
NEXT_INST_F(1, 2, 1);
case INST_STR_FIND_LAST:
ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length); /* Haystack */
ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */
match = -1;
if (length2 > 0 && length2 <= length) {
for (p=ustring1+length-length2 ; p>=ustring1 ; p--) {
if ((*p == *ustring2) &&
memcmp(ustring2,p,sizeof(Tcl_UniChar)*length2) == 0) {
match = p - ustring1;
break;
}
}
}
match = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, INT_MAX - 1);
TRACE(("%.20s %.20s => %d\n",
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
TclNewIntObj(objResultPtr, match);
NEXT_INST_F(1, 2, 1);
@@ -9147,7 +9034,7 @@ ExecuteExtendedBinaryMathOp(
}
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
mp_init(&bigResult);
mp_expt_d(&big1, big2.dp[0], &bigResult);
mp_expt_d_ex(&big1, big2.dp[0], &bigResult, 1);
mp_clear(&big1);
mp_clear(&big2);
BIG_RESULT(&bigResult);
@@ -9671,9 +9558,9 @@ PrintByteCodeInfo(
Proc *procPtr = codePtr->procPtr;
Interp *iPtr = (Interp *) *codePtr->interpHandle;
fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %u, epoch %u, interp 0x%p (epoch %u)\n",
codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr,
iPtr->compileEpoch);
fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_LL_MODIFIER "u, epoch %" TCL_LL_MODIFIER "u, interp 0x%p (epoch %" TCL_LL_MODIFIER "u)\n",
codePtr, (Tcl_WideInt)codePtr->refCount, (Tcl_WideInt)codePtr->compileEpoch, iPtr,
(Tcl_WideInt)iPtr->compileEpoch);
fprintf(stdout, " Source: ");
TclPrintSource(stdout, codePtr->source, 60);
@@ -9770,7 +9657,7 @@ ValidatePcAndStackTop(
TclNewLiteralStringObj(message, "\n executing ");
Tcl_IncrRefCount(message);
Tcl_AppendLimitedToObj(message, cmd, numChars, 100, NULL);
fprintf(stderr,"%s\n", Tcl_GetString(message));
fprintf(stderr,"%s\n", TclGetString(message));
Tcl_DecrRefCount(message);
} else {
fprintf(stderr, "\n");
@@ -10233,7 +10120,7 @@ TclExprFloatError(
"unknown floating-point error, errno = %d", errno);
Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN",
Tcl_GetString(objPtr), NULL);
TclGetString(objPtr), NULL);
Tcl_SetObjResult(interp, objPtr);
}
}
+2 -2
View File
@@ -924,7 +924,7 @@ HashStringKey(
*
* BogusFind --
*
* This function is invoked when an Tcl_FindHashEntry is called on a
* This function is invoked when Tcl_FindHashEntry is called on a
* table that has been deleted.
*
* Results:
@@ -951,7 +951,7 @@ BogusFind(
*
* BogusCreate --
*
* This function is invoked when an Tcl_CreateHashEntry is called on a
* This function is invoked when Tcl_CreateHashEntry is called on a
* table that has been deleted.
*
* Results:
+1 -1
View File
@@ -7129,7 +7129,7 @@ Tcl_Tell(
*
* Tcl_SeekOld, Tcl_TellOld --
*
* Backward-compatability versions of the seek/tell interface that do not
* Backward-compatibility versions of the seek/tell interface that do not
* support 64-bit offsets. This interface is not documented or expected
* to be supported indefinitely.
*
+2 -2
View File
@@ -211,7 +211,7 @@ struct TransformChannelData {
* a transformation of incoming data. Also
* serves as buffer of all data not yet
* consumed by the reader. */
int refCount;
size_t refCount;
};
static void
@@ -225,7 +225,7 @@ static void
ReleaseData(
TransformChannelData *dataPtr)
{
if (--dataPtr->refCount) {
if (dataPtr->refCount-- > 1) {
return;
}
ResultClear(&dataPtr->result);
+9 -9
View File
@@ -591,7 +591,7 @@ TclChanCreateObjCmd(
if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s initialize\" returned non-list: %s",
Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
TclGetString(cmdObj), TclGetString(resObj)));
Tcl_DecrRefCount(resObj);
goto error;
}
@@ -617,35 +617,35 @@ TclChanCreateObjCmd(
if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s\" does not support all required methods",
Tcl_GetString(cmdObj)));
TclGetString(cmdObj)));
goto error;
}
if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s\" lacks a \"read\" method",
Tcl_GetString(cmdObj)));
TclGetString(cmdObj)));
goto error;
}
if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s\" lacks a \"write\" method",
Tcl_GetString(cmdObj)));
TclGetString(cmdObj)));
goto error;
}
if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s\" supports \"cget\" but not \"cgetall\"",
Tcl_GetString(cmdObj)));
TclGetString(cmdObj)));
goto error;
}
if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s\" supports \"cgetall\" but not \"cget\"",
Tcl_GetString(cmdObj)));
TclGetString(cmdObj)));
goto error;
}
@@ -1152,7 +1152,7 @@ ReflectClose(
tctPtr = ((Channel *)rcPtr->chan)->typePtr;
if (tctPtr && tctPtr != &tclRChannelType) {
ckfree((char *)tctPtr);
ckfree(tctPtr);
((Channel *)rcPtr->chan)->typePtr = NULL;
}
Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
@@ -1221,7 +1221,7 @@ ReflectClose(
#endif
tctPtr = ((Channel *)rcPtr->chan)->typePtr;
if (tctPtr && tctPtr != &tclRChannelType) {
ckfree((char *)tctPtr);
ckfree(tctPtr);
((Channel *)rcPtr->chan)->typePtr = NULL;
}
Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
@@ -2398,7 +2398,7 @@ ErrnoReturn(
if (((Tcl_GetIntFromObj(rcPtr->interp, resObj, &code) != TCL_OK)
|| (code >= 0))) {
if (strcmp("EAGAIN", Tcl_GetString(resObj)) == 0) {
if (strcmp("EAGAIN", TclGetString(resObj)) == 0) {
code = -EAGAIN;
} else {
code = 0;
+13 -13
View File
@@ -554,7 +554,7 @@ TclChanPushObjCmd(
*/
chanObj = objv[CHAN];
parentChan = Tcl_GetChannel(interp, Tcl_GetString(chanObj), &mode);
parentChan = Tcl_GetChannel(interp, TclGetString(chanObj), &mode);
if (parentChan == NULL) {
return TCL_ERROR;
}
@@ -608,7 +608,7 @@ TclChanPushObjCmd(
if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s initialize\" returned non-list: %s",
Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
TclGetString(cmdObj), TclGetString(resObj)));
Tcl_DecrRefCount(resObj);
goto error;
}
@@ -619,7 +619,7 @@ TclChanPushObjCmd(
"method", TCL_EXACT, &methIndex) != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s initialize\" returned %s",
Tcl_GetString(cmdObj),
TclGetString(cmdObj),
Tcl_GetString(Tcl_GetObjResult(interp))));
Tcl_DecrRefCount(resObj);
goto error;
@@ -633,7 +633,7 @@ TclChanPushObjCmd(
if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s\" does not support all required methods",
Tcl_GetString(cmdObj)));
TclGetString(cmdObj)));
goto error;
}
@@ -655,7 +655,7 @@ TclChanPushObjCmd(
if (!mode) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s\" makes the channel inaccessible",
Tcl_GetString(cmdObj)));
TclGetString(cmdObj)));
goto error;
}
@@ -666,14 +666,14 @@ TclChanPushObjCmd(
if (!IMPLIES(HAS(methods, METH_DRAIN), HAS(methods, METH_READ))) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s\" supports \"drain\" but not \"read\"",
Tcl_GetString(cmdObj)));
TclGetString(cmdObj)));
goto error;
}
if (!IMPLIES(HAS(methods, METH_FLUSH), HAS(methods, METH_WRITE))) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s\" supports \"flush\" but not \"write\"",
Tcl_GetString(cmdObj)));
TclGetString(cmdObj)));
goto error;
}
@@ -694,14 +694,14 @@ TclChanPushObjCmd(
*/
rtmPtr = GetReflectedTransformMap(interp);
hPtr = Tcl_CreateHashEntry(&rtmPtr->map, Tcl_GetString(rtId), &isNew);
hPtr = Tcl_CreateHashEntry(&rtmPtr->map, TclGetString(rtId), &isNew);
if (!isNew && rtPtr != Tcl_GetHashValue(hPtr)) {
Tcl_Panic("TclChanPushObjCmd: duplicate transformation handle");
}
Tcl_SetHashValue(hPtr, rtPtr);
#ifdef TCL_THREADS
rtmPtr = GetThreadReflectedTransformMap();
hPtr = Tcl_CreateHashEntry(&rtmPtr->map, Tcl_GetString(rtId), &isNew);
hPtr = Tcl_CreateHashEntry(&rtmPtr->map, TclGetString(rtId), &isNew);
Tcl_SetHashValue(hPtr, rtPtr);
#endif /* TCL_THREADS */
@@ -1027,7 +1027,7 @@ ReflectClose(
#ifdef TCL_THREADS
rtmPtr = GetThreadReflectedTransformMap();
hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
hPtr = Tcl_FindHashEntry(&rtmPtr->map, TclGetString(rtPtr->handle));
if (hPtr) {
Tcl_DeleteHashEntry(hPtr);
}
@@ -2568,7 +2568,7 @@ ForwardProc(
*/
rtmPtr = GetReflectedTransformMap(interp);
hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
hPtr = Tcl_FindHashEntry(&rtmPtr->map, TclGetString(rtPtr->handle));
Tcl_DeleteHashEntry(hPtr);
/*
@@ -2578,7 +2578,7 @@ ForwardProc(
*/
rtmPtr = GetThreadReflectedTransformMap();
hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
hPtr = Tcl_FindHashEntry(&rtmPtr->map, TclGetString(rtPtr->handle));
Tcl_DeleteHashEntry(hPtr);
FreeReflectedTransformArgs(rtPtr);
@@ -2955,7 +2955,7 @@ ResultClear(
return;
}
ckfree((char *) rPtr->buf);
ckfree(rPtr->buf);
rPtr->buf = NULL;
rPtr->allocated = 0;
}
+26 -24
View File
@@ -56,8 +56,8 @@ static const char *gai_strerror(int code) {
int
TclSockGetPort(
Tcl_Interp *interp,
const char *string, /* Integer or service name */
const char *proto, /* "tcp" or "udp", typically */
const char *string, /* Integer or service name */
const char *proto, /* "tcp" or "udp", typically */
int *portPtr) /* Return port number */
{
struct servent *sp; /* Protocol info for named services */
@@ -154,15 +154,15 @@ TclSockMinimumBuffers(
int
TclCreateSocketAddress(
Tcl_Interp *interp, /* Interpreter for querying
* the desired socket family */
struct addrinfo **addrlist, /* Socket address list */
const char *host, /* Host. NULL implies INADDR_ANY */
int port, /* Port number */
int willBind, /* Is this an address to bind() to or
* to connect() to? */
const char **errorMsgPtr) /* Place to store the error message
* detail, if available. */
Tcl_Interp *interp, /* Interpreter for querying the desired socket
* family */
struct addrinfo **addrlist, /* Socket address list */
const char *host, /* Host. NULL implies INADDR_ANY */
int port, /* Port number */
int willBind, /* Is this an address to bind() to or to
* connect() to? */
const char **errorMsgPtr) /* Place to store the error message detail, if
* available. */
{
struct addrinfo hints;
struct addrinfo *p;
@@ -181,30 +181,31 @@ TclCreateSocketAddress(
* Workaround for OSX's apparent inability to resolve "localhost", "0"
* when the loopback device is the only available network interface.
*/
if (host != NULL && port == 0) {
portstring = NULL;
portstring = NULL;
} else {
TclFormatInt(portbuf, port);
portstring = portbuf;
TclFormatInt(portbuf, port);
portstring = portbuf;
}
(void) memset(&hints, 0, sizeof(hints));
hints.ai_family = AF_UNSPEC;
/*
* Magic variable to enforce a certain address family - to be superseded
* by a TIP that adds explicit switches to [socket]
* Magic variable to enforce a certain address family; to be superseded
* by a TIP that adds explicit switches to [socket].
*/
if (interp != NULL) {
family = Tcl_GetVar2(interp, "::tcl::unsupported::socketAF", NULL, 0);
if (family != NULL) {
if (strcmp(family, "inet") == 0) {
hints.ai_family = AF_INET;
} else if (strcmp(family, "inet6") == 0) {
hints.ai_family = AF_INET6;
}
}
family = Tcl_GetVar2(interp, "::tcl::unsupported::socketAF", NULL, 0);
if (family != NULL) {
if (strcmp(family, "inet") == 0) {
hints.ai_family = AF_INET;
} else if (strcmp(family, "inet6") == 0) {
hints.ai_family = AF_INET6;
}
}
}
hints.ai_socktype = SOCK_STREAM;
@@ -251,6 +252,7 @@ TclCreateSocketAddress(
*
* There might be more elegant/efficient ways to do this.
*/
if (willBind) {
for (p = *addrlist; p != NULL; p = p->ai_next) {
if (p->ai_family == AF_INET) {
+2 -2
View File
@@ -638,8 +638,8 @@ FsGetFirstFilesystem(void)
}
/*
* The epoch can be changed both by filesystems being added or removed and by
* env(HOME) changing.
* The epoch can be changed by filesystems being added or removed, by changing
* the "system encoding" and by env(HOME) changing.
*/
int
+1 -1
View File
@@ -1246,7 +1246,7 @@ declare 19 macosx {
}
declare 29 {win unix} {
int TclWinCPUID(unsigned int index, unsigned int *regs)
int TclWinCPUID(int index, int *regs)
}
# Added in 8.6; core of TclpOpenTemporaryFile
declare 30 {win unix} {
+27 -16
View File
@@ -1898,7 +1898,7 @@ typedef struct Interp {
* compiled by the interpreter. Indexed by the
* string representations of literals. Used to
* avoid creating duplicate objects. */
int compileEpoch; /* Holds the current "compilation epoch" for
unsigned int compileEpoch; /* Holds the current "compilation epoch" for
* this interpreter. This is incremented to
* invalidate existing ByteCodes when, e.g., a
* command with a compile procedure is
@@ -2608,7 +2608,7 @@ typedef Tcl_ObjCmdProc *TclObjCmdProcType;
*----------------------------------------------------------------
*/
typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, int *lengthPtr,
typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, size_t *lengthPtr,
Tcl_Encoding *encodingPtr);
/*
@@ -2620,9 +2620,9 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, int *lengthPtr,
*/
typedef struct ProcessGlobalValue {
int epoch; /* Epoch counter to detect changes in the
size_t epoch; /* Epoch counter to detect changes in the
* master value. */
int numBytes; /* Length of the master string. */
size_t numBytes; /* Length of the master string. */
char *value; /* The master string value. */
Tcl_Encoding encoding; /* system encoding when master string was
* initialized. */
@@ -3072,7 +3072,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,
int *lengthPtr, Tcl_Encoding *encodingPtr);
size_t *lengthPtr, Tcl_Encoding *encodingPtr);
MODULE_SCOPE void TclpInitLock(void);
MODULE_SCOPE void TclpInitPlatform(void);
MODULE_SCOPE void TclpInitUnlock(void);
@@ -3135,11 +3135,20 @@ 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);
@@ -3490,6 +3499,9 @@ MODULE_SCOPE int TclCompileAppendCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileArrayExistsCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileArrayForCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileArraySetCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -4067,7 +4079,7 @@ typedef const char *TclDTraceStr;
TCL_DTRACE_OBJ_FREE(objPtr); \
if ((objPtr)->bytes \
&& ((objPtr)->bytes != tclEmptyStringRep)) { \
ckfree((char *) (objPtr)->bytes); \
ckfree((objPtr)->bytes); \
} \
(objPtr)->length = -1; \
TclFreeObjStorage(objPtr); \
@@ -4090,7 +4102,7 @@ typedef const char *TclDTraceStr;
(objPtr) = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj))
# define TclFreeObjStorageEx(interp, objPtr) \
ckfree((char *) (objPtr))
ckfree(objPtr)
#undef USE_THREAD_ALLOC
#undef USE_TCLALLOC
@@ -4249,7 +4261,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
*/
#define TclGetString(objPtr) \
((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString((objPtr)))
((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr))
#define TclGetStringFromObj(objPtr, lenPtr) \
((objPtr)->bytes \
@@ -4284,11 +4296,11 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
*/
#define TclInvalidateStringRep(objPtr) \
if (objPtr->bytes != NULL) { \
if (objPtr->bytes != tclEmptyStringRep) { \
ckfree((char *) objPtr->bytes); \
if ((objPtr)->bytes != NULL) { \
if ((objPtr)->bytes != tclEmptyStringRep) { \
ckfree((objPtr)->bytes); \
} \
objPtr->bytes = NULL; \
(objPtr)->bytes = NULL; \
}
/*
@@ -4418,8 +4430,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
*----------------------------------------------------------------
*/
#define TclIsPureByteArray(objPtr) \
(((objPtr)->typePtr==&tclByteArrayType) && ((objPtr)->bytes==NULL))
MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr);
/*
*----------------------------------------------------------------
@@ -4699,7 +4710,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
#define TclCleanupCommandMacro(cmdPtr) \
if ((cmdPtr)->refCount-- <= 1) { \
ckfree((char *) (cmdPtr));\
ckfree(cmdPtr);\
}
/*
@@ -4857,7 +4868,7 @@ typedef struct NRE_callback {
#else
#define TCLNR_ALLOC(interp, ptr) \
(ptr = ((ClientData) ckalloc(sizeof(NRE_callback))))
#define TCLNR_FREE(interp, ptr) ckfree((char *) (ptr))
#define TCLNR_FREE(interp, ptr) ckfree(ptr)
#endif
#if NRE_ENABLE_ASSERTS
+6 -6
View File
@@ -98,7 +98,7 @@ EXTERN int TclUnixCopyFile(const char *src, const char *dst,
/* Slot 27 is reserved */
/* Slot 28 is reserved */
/* 29 */
EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs);
EXTERN int TclWinCPUID(int index, int *regs);
/* 30 */
EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
@@ -173,7 +173,7 @@ EXTERN void TclWinFlushDirtyChannels(void);
/* 28 */
EXTERN void TclWinResetInterfaces(void);
/* 29 */
EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs);
EXTERN int TclWinCPUID(int index, int *regs);
/* 30 */
EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
@@ -247,7 +247,7 @@ EXTERN void TclMacOSXNotifierAddRunLoopMode(
/* Slot 27 is reserved */
/* Slot 28 is reserved */
/* 29 */
EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs);
EXTERN int TclWinCPUID(int index, int *regs);
/* 30 */
EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
@@ -288,7 +288,7 @@ typedef struct TclIntPlatStubs {
void (*reserved26)(void);
void (*reserved27)(void);
void (*reserved28)(void);
int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
int (*tclWinCPUID) (int index, int *regs); /* 29 */
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
@@ -321,7 +321,7 @@ typedef struct TclIntPlatStubs {
void (*tclWinSetInterfaces) (int wide); /* 26 */
void (*tclWinFlushDirtyChannels) (void); /* 27 */
void (*tclWinResetInterfaces) (void); /* 28 */
int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
int (*tclWinCPUID) (int index, int *regs); /* 29 */
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
@@ -354,7 +354,7 @@ typedef struct TclIntPlatStubs {
void (*reserved26)(void);
void (*reserved27)(void);
void (*reserved28)(void);
int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
int (*tclWinCPUID) (int index, int *regs); /* 29 */
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* MACOSX */
} TclIntPlatStubs;
+8 -8
View File
@@ -897,18 +897,18 @@ Tcl_ListObjReplace(
}
if (count < 0) {
count = 0;
} else if (numElems < first+count || first+count < 0) {
/*
* The 'first+count < 0' condition here guards agains integer
* overflow in determining 'first+count'.
*/
} else if (first > INT_MAX - count /* Handle integer overflow */
|| numElems < first+count) {
count = numElems - first;
}
if (objc > LIST_MAX - (numElems - count)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"max length of a Tcl list (%d elements) exceeded", LIST_MAX));
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"max length of a Tcl list (%d elements) exceeded",
LIST_MAX));
}
return TCL_ERROR;
}
isShared = (listRepPtr->refCount > 1);
@@ -1898,7 +1898,7 @@ SetListFromAny(
while (--elemPtrs >= &listRepPtr->elements) {
Tcl_DecrRefCount(*elemPtrs);
}
ckfree((char *) listRepPtr);
ckfree(listRepPtr);
return TCL_ERROR;
}
if (elemStart == limit) {
+1 -1
View File
@@ -1015,7 +1015,7 @@ Tcl_StaticPackage(
* TclGetLoadedPackages --
*
* This function returns information about all of the files that are
* loaded (either in a particular intepreter, or for all interpreters).
* loaded (either in a particular interpreter, or for all interpreters).
*
* Results:
* The return value is a standard Tcl completion code. If successful, a
+4 -6
View File
@@ -32,7 +32,7 @@
*/
typedef struct ThreadSpecificData {
long numNsCreated; /* Count of the number of namespaces created
size_t 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
@@ -59,7 +59,7 @@ typedef struct ResolvedNsName {
* the name was resolved. NULL if the name is
* fully qualified and thus the resolution
* does not depend on the context. */
int refCount; /* Reference count: 1 for each nsName object
size_t refCount; /* Reference count: 1 for each nsName object
* that has a pointer to this ResolvedNsName
* structure as its internal rep. This
* structure can be freed when refCount
@@ -1326,8 +1326,7 @@ void
TclNsDecrRefCount(
Namespace *nsPtr)
{
nsPtr->refCount--;
if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) {
if ((nsPtr->refCount-- <= 1) && (nsPtr->flags & NS_DEAD)) {
NamespaceFree(nsPtr);
}
}
@@ -4671,8 +4670,7 @@ FreeNsNameInternalRep(
* references, free it up.
*/
resNamePtr->refCount--;
if (resNamePtr->refCount == 0) {
if (resNamePtr->refCount-- <= 1) {
/*
* Decrement the reference count for the cached namespace. If the
* namespace is dead, and there are no more references to it, free
+1
View File
@@ -179,6 +179,7 @@ StashCallChain(
CallChain *callPtr)
{
callPtr->refCount++;
TclGetString(objPtr);
TclFreeIntRep(objPtr);
objPtr->typePtr = &methodNameType;
objPtr->internalRep.twoPtrValue.ptr1 = callPtr;
+6 -6
View File
@@ -2217,7 +2217,7 @@ ClassSuperSet(
"attempt to form circular dependency graph", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
failedAfterAlloc:
ckfree((char *) superclasses);
ckfree(superclasses);
return TCL_ERROR;
}
}
@@ -2234,7 +2234,7 @@ ClassSuperSet(
FOREACH(superPtr, oPtr->classPtr->superclasses) {
TclOORemoveFromSubclasses(oPtr->classPtr, superPtr);
}
ckfree((char *) oPtr->classPtr->superclasses.list);
ckfree(oPtr->classPtr->superclasses.list);
}
oPtr->classPtr->superclasses.list = superclasses;
oPtr->classPtr->superclasses.num = superc;
@@ -2323,7 +2323,7 @@ ClassVarsSet(
}
for (i=0 ; i<varc ; i++) {
const char *varName = Tcl_GetString(varv[i]);
const char *varName = TclGetString(varv[i]);
if (strstr(varName, "::") != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -2349,7 +2349,7 @@ ClassVarsSet(
}
if (i != varc) {
if (varc == 0) {
ckfree((char *) oPtr->classPtr->variables.list);
ckfree(oPtr->classPtr->variables.list);
} else if (i) {
oPtr->classPtr->variables.list = (Tcl_Obj **)
ckrealloc((char *) oPtr->classPtr->variables.list,
@@ -2604,7 +2604,7 @@ ObjVarsSet(
}
for (i=0 ; i<varc ; i++) {
const char *varName = Tcl_GetString(varv[i]);
const char *varName = TclGetString(varv[i]);
if (strstr(varName, "::") != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -2630,7 +2630,7 @@ ObjVarsSet(
}
if (i != varc) {
if (varc == 0) {
ckfree((char *) oPtr->variables.list);
ckfree(oPtr->variables.list);
} else if (i) {
oPtr->variables.list = (Tcl_Obj **)
ckrealloc((char *) oPtr->variables.list,
+1 -1
View File
@@ -592,7 +592,7 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);
#define AddRef(ptr) ((ptr)->refCount++)
#define DelRef(ptr) do { \
if ((ptr)->refCount-- <= 1) { \
ckfree((char *) (ptr)); \
ckfree(ptr); \
} \
} while(0)
+6 -8
View File
@@ -361,7 +361,7 @@ typedef struct ResolvedCmdName {
* incremented; if so, the cmd was renamed,
* deleted, hidden, or exposed, and so the
* pointer is invalid. */
int refCount; /* Reference count: 1 for each cmdName object
size_t refCount; /* Reference count: 1 for each cmdName object
* that has a pointer to this ResolvedCmdName
* structure as its internal rep. This
* structure can be freed when refCount
@@ -3252,13 +3252,11 @@ UpdateStringOfBignum(
if (status != MP_OKAY) {
Tcl_Panic("radix size failure in UpdateStringOfBignum");
}
if (size == 3) {
if (size < 2) {
/*
* mp_radix_size() returns 3 when more than INT_MAX bytes would be
* mp_radix_size() returns < 2 when more than INT_MAX bytes would be
* needed to hold the string rep (because mp_radix_size ignores
* integer overflow issues). When we know the string rep will be more
* than 3, we can conclude the string rep would overflow our string
* length limits.
* integer overflow issues).
*
* Note that so long as we enforce our bignums to the size that fits
* in a packed bignum, this branch will never be taken.
@@ -4309,7 +4307,7 @@ FreeCmdNameInternalRep(
* there are no more uses, free the ResolvedCmdName structure.
*/
if (resPtr->refCount-- == 1) {
if (resPtr->refCount-- <= 1) {
/*
* Now free the cached command, unless it is still in its hash
* table or if there are other references to it from other cmdName
@@ -4421,7 +4419,7 @@ SetCmdNameFromAny(
Command *oldCmdPtr = resPtr->cmdPtr;
if (--oldCmdPtr->refCount == 0) {
if (oldCmdPtr->refCount-- <= 1) {
TclCleanupCommandMacro(oldCmdPtr);
}
} else {
+1 -1
View File
@@ -60,7 +60,7 @@ static TclFile FileForRedirect(Tcl_Interp *interp, const char *spec,
static TclFile
FileForRedirect(
Tcl_Interp *interp, /* Intepreter to use for error reporting. */
Tcl_Interp *interp, /* Interpreter to use for error reporting. */
const char *spec, /* Points to character just after redirection
* character. */
int atOK, /* Non-zero means that '@' notation can be
+4 -4
View File
@@ -22,7 +22,7 @@
typedef struct {
ClientData clientData; /* Address of preserved block. */
int refCount; /* Number of Tcl_Preserve calls in effect for
size_t refCount; /* Number of Tcl_Preserve calls in effect for
* block. */
int mustFree; /* Non-zero means Tcl_EventuallyFree was
* called while a Tcl_Preserve call was in
@@ -63,7 +63,7 @@ typedef struct HandleStruct {
* ensure that the contents of the handle are
* not changed by anyone else. */
#endif
int refCount; /* Number of TclHandlePreserve() calls in
size_t refCount; /* Number of TclHandlePreserve() calls in
* effect on this handle. */
} HandleStruct;
@@ -195,7 +195,7 @@ Tcl_Release(
continue;
}
if (--refPtr->refCount != 0) {
if (refPtr->refCount-- > 1) {
Tcl_MutexUnlock(&preserveMutex);
return;
}
@@ -459,7 +459,7 @@ TclHandleRelease(
handlePtr, handlePtr->ptr2, handlePtr->ptr);
}
#endif
if ((--handlePtr->refCount == 0) && (handlePtr->ptr == NULL)) {
if ((handlePtr->refCount-- <= 1) && (handlePtr->ptr == NULL)) {
ckfree(handlePtr);
}
}
+10 -3
View File
@@ -502,9 +502,16 @@ Tcl_RegExpMatchObj(
{
Tcl_RegExp re;
re = Tcl_GetRegExpFromObj(interp, patternObj,
TCL_REG_ADVANCED | TCL_REG_NOSUB);
if (re == NULL) {
/*
* For performance reasons, first try compiling the RE without support for
* subexpressions. On failure, try again without TCL_REG_NOSUB in case the
* RE has backreferences in it. Closely related to [Bug 1366683]. If this
* still fails, an error message will be left in the interpreter.
*/
if (!(re = Tcl_GetRegExpFromObj(interp, patternObj,
TCL_REG_ADVANCED | TCL_REG_NOSUB))
&& !(re = Tcl_GetRegExpFromObj(interp, patternObj, TCL_REG_ADVANCED))) {
return -1;
}
return Tcl_RegExpExecObj(interp, re, textObj, 0 /* offset */,
+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). */
int refCount; /* Count of number of references to this
unsigned int refCount; /* Count of number of references to this
* compiled regexp. */
} TclRegexp;
+9
View File
@@ -396,6 +396,9 @@ static Tcl_WideUInt Nokia770Twiddle(Tcl_WideUInt w);
* - TCL_PARSE_SCAN_PREFIXES: ignore the prefixes 0b and 0o that are
* not part of the [scan] command's vocabulary. Use only in
* combination with TCL_PARSE_INTEGER_ONLY.
* - TCL_PARSE_BINARY_ONLY: parse only in the binary format, whether
* or not a prefix is present that would lead to binary parsing.
* Use only in combination with TCL_PARSE_INTEGER_ONLY.
* - TCL_PARSE_OCTAL_ONLY: parse only in the octal format, whether
* or not a prefix is present that would lead to octal parsing.
* Use only in combination with TCL_PARSE_INTEGER_ONLY.
@@ -627,6 +630,9 @@ TclParseNumber(
acceptPoint = p;
acceptLen = len;
if (c == 'x' || c == 'X') {
if (flags & (TCL_PARSE_OCTAL_ONLY|TCL_PARSE_BINARY_ONLY)) {
goto endgame;
}
state = ZERO_X;
break;
}
@@ -637,6 +643,9 @@ TclParseNumber(
goto zeroo;
}
if (c == 'b' || c == 'B') {
if (flags & TCL_PARSE_OCTAL_ONLY) {
goto endgame;
}
state = ZERO_B;
break;
}
+637 -2
View File
@@ -408,6 +408,15 @@ Tcl_GetCharLength(
String *stringPtr;
int numChars;
/*
* Quick, no-shimmer return for short string reps.
*/
if ((objPtr->bytes) && (objPtr->length < 2)) {
/* 0 bytes -> 0 chars; 1 byte -> 1 char */
return objPtr->length;
}
/*
* Optimize the case where we're really dealing with a bytearray object
* without string representation; we don't need to convert to a string to
@@ -1173,6 +1182,8 @@ Tcl_AppendUnicodeToObj(
* Side effects:
* The string rep of appendObjPtr is appended to the string
* representation of objPtr.
* IMPORTANT: This routine does not and MUST NOT shimmer appendObjPtr.
* Callers are counting on that.
*
*----------------------------------------------------------------------
*/
@@ -2461,6 +2472,10 @@ AppendPrintfToObjVA(
Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
va_arg(argList, long)));
break;
case 2:
Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(
va_arg(argList, Tcl_WideInt)));
break;
}
break;
case 'e':
@@ -2489,9 +2504,9 @@ AppendPrintfToObjVA(
gotPrecision = 1;
p++;
break;
/* TODO: support for wide (and bignum?) arguments */
/* TODO: support for bignum arguments */
case 'l':
size = 1;
++size;
p++;
break;
case 'h':
@@ -2598,6 +2613,616 @@ TclGetStringStorage(
*sizePtr = stringPtr->allocated;
return objPtr->bytes;
}
/*
*---------------------------------------------------------------------------
*
* TclStringRepeat --
*
* Performs the [string repeat] function.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* Writes to *objPtrPtr the address of Tcl_Obj that is concatenation
* of count copies of the value in objPtr.
*
*---------------------------------------------------------------------------
*/
int
TclStringRepeat(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
int count,
Tcl_Obj **objPtrPtr)
{
Tcl_Obj *objResultPtr;
int length = 0, unichar = 0, done = 1;
int binary = TclIsPureByteArray(objPtr);
/* assert (count >= 2) */
/*
* Analyze to determine what representation result should be.
* GOALS: Avoid shimmering & string rep generation.
* Produce pure bytearray when possible.
* Error on overflow.
*/
if (!binary) {
if (objPtr->typePtr == &tclStringType) {
String *stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode) {
unichar = 1;
}
}
}
if (binary) {
/* Result will be pure byte array. Pre-size it */
Tcl_GetByteArrayFromObj(objPtr, &length);
} else if (unichar) {
/* Result will be pure Tcl_UniChar array. Pre-size it. */
Tcl_GetUnicodeFromObj(objPtr, &length);
} else {
/* Result will be concat of string reps. Pre-size it. */
Tcl_GetStringFromObj(objPtr, &length);
}
if (length == 0) {
/* Any repeats of empty is empty. */
*objPtrPtr = objPtr;
return TCL_OK;
}
if (count > INT_MAX/length) {
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"max size for a Tcl value (%d bytes) exceeded", INT_MAX));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
return TCL_ERROR;
}
if (binary) {
/* Efficiently produce a pure byte array result */
objResultPtr = Tcl_IsShared(objPtr) ? Tcl_DuplicateObj(objPtr)
: objPtr;
Tcl_SetByteArrayLength(objResultPtr, count*length); /* PANIC? */
Tcl_SetByteArrayLength(objResultPtr, length);
while (count - done > done) {
Tcl_AppendObjToObj(objResultPtr, objResultPtr);
done *= 2;
}
TclAppendBytesToByteArray(objResultPtr,
Tcl_GetByteArrayFromObj(objResultPtr, NULL),
(count - done) * length);
} else if (unichar) {
/* Efficiently produce a pure Tcl_UniChar array result */
if (Tcl_IsShared(objPtr)) {
objResultPtr = Tcl_NewUnicodeObj(Tcl_GetUnicode(objPtr), length);
} else {
TclInvalidateStringRep(objPtr);
objResultPtr = objPtr;
}
if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"string size overflow: unable to alloc %"
TCL_LL_MODIFIER "u bytes",
(Tcl_WideUInt)STRING_SIZE(count*length)));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
return TCL_ERROR;
}
Tcl_SetObjLength(objResultPtr, length);
while (count - done > done) {
Tcl_AppendObjToObj(objResultPtr, objResultPtr);
done *= 2;
}
Tcl_AppendUnicodeToObj(objResultPtr, Tcl_GetUnicode(objResultPtr),
(count - done) * length);
} else {
/* Efficiently concatenate string reps */
if (Tcl_IsShared(objPtr)) {
objResultPtr = Tcl_NewStringObj(Tcl_GetString(objPtr), length);
} else {
TclFreeIntRep(objPtr);
objResultPtr = objPtr;
}
if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"string size overflow: unable to alloc %u bytes",
count*length));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
return TCL_ERROR;
}
Tcl_SetObjLength(objResultPtr, length);
while (count - done > done) {
Tcl_AppendObjToObj(objResultPtr, objResultPtr);
done *= 2;
}
Tcl_AppendToObj(objResultPtr, Tcl_GetString(objResultPtr),
(count - done) * length);
}
*objPtrPtr = objResultPtr;
return TCL_OK;
}
/*
*---------------------------------------------------------------------------
*
* TclStringCatObjv --
*
* Performs the [string cat] function.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* Writes to *objPtrPtr the address of Tcl_Obj that is concatenation
* of all objc values in objv.
*
*---------------------------------------------------------------------------
*/
int
TclStringCatObjv(
Tcl_Interp *interp,
int inPlace,
int objc,
Tcl_Obj * const objv[],
Tcl_Obj **objPtrPtr)
{
Tcl_Obj *objPtr, *objResultPtr, * const *ov;
int oc, length = 0, binary = 1, first = 0;
int allowUniChar = 1, requestUniChar = 0;
/* assert (objc >= 2) */
/*
* Analyze to determine what representation result should be.
* GOALS: Avoid shimmering & string rep generation.
* Produce pure bytearray when possible.
* Error on overflow.
*/
ov = objv, oc = objc;
while (oc-- && (binary || allowUniChar)) {
objPtr = *ov++;
if (objPtr->bytes) {
/* Value has a string rep. */
if (objPtr->length) {
/*
* Non-empty string rep. Not a pure bytearray, so we
* won't create a pure bytearray
*/
binary = 0;
if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
/* Prevent shimmer of non-string types. */
allowUniChar = 0;
}
}
} else {
/* assert (objPtr->typePtr != NULL) -- stork! */
if (TclIsPureByteArray(objPtr)) {
allowUniChar = 0;
} else {
binary = 0;
if (objPtr->typePtr == &tclStringType) {
/* Have a pure Unicode value; ask to preserve it */
requestUniChar = 1;
} else {
/* Have another type; prevent shimmer */
allowUniChar = 0;
}
}
}
}
if (binary) {
/* Result will be pure byte array. Pre-size it */
ov = objv; oc = objc;
while (oc-- && (length >= 0)) {
objPtr = *ov++;
if (objPtr->bytes == NULL) {
int numBytes;
Tcl_GetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */
if (length == 0) {
first = objc - oc - 1;
}
length += numBytes;
}
}
} else if (allowUniChar && requestUniChar) {
/* Result will be pure Tcl_UniChar array. Pre-size it. */
ov = objv; oc = objc;
while (oc-- && (length >= 0)) {
objPtr = *ov++;
if ((objPtr->bytes == NULL) || (objPtr->length)) {
int numChars;
Tcl_GetUnicodeFromObj(objPtr, &numChars); /* PANIC? */
if (length == 0) {
first = objc - oc - 1;
}
length += numChars;
}
}
} else {
/* Result will be concat of string reps. Pre-size it. */
ov = objv; oc = objc;
while (oc-- && (length >= 0)) {
int numBytes;
objPtr = *ov++;
Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */
if ((length == 0) && numBytes) {
first = objc - oc - 1;
}
length += numBytes;
}
}
if (length < 0) {
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"max size for a Tcl value (%d bytes) exceeded", INT_MAX));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
return TCL_ERROR;
}
if (length == 0) {
/* Total length of zero means every value has length zero */
*objPtrPtr = objv[0];
return TCL_OK;
}
objv += first; objc -= first;
if (binary) {
/* Efficiently produce a pure byte array result */
unsigned char *dst;
/*
* Broken interface! Byte array value routines offer no way
* to handle failure to allocate enough space. Following
* stanza may panic.
*/
if (inPlace && !Tcl_IsShared(*objv)) {
int start;
objResultPtr = *objv++; objc--;
Tcl_GetByteArrayFromObj(objResultPtr, &start);
dst = Tcl_SetByteArrayLength(objResultPtr, length) + start;
} else {
objResultPtr = Tcl_NewByteArrayObj(NULL, length);
dst = Tcl_SetByteArrayLength(objResultPtr, length);
}
while (objc--) {
Tcl_Obj *objPtr = *objv++;
if (objPtr->bytes == NULL) {
int more;
unsigned char *src = Tcl_GetByteArrayFromObj(objPtr, &more);
memcpy(dst, src, (size_t) more);
dst += more;
}
}
} else if (allowUniChar && requestUniChar) {
/* Efficiently produce a pure Tcl_UniChar array result */
Tcl_UniChar *dst;
if (inPlace && !Tcl_IsShared(*objv)) {
int start;
objResultPtr = *objv++; objc--;
/* Ugly interface! Force resize of the unicode array. */
Tcl_GetUnicodeFromObj(objResultPtr, &start);
Tcl_InvalidateStringRep(objResultPtr);
if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"concatenation failed: unable to alloc %"
TCL_LL_MODIFIER "u bytes",
(Tcl_WideUInt)STRING_SIZE(length)));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
return TCL_ERROR;
}
dst = Tcl_GetUnicode(objResultPtr) + start;
} else {
Tcl_UniChar ch = 0;
/* Ugly interface! No scheme to init array size. */
objResultPtr = Tcl_NewUnicodeObj(&ch, 0); /* PANIC? */
if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"concatenation failed: unable to alloc %"
TCL_LL_MODIFIER "u bytes",
(Tcl_WideUInt)STRING_SIZE(length)));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
return TCL_ERROR;
}
dst = Tcl_GetUnicode(objResultPtr);
}
while (objc--) {
Tcl_Obj *objPtr = *objv++;
if ((objPtr->bytes == NULL) || (objPtr->length)) {
int more;
Tcl_UniChar *src = Tcl_GetUnicodeFromObj(objPtr, &more);
memcpy(dst, src, more * sizeof(Tcl_UniChar));
dst += more;
}
}
} else {
/* Efficiently concatenate string reps */
char *dst;
if (inPlace && !Tcl_IsShared(*objv)) {
int start;
objResultPtr = *objv++; objc--;
Tcl_GetStringFromObj(objResultPtr, &start);
if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"concatenation failed: unable to alloc %u bytes",
length));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
return TCL_ERROR;
}
dst = Tcl_GetString(objResultPtr) + start;
if (length > start) {
TclFreeIntRep(objResultPtr);
}
} else {
objResultPtr = Tcl_NewObj(); /* PANIC? */
if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"concatenation failed: unable to alloc %u bytes",
length));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
return TCL_ERROR;
}
dst = Tcl_GetString(objResultPtr);
}
while (objc--) {
Tcl_Obj *objPtr = *objv++;
if ((objPtr->bytes == NULL) || (objPtr->length)) {
int more;
char *src = Tcl_GetStringFromObj(objPtr, &more);
memcpy(dst, src, (size_t) more);
dst += more;
}
}
}
*objPtrPtr = objResultPtr;
return TCL_OK;
}
/*
*---------------------------------------------------------------------------
*
* TclStringFind --
*
* Implements the [string first] operation.
*
* Results:
* If needle is found as a substring of haystack, the index of the
* first instance of such a find is returned. If needle is not present
* as a substring of haystack, -1 is returned.
*
* Side effects:
* needle and haystack may have their Tcl_ObjType changed.
*
*---------------------------------------------------------------------------
*/
int
TclStringFind(
Tcl_Obj *needle,
Tcl_Obj *haystack,
int start)
{
int lh, ln = Tcl_GetCharLength(needle);
if (ln == 0) {
/*
* We don't find empty substrings. Bizarre!
*
* TODO: When we one day make this a true substring
* finder, change this to "return 0"
*/
return -1;
}
if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) {
unsigned char *end, *try, *bh;
unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln);
bh = Tcl_GetByteArrayFromObj(haystack, &lh);
end = bh + lh;
try = bh + start;
while (try + ln <= end) {
try = memchr(try, bn[0], end - try);
if (try == NULL) {
return -1;
}
if (0 == memcmp(try+1, bn+1, ln-1)) {
return (try - bh);
}
try++;
}
return -1;
}
lh = Tcl_GetCharLength(haystack);
if (haystack->bytes && (lh == haystack->length)) {
/* haystack is all single-byte chars */
if (needle->bytes && (ln == needle->length)) {
/* needle is also all single-byte chars */
char *found = strstr(haystack->bytes + start, needle->bytes);
if (found) {
return (found - haystack->bytes);
} else {
return -1;
}
} else {
/*
* Cannot find substring with a multi-byte char inside
* a string with no multi-byte chars.
*/
return -1;
}
} else {
Tcl_UniChar *try, *end, *uh;
Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln);
uh = Tcl_GetUnicodeFromObj(haystack, &lh);
end = uh + lh;
try = uh + start;
while (try + ln <= end) {
if ((*try == *un)
&& (0 == memcmp(try+1, un+1, (ln-1)*sizeof(Tcl_UniChar)))) {
return (try - uh);
}
try++;
}
return -1;
}
}
/*
*---------------------------------------------------------------------------
*
* TclStringLast --
*
* Implements the [string last] operation.
*
* Results:
* If needle is found as a substring of haystack, the index of the
* last instance of such a find is returned. If needle is not present
* as a substring of haystack, -1 is returned.
*
* Side effects:
* needle and haystack may have their Tcl_ObjType changed.
*
*---------------------------------------------------------------------------
*/
int
TclStringLast(
Tcl_Obj *needle,
Tcl_Obj *haystack,
int last)
{
int lh, ln = Tcl_GetCharLength(needle);
if (ln == 0) {
/*
* We don't find empty substrings. Bizarre!
*
* TODO: When we one day make this a true substring
* finder, change this to "return 0"
*/
return -1;
}
if (ln > last + 1) {
return -1;
}
if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) {
unsigned char *try, *bh;
unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln);
bh = Tcl_GetByteArrayFromObj(haystack, &lh);
if (last + 1 > lh) {
last = lh - 1;
}
try = bh + last + 1 - ln;
while (try >= bh) {
if ((*try == bn[0])
&& (0 == memcmp(try+1, bn+1, ln-1))) {
return (try - bh);
}
try--;
}
return -1;
}
lh = Tcl_GetCharLength(haystack);
if (last + 1 > lh) {
last = lh - 1;
}
if (haystack->bytes && (lh == haystack->length)) {
/* haystack is all single-byte chars */
if (needle->bytes && (ln == needle->length)) {
/* needle is also all single-byte chars */
char *try = haystack->bytes + last + 1 - ln;
while (try >= haystack->bytes) {
if ((*try == needle->bytes[0])
&& (0 == memcmp(try+1, needle->bytes + 1, ln - 1))) {
return (try - haystack->bytes);
}
try--;
}
return -1;
} else {
/*
* Cannot find substring with a multi-byte char inside
* a string with no multi-byte chars.
*/
return -1;
}
} else {
Tcl_UniChar *try, *uh;
Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln);
uh = Tcl_GetUnicodeFromObj(haystack, &lh);
try = uh + last + 1 - ln;
while (try >= uh) {
if ((*try == un[0])
&& (0 == memcmp(try+1, un+1, (ln-1)*sizeof(Tcl_UniChar)))) {
return (try - uh);
}
try--;
}
return -1;
}
}
/*
*---------------------------------------------------------------------------
*
@@ -2948,6 +3573,16 @@ UpdateStringOfString(
{
String *stringPtr = GET_STRING(objPtr);
/*
* This routine is only called when we need to generate the
* string rep objPtr->bytes because it does not exist -- it is NULL.
* In that circumstance, any lingering claim about the size of
* memory pointed to by that NULL pointer is clearly bogus, and
* needs a reset.
*/
stringPtr->allocated = 0;
if (stringPtr->numChars == 0) {
TclInitStringRep(objPtr, tclEmptyStringRep, 0);
} else {
+5 -5
View File
@@ -72,17 +72,17 @@ typedef struct {
do { \
if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \
Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
STRING_MAXCHARS); \
(int)STRING_MAXCHARS); \
} \
} while (0)
#define stringAttemptAlloc(numChars) \
(String *) attemptckalloc((unsigned) STRING_SIZE(numChars))
(String *) attemptckalloc(STRING_SIZE(numChars))
#define stringAlloc(numChars) \
(String *) ckalloc((unsigned) STRING_SIZE(numChars))
(String *) ckalloc(STRING_SIZE(numChars))
#define stringRealloc(ptr, numChars) \
(String *) ckrealloc((ptr), (unsigned) STRING_SIZE(numChars))
(String *) ckrealloc((ptr), STRING_SIZE(numChars))
#define stringAttemptRealloc(ptr, numChars) \
(String *) attemptckrealloc((ptr), (unsigned) STRING_SIZE(numChars))
(String *) attemptckrealloc((ptr), STRING_SIZE(numChars))
#define GET_STRING(objPtr) \
((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_STRING(objPtr, stringPtr) \
+4
View File
@@ -749,6 +749,7 @@ const TclTomMathStubs tclTomMathStubs = {
TclBNInitBignumFromLong, /* 64 */
TclBNInitBignumFromWideInt, /* 65 */
TclBNInitBignumFromWideUInt, /* 66 */
TclBN_mp_expt_d_ex, /* 67 */
};
static const TclStubHooks tclStubHooks = {
@@ -1415,6 +1416,9 @@ const TclStubs tclStubs = {
Tcl_FindSymbol, /* 628 */
Tcl_FSUnloadFile, /* 629 */
Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
0, /* 631 */
Tcl_ArrayObjFirst, /* 632 */
Tcl_ArrayObjNext, /* 633 */
};
/* !END!: Do not edit above this line. */
+3 -3
View File
@@ -6751,7 +6751,7 @@ TestcpuidCmd(
Tcl_Obj *const * objv) /* Parameter vector */
{
int status, index, i;
unsigned int regs[4];
int regs[4];
Tcl_Obj *regsObjs[4];
if (objc != 2) {
@@ -6761,14 +6761,14 @@ TestcpuidCmd(
if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) {
return TCL_ERROR;
}
status = TclWinCPUID((unsigned) index, regs);
status = TclWinCPUID(index, regs);
if (status != TCL_OK) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("operation not available", -1));
return status;
}
for (i=0 ; i<4 ; ++i) {
regsObjs[i] = Tcl_NewIntObj((int) regs[i]);
regsObjs[i] = Tcl_NewIntObj(regs[i]);
}
Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs));
return TCL_OK;
+48 -3
View File
@@ -152,10 +152,11 @@ TestbignumobjCmd(
Tcl_Obj *const objv[]) /* Argument vector */
{
const char *const subcmds[] = {
"set", "get", "mult10", "div10", NULL
"set", "get", "mult10", "div10", "iseven", "radixsize", NULL
};
enum options {
BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10
BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10, BIGNUM_ISEVEN,
BIGNUM_RADIXSIZE
};
int index, varIndex;
const char *string;
@@ -274,6 +275,50 @@ TestbignumobjCmd(
} else {
SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&newValue));
}
break;
case BIGNUM_ISEVEN:
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
return TCL_ERROR;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
&bignumValue) != TCL_OK) {
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetIntObj(varPtr[varIndex], mp_iseven(&bignumValue));
} else {
SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(mp_iseven(&bignumValue)));
}
mp_clear(&bignumValue);
break;
case BIGNUM_RADIXSIZE:
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
return TCL_ERROR;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
&bignumValue) != TCL_OK) {
return TCL_ERROR;
}
if (mp_radix_size(&bignumValue, 10, &index) != MP_OKAY) {
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetIntObj(varPtr[varIndex], index);
} else {
SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(index));
}
mp_clear(&bignumValue);
break;
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
@@ -1056,7 +1101,7 @@ TestobjCmd(
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(varPtr[varIndex]->refCount));
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(varPtr[varIndex]->refCount));
} else if (strcmp(subCmd, "type") == 0) {
if (objc != 3) {
goto wrongNumArgs;
+3 -3
View File
@@ -1106,9 +1106,9 @@ TclFinalizeThreadAlloc(void)
*
* TclFinalizeThreadAllocThread --
*
* This procedure is used to destroy single thread private resources used
* in this file.
* Called in TclpFinalizeThreadData when a thread exits (Tcl_FinalizeThread).
* This procedure is used to destroy single thread private resources
* defined in this file. Called either during Tcl_FinalizeThread() or
* Tcl_Finalize().
*
* Results:
* None.
+7 -2
View File
@@ -90,7 +90,7 @@ declare 21 {
int TclBN_mp_init(mp_int *a)
}
declare 22 {
int TclBN_mp_init_copy(mp_int *a, mp_int *b)
int TclBN_mp_init_copy(mp_int *a, const mp_int *b)
}
declare 23 {
int TclBN_mp_init_multi(mp_int *a, ...)
@@ -129,7 +129,7 @@ declare 34 {
int TclBN_mp_or(mp_int *a, mp_int *b, mp_int *c)
}
declare 35 {
int TclBN_mp_radix_size(mp_int *a, int radix, int *size)
int TclBN_mp_radix_size(const mp_int *a, int radix, int *size)
}
declare 36 {
int TclBN_mp_read_radix(mp_int *a, const char *str, int radix)
@@ -233,6 +233,11 @@ declare 66 {
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)
}
# Local Variables:
# mode: tcl
# End:
+121 -151
View File
@@ -10,7 +10,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
* Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
* Tom St Denis, tstdenis82@gmail.com, http://math.libtomcrypt.com
*/
#ifndef BN_H_
#define BN_H_
@@ -22,33 +22,15 @@
#ifndef MIN
# define MIN(x,y) ((x)<(y)?(x):(y))
#endif
#ifndef MAX
# define MAX(x,y) ((x)>(y)?(x):(y))
#endif
#ifdef __cplusplus
extern "C" {
/* C++ compilers don't like assigning void * to mp_digit * */
#define OPT_CAST(x) (x *)
#else
/* C on the other hand doesn't care */
#define OPT_CAST(x)
#endif
/* detect 64-bit mode if possible */
#if defined(NEVER) /* 128-bit ints fail in too many places */
# if !(defined(MP_64BIT) && 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.
@@ -61,83 +43,89 @@ extern "C" {
*/
#ifdef MP_8BIT
#ifndef MP_DIGIT_DECLARED
typedef unsigned char mp_digit;
typedef uint8_t mp_digit;
#define MP_DIGIT_DECLARED
#endif
typedef unsigned short mp_word;
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
#endif
#elif defined(MP_16BIT)
#ifndef MP_DIGIT_DECLARED
typedef unsigned short mp_digit;
typedef uint16_t mp_digit;
#define MP_DIGIT_DECLARED
#endif
typedef unsigned long mp_word;
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
#endif
#elif defined(MP_64BIT)
/* for GCC only on supported platforms */
#ifndef CRYPT
typedef unsigned long long ulong64;
typedef signed long long long64;
typedef unsigned long long ulong64;
typedef signed long long long64;
#endif
#ifndef MP_DIGIT_DECLARED
typedef unsigned long mp_digit;
typedef ulong64 mp_digit;
#define MP_DIGIT_DECLARED
#endif
typedef unsigned long mp_word __attribute__ ((mode(TI)));
#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;
#endif
# define DIGIT_BIT 60
#define DIGIT_BIT 60
#else
/* this is the default case, 28-bit digits */
/* this is to make porting into LibTomCrypt easier :-) */
#ifndef CRYPT
# if defined(_MSC_VER) || defined(__BORLANDC__)
typedef unsigned __int64 ulong64;
typedef signed __int64 long64;
# else
typedef unsigned long long ulong64;
typedef signed long long long64;
# endif
typedef unsigned long long ulong64;
typedef signed long long long64;
#endif
#ifndef MP_DIGIT_DECLARED
typedef unsigned int mp_digit;
typedef uint32_t mp_digit;
#define MP_DIGIT_DECLARED
#endif
typedef ulong64 mp_word;
typedef ulong64 mp_word;
#ifdef MP_31BIT
#ifdef MP_31BIT
/* this is an extension that uses 31-bit digits */
# define DIGIT_BIT 31
#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
/* define heap macros */
#if 0 /* these are macros in tclTomMathDecls.h */
#ifndef CRYPT
/* default to libc stuff */
# ifndef XMALLOC
# define XMALLOC malloc
# define XFREE free
# define XREALLOC realloc
# define XCALLOC calloc
# else
/* prototypes for our heap functions */
extern void *XMALLOC(size_t n);
extern void *XREALLOC(void *p, size_t n);
extern void *XCALLOC(size_t n, size_t s);
extern void XFREE(void *p);
# endif
#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 ((int)((CHAR_BIT * sizeof(mp_digit) - 1))) /* bits per digit */
#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
#endif
/* use arc4random on platforms that support it */
#ifdef MP_USE_ALT_RAND
#define MP_GEN_RANDOM() arc4random()
#else
#define MP_GEN_RANDOM() rand()
#endif
#define MP_DIGIT_BIT DIGIT_BIT
@@ -180,15 +168,15 @@ 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) */
#define MP_WARRAY (1 << (sizeof(mp_word) * CHAR_BIT - 2 * DIGIT_BIT + 1))
#define MP_WARRAY (1 << (((sizeof(mp_word) * CHAR_BIT) - (2 * DIGIT_BIT)) + 1))
/* the infamous mp_int structure */
#ifndef MP_INT_DECLARED
@@ -209,9 +197,7 @@ typedef int ltm_prime_callback(unsigned char *dst, int len, void *dat);
#define SIGN(m) ((m)->sign)
/* error code to char* string */
/*
char *mp_error_to_string(int code);
*/
const char *mp_error_to_string(int code);
/* ---> init and deinit bignum functions <--- */
/* init a bignum */
@@ -256,8 +242,9 @@ int mp_init_size(mp_int *a, int size);
/* ---> Basic Manipulations <--- */
#define mp_iszero(a) (((a)->used == 0) ? MP_YES : MP_NO)
#define mp_iseven(a) (((a)->used == 0 || (((a)->dp[0] & 1) == 0)) ? MP_YES : MP_NO)
#define mp_isodd(a) (((a)->used > 0 && (((a)->dp[0] & 1) == 1)) ? MP_YES : MP_NO)
#define mp_iseven(a) ((((a)->used == 0) || (((a)->dp[0] & 1u) == 0u)) ? MP_YES : MP_NO)
#define mp_isodd(a) ((((a)->used > 0) && (((a)->dp[0] & 1u) == 1u)) ? MP_YES : MP_NO)
#define mp_isneg(a) (((a)->sign != MP_ZPOS) ? MP_YES : MP_NO)
/* set to zero */
/*
@@ -274,9 +261,25 @@ void mp_set(mp_int *a, mp_digit b);
int mp_set_int(mp_int *a, unsigned long b);
*/
/* set a platform dependent unsigned long value */
/*
int mp_set_long(mp_int *a, unsigned long b);
*/
/* set a platform dependent unsigned long long value */
/*
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);
/* get a platform dependent unsigned long value */
unsigned long mp_get_long(mp_int * a);
/* get a platform dependent unsigned long long value */
unsigned long long mp_get_long_long(mp_int * a);
/* initialize and set a digit */
/*
int mp_init_set (mp_int * a, mp_digit b);
@@ -294,7 +297,7 @@ int mp_copy(const mp_int *a, mp_int *b);
/* inits and copies, a = b */
/*
int mp_init_copy(mp_int *a, mp_int *b);
int mp_init_copy(mp_int *a, const mp_int *b);
*/
/* trim unused digits */
@@ -302,6 +305,16 @@ int mp_init_copy(mp_int *a, mp_int *b);
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);
*/
/* export binary data */
/*
int mp_export(void* rop, size_t* countp, int order, size_t size, int endian, size_t nails, mp_int* op);
*/
/* ---> digit manipulation <--- */
/* right shift by "b" digits */
@@ -314,7 +327,7 @@ void mp_rshd(mp_int *a, int b);
int mp_lshd(mp_int *a, int b);
*/
/* c = a / 2**b */
/* c = a / 2**b, implemented as c = a >> b */
/*
int mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d);
*/
@@ -324,7 +337,7 @@ int mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d);
int mp_div_2(mp_int *a, mp_int *b);
*/
/* c = a * 2**b */
/* c = a * 2**b, implemented as c = a << b */
/*
int mp_mul_2d(const mp_int *a, int b, mp_int *c);
*/
@@ -334,7 +347,7 @@ int mp_mul_2d(const mp_int *a, int b, mp_int *c);
int mp_mul_2(mp_int *a, mp_int *b);
*/
/* c = a mod 2**d */
/* c = a mod 2**b */
/*
int mp_mod_2d(const mp_int *a, int b, mp_int *c);
*/
@@ -346,7 +359,7 @@ int mp_2expt(mp_int *a, int b);
/* Counts the number of lsbs which are zero before the first zero bit */
/*
int mp_cnt_lsb(mp_int *a);
int mp_cnt_lsb(const mp_int *a);
*/
/* I Love Earth! */
@@ -460,6 +473,9 @@ int mp_div_3(mp_int *a, mp_int *c, mp_digit *d);
/*
int mp_expt_d(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);
*/
/* c = a mod b, 0 <= c < b */
/*
@@ -515,12 +531,20 @@ int mp_lcm(mp_int *a, mp_int *b, mp_int *c);
/*
int mp_n_root(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);
*/
/* special sqrt algo */
/*
int mp_sqrt(mp_int *arg, mp_int *ret);
*/
/* special sqrt (mod prime) */
/*
int mp_sqrtmod_prime(mp_int *arg, mp_int *prime, mp_int *ret);
*/
/* is number a square? */
/*
int mp_is_square(mp_int *arg, int *ret);
@@ -623,7 +647,7 @@ int mp_exptmod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
/* table of first PRIME_SIZE primes */
#if defined(BUILD_tcl) || !defined(_WIN32)
MODULE_SCOPE const mp_digit ltm_prime_tab[];
MODULE_SCOPE const mp_digit ltm_prime_tab[PRIME_SIZE];
#endif
/* result=1 if a is divisible by one of the first PRIME_SIZE primes */
@@ -646,7 +670,7 @@ int mp_prime_miller_rabin(mp_int *a, mp_int *b, int *result);
*/
/* This gives [for a given bit size] the number of trials required
* such that Miller-Rabin gives a prob of failure lower than 2^-96
* such that Miller-Rabin gives a prob of failure lower than 2^-96
*/
/*
int mp_prime_rabin_miller_trials(int size);
@@ -673,7 +697,7 @@ int mp_prime_next_prime(mp_int *a, int t, int bbs_style);
*/
/* makes a truly random prime of a given size (bytes),
* call with bbs = 1 if you want it to be congruent to 3 mod 4
* call with bbs = 1 if you want it to be congruent to 3 mod 4
*
* You have to supply a callback which fills in a buffer with random bytes. "dat" is a parameter you can
* have passed to the callback (e.g. a state or something). This function doesn't use "dat" itself
@@ -686,10 +710,9 @@ int mp_prime_next_prime(mp_int *a, int t, int bbs_style);
/* makes a truly random prime of a given size (bits),
*
* Flags are as follows:
*
*
* LTM_PRIME_BBS - make prime congruent to 3 mod 4
* LTM_PRIME_SAFE - make sure (p-1)/2 is prime as well (implies LTM_PRIME_BBS)
* LTM_PRIME_2MSB_OFF - make the 2nd highest bit zero
* LTM_PRIME_2MSB_ON - make the 2nd highest bit one
*
* You have to supply a callback which fills in a buffer with random bytes. "dat" is a parameter you can
@@ -742,15 +765,17 @@ int mp_toradix(mp_int *a, char *str, int radix);
int mp_toradix_n(mp_int * a, char *str, int radix, int maxlen);
*/
/*
int mp_radix_size(mp_int *a, int radix, int *size);
int mp_radix_size(const mp_int *a, int radix, int *size);
*/
#ifndef LTM_NO_FILE
/*
int mp_fread(mp_int *a, int radix, FILE *stream);
*/
/*
int mp_fwrite(mp_int *a, int radix, FILE *stream);
*/
#endif
#define mp_read_raw(mp, str, len) mp_read_signed_bin((mp), (str), (len))
#define mp_raw_size(mp) mp_signed_bin_size(mp)
@@ -764,69 +789,14 @@ int mp_fwrite(mp_int *a, int radix, FILE *stream);
#define mp_todecimal(M, S) mp_toradix((M), (S), 10)
#define mp_tohex(M, S) mp_toradix((M), (S), 16)
/* lowlevel functions, do not call! */
/*
int s_mp_add(mp_int *a, mp_int *b, mp_int *c);
*/
/*
int s_mp_sub(mp_int *a, mp_int *b, mp_int *c);
*/
#define s_mp_mul(a, b, c) s_mp_mul_digs(a, b, c, (a)->used + (b)->used + 1)
/*
int fast_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
*/
/*
int s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
*/
/*
int fast_s_mp_mul_high_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
*/
/*
int s_mp_mul_high_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
*/
/*
int fast_s_mp_sqr(mp_int *a, mp_int *b);
*/
/*
int s_mp_sqr(mp_int *a, mp_int *b);
*/
/*
int mp_karatsuba_mul(mp_int *a, mp_int *b, mp_int *c);
*/
/*
int mp_toom_mul(mp_int *a, mp_int *b, mp_int *c);
*/
/*
int mp_karatsuba_sqr(mp_int *a, mp_int *b);
*/
/*
int mp_toom_sqr(mp_int *a, mp_int *b);
*/
/*
int fast_mp_invmod(mp_int *a, mp_int *b, mp_int *c);
*/
/*
int mp_invmod_slow (mp_int * a, mp_int * b, mp_int * c);
*/
/*
int fast_mp_montgomery_reduce(mp_int *a, mp_int *m, mp_digit mp);
*/
/*
int mp_exptmod_fast(mp_int *G, mp_int *X, mp_int *P, mp_int *Y, int mode);
*/
/*
int s_mp_exptmod (mp_int * G, mp_int * X, mp_int * P, mp_int * Y, int mode);
*/
/*
void bn_reverse(unsigned char *s, int len);
*/
#if defined(BUILD_tcl) || !defined(_WIN32)
MODULE_SCOPE const char *mp_s_rmap;
#endif
#ifdef __cplusplus
}
}
#endif
#endif
/* $Source$ */
/* $Revision$ */
/* $Date$ */
+12 -4
View File
@@ -73,6 +73,7 @@
#define mp_div_d TclBN_mp_div_d
#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_grow TclBN_mp_grow
#define mp_init TclBN_mp_init
#define mp_init_copy TclBN_mp_init_copy
@@ -190,7 +191,7 @@ EXTERN int TclBN_mp_grow(mp_int *a, int size);
/* 21 */
EXTERN int TclBN_mp_init(mp_int *a);
/* 22 */
EXTERN int TclBN_mp_init_copy(mp_int *a, mp_int *b);
EXTERN int TclBN_mp_init_copy(mp_int *a, const mp_int *b);
/* 23 */
EXTERN int TclBN_mp_init_multi(mp_int *a, ...);
/* 24 */
@@ -216,7 +217,8 @@ 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);
/* 35 */
EXTERN int TclBN_mp_radix_size(mp_int *a, int radix, int *size);
EXTERN int TclBN_mp_radix_size(const mp_int *a, int radix,
int *size);
/* 36 */
EXTERN int TclBN_mp_read_radix(mp_int *a, const char *str,
int radix);
@@ -287,6 +289,9 @@ EXTERN void TclBNInitBignumFromWideInt(mp_int *bignum,
/* 66 */
EXTERN 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);
typedef struct TclTomMathStubs {
int magic;
@@ -314,7 +319,7 @@ typedef struct TclTomMathStubs {
int (*tclBN_mp_expt_d) (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, mp_int *b); /* 22 */
int (*tclBN_mp_init_copy) (mp_int *a, const mp_int *b); /* 22 */
int (*tclBN_mp_init_multi) (mp_int *a, ...); /* 23 */
int (*tclBN_mp_init_set) (mp_int *a, mp_digit b); /* 24 */
int (*tclBN_mp_init_size) (mp_int *a, int size); /* 25 */
@@ -327,7 +332,7 @@ typedef struct TclTomMathStubs {
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_radix_size) (mp_int *a, int radix, int *size); /* 35 */
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 */
@@ -359,6 +364,7 @@ typedef struct TclTomMathStubs {
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 */
} TclTomMathStubs;
extern const TclTomMathStubs *tclTomMathStubsPtr;
@@ -507,6 +513,8 @@ extern const TclTomMathStubs *tclTomMathStubsPtr;
(tclTomMathStubsPtr->tclBNInitBignumFromWideInt) /* 65 */
#define TclBNInitBignumFromWideUInt \
(tclTomMathStubsPtr->tclBNInitBignumFromWideUInt) /* 66 */
#define TclBN_mp_expt_d_ex \
(tclTomMathStubsPtr->tclBN_mp_expt_d_ex) /* 67 */
#endif /* defined(USE_TCL_STUBS) */
+1 -1
View File
@@ -52,7 +52,7 @@ typedef struct {
* invoked step trace */
int curFlags; /* Trace flags for the current command */
int curCode; /* Return code for the current 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. */
+13 -14
View File
@@ -2953,7 +2953,7 @@ Tcl_DStringGetResult(
dsPtr->length = 0;
dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
} else {
dsPtr->string = Tcl_GetString(iPtr->objResultPtr);
dsPtr->string = TclGetString(iPtr->objResultPtr);
dsPtr->length = iPtr->objResultPtr->length;
dsPtr->spaceAvl = dsPtr->length + 1;
TclFreeIntRep(iPtr->objResultPtr);
@@ -3639,7 +3639,7 @@ TclGetIntForIndex(
parseError:
if (interp != NULL) {
bytes = Tcl_GetString(objPtr);
bytes = TclGetString(objPtr);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad index \"%s\": must be integer?[+-]integer? or"
" end?[+-]integer?", bytes));
@@ -4000,9 +4000,10 @@ TclSetProcessGlobalValue(
} else {
Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr);
}
bytes = TclGetStringFromObj(newValue, &pgvPtr->numBytes);
bytes = TclGetString(newValue);
pgvPtr->numBytes = newValue->length;
pgvPtr->value = ckalloc(pgvPtr->numBytes + 1);
memcpy(pgvPtr->value, bytes, (unsigned) pgvPtr->numBytes + 1);
memcpy(pgvPtr->value, bytes, pgvPtr->numBytes + 1);
if (pgvPtr->encoding) {
Tcl_FreeEncoding(pgvPtr->encoding);
}
@@ -4017,7 +4018,7 @@ TclSetProcessGlobalValue(
Tcl_IncrRefCount(newValue);
cacheMap = GetThreadHash(&pgvPtr->key);
ClearHash(cacheMap);
hPtr = Tcl_CreateHashEntry(cacheMap, INT2PTR(pgvPtr->epoch), &dummy);
hPtr = Tcl_CreateHashEntry(cacheMap, (void *)(pgvPtr->epoch), &dummy);
Tcl_SetHashValue(hPtr, newValue);
Tcl_MutexUnlock(&pgvPtr->mutex);
}
@@ -4043,7 +4044,7 @@ TclGetProcessGlobalValue(
Tcl_Obj *value = NULL;
Tcl_HashTable *cacheMap;
Tcl_HashEntry *hPtr;
int epoch = pgvPtr->epoch;
size_t epoch = pgvPtr->epoch;
if (pgvPtr->encoding) {
Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL);
@@ -4058,8 +4059,7 @@ TclGetProcessGlobalValue(
Tcl_DString native, newValue;
Tcl_MutexLock(&pgvPtr->mutex);
pgvPtr->epoch++;
epoch = pgvPtr->epoch;
epoch = ++pgvPtr->epoch;
Tcl_UtfToExternalDString(pgvPtr->encoding, pgvPtr->value,
pgvPtr->numBytes, &native);
Tcl_ExternalToUtfDString(current, Tcl_DStringValue(&native),
@@ -4078,7 +4078,7 @@ TclGetProcessGlobalValue(
}
}
cacheMap = GetThreadHash(&pgvPtr->key);
hPtr = Tcl_FindHashEntry(cacheMap, (char *) INT2PTR(epoch));
hPtr = Tcl_FindHashEntry(cacheMap, (void *) (epoch));
if (NULL == hPtr) {
int dummy;
@@ -4111,7 +4111,7 @@ TclGetProcessGlobalValue(
value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes);
hPtr = Tcl_CreateHashEntry(cacheMap,
INT2PTR(pgvPtr->epoch), &dummy);
(void *)(pgvPtr->epoch), &dummy);
Tcl_MutexUnlock(&pgvPtr->mutex);
Tcl_SetHashValue(hPtr, value);
Tcl_IncrRefCount(value);
@@ -4194,11 +4194,10 @@ TclGetObjNameOfExecutable(void)
const char *
Tcl_GetNameOfExecutable(void)
{
int numBytes;
const char *bytes =
Tcl_GetStringFromObj(TclGetObjNameOfExecutable(), &numBytes);
Tcl_Obj *obj = TclGetObjNameOfExecutable();
const char *bytes = TclGetString(obj);
if (numBytes == 0) {
if (obj->length == 0) {
return NULL;
}
return bytes;
+330 -42
View File
@@ -143,37 +143,13 @@ static const char *isArrayElement =
#define HasLocalVars(framePtr) ((framePtr)->isProcCallFrame & FRAME_IS_PROC)
/*
* The following structure describes an enumerative search in progress on an
* array variable; this are invoked with options to the "array" command.
*/
typedef struct ArraySearch {
Tcl_Obj *name; /* Name of this search */
int id; /* Integer id used to distinguish among
* multiple concurrent searches for the same
* array. */
struct Var *varPtr; /* Pointer to array variable that's being
* searched. */
Tcl_HashSearch search; /* Info kept by the hash module about progress
* through the array. */
Tcl_HashEntry *nextEntry; /* Non-null means this is the next element to
* be enumerated (it's leftover from the
* Tcl_FirstHashEntry call or from an "array
* anymore" command). NULL means must call
* Tcl_NextHashEntry to get value to
* return. */
struct ArraySearch *nextPtr;/* Next in list of all active searches for
* this variable, or NULL if this is the last
* one. */
} ArraySearch;
/*
* Forward references to functions defined later in this file:
*/
static void AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
Tcl_Obj *patternPtr, int includeLinks);
static Tcl_NRPostProc ArrayForLoopCallback;
static void DeleteSearches(Interp *iPtr, Var *arrayVarPtr);
static void DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr,
Var *varPtr, int flags, int index);
@@ -184,7 +160,7 @@ static int ObjMakeUpvar(Tcl_Interp *interp,
CallFrame *framePtr, Tcl_Obj *otherP1Ptr,
const char *otherP2, const int otherFlags,
Tcl_Obj *myNamePtr, int myFlags, int index);
static ArraySearch * ParseSearchId(Tcl_Interp *interp, const Var *varPtr,
static Tcl_ArraySearch * ParseSearchId(Tcl_Interp *interp, const Var *varPtr,
Tcl_Obj *varNamePtr, Tcl_Obj *handleObj);
static void UnsetVarStruct(Var *varPtr, Var *arrayPtr,
Interp *iPtr, Tcl_Obj *part1Ptr,
@@ -2754,7 +2730,7 @@ TclArraySet(
} else {
/*
* Not a dictionary, so assume (and convert to, for backward-
* -compatability reasons) a list.
* -compatibility reasons) a list.
*/
int elemLen;
@@ -2828,6 +2804,315 @@ TclArraySet(
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ArrayForNRCmd --
* ArrayForLoopCallback
*
* These functions implement the "array for" Tcl command.
* array for {k} a {}
* array for {k v} a {}
* The array for command iterates over the array, setting the
* the specified loop variables, and executing the body each iteration.
*
* ArrayForNRCmd() sets up the Tcl_ArraySearch structure, sets arrayNamePtr
* inside the structure and calls VarHashFirstEntry to start the hash
* iteration.
*
* ArrayForNRCmd() does not execute the body or set the loop variables,
* it only initializes the iterator.
*
* ArrayForLoopCallback() iterates over the entire array, executing
* the body each time.
*
*----------------------------------------------------------------------
*/
static int
ArrayForNRCmd(
ClientData dummy,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
Tcl_Obj **varv;
Tcl_Obj *arrayNameObj;
Tcl_ArraySearch *searchPtr = NULL;
Var *varPtr;
Var *arrayPtr;
int varc;
/*
* array for {k} a body
* array for {k v} a body
*/
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv,
"{keyVarName ?valueVarName?} array script");
return TCL_ERROR;
}
/*
* Parse arguments.
*/
if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) {
return TCL_ERROR;
}
if (varc < 1 || varc > 2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"must have one or two variable names", -1));
Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "array", "for", NULL);
return TCL_ERROR;
}
arrayNameObj = objv[2];
keyVarObj = varv[0];
valueVarObj = (varc < 2 ? NULL : varv[1]);
scriptObj = objv[3];
/*
* Locate the array variable.
*/
varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL, /*flags*/ 0,
/*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
/*
* Special array trace used to keep the env array in sync for array names,
* array get, etc.
*/
if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
&& (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, arrayNameObj, NULL,
(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
return TCL_ERROR;
}
}
/*
* Verify that it is indeed an array variable. This test comes after the
* traces; the variable may actually become an array as an effect of said
* traces.
*/
if ((varPtr == NULL) || !TclIsVarArray(varPtr)
|| TclIsVarUndefined(varPtr)) {
const char *varName = Tcl_GetString(arrayNameObj);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" isn't an array", varName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", varName, NULL);
return TCL_ERROR;
}
/*
* Make a new array search, put it on the stack.
*/
searchPtr = TclStackAlloc(interp, sizeof(Tcl_ArraySearch));
Tcl_ArrayObjFirst(interp, arrayNameObj, searchPtr);
/*
* Make sure that these objects (which we need throughout the body of the
* loop) don't vanish.
*/
Tcl_IncrRefCount(keyVarObj);
if (valueVarObj != NULL) {
Tcl_IncrRefCount(valueVarObj);
}
Tcl_IncrRefCount(scriptObj);
/*
* Run the script.
*/
TclNRAddCallback(interp, ArrayForLoopCallback, searchPtr, keyVarObj,
valueVarObj, scriptObj);
return TCL_OK;
}
/*
* Tcl_ArrayObjFirst
*
* Does not execute the body or set the key/value variables.
*
*/
void
Tcl_ArrayObjFirst(
Tcl_Interp *interp,
Tcl_Obj *arrayObj,
Tcl_ArraySearch *searchPtr)
{
Var *varPtr;
Var *arrayPtr;
searchPtr->id = 1;
/*
* Do not turn on VAR_SEARCH_ACTIVE in varPtr->flags. This search is not
* stored in the search list.
*/
searchPtr->nextPtr = NULL;
varPtr = TclObjLookupVarEx(interp, arrayObj, NULL, /*flags*/ 0,
/*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
searchPtr->varPtr = varPtr;
searchPtr->arrayNameObj = arrayObj;
searchPtr->flags = TCL_ARRAYSEARCH_FOR_VALUE;
searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr,
&searchPtr->search);
}
int
Tcl_ArrayObjNext(
Tcl_Interp *interp,
Tcl_ArraySearch *searchPtr,
Tcl_Obj **keyPtrPtr, /* Pointer to a variable to have the key
* written into, or NULL. */
Tcl_Obj **valuePtrPtr /* Pointer to a variable to have the
* value written into, or NULL.*/
)
{
Tcl_Obj *keyObj;
Tcl_Obj *valueObj = NULL;
Var *varPtr;
int gotValue;
int donerc;
donerc = 1;
gotValue = 0;
while (1) {
Tcl_HashEntry *hPtr = searchPtr->nextEntry;
/*
* The only time hPtr will be non-NULL is when first started.
* nextEntry is set by the Tcl_FirstHashEntry call in the
* call to Tcl_ArrayObjFirst from ArrayForNRCmd.
*/
if (hPtr != NULL) {
searchPtr->nextEntry = NULL;
} else {
hPtr = Tcl_NextHashEntry(&searchPtr->search);
if (hPtr == NULL) {
gotValue = 0;
break;
}
}
varPtr = VarHashGetValue(hPtr);
if (!TclIsVarUndefined(varPtr)) {
gotValue = 1;
break;
}
}
if (!gotValue) {
donerc = 1;
return donerc;
}
donerc = 0;
keyObj = VarHashGetKey(varPtr);
*keyPtrPtr = keyObj;
*valuePtrPtr = NULL;
if (searchPtr->flags & TCL_ARRAYSEARCH_FOR_VALUE) {
valueObj = Tcl_ObjGetVar2(interp, searchPtr->arrayNameObj,
keyObj, TCL_LEAVE_ERR_MSG);
*valuePtrPtr = valueObj;
}
return donerc;
}
static int
ArrayForLoopCallback(
ClientData data[],
Tcl_Interp *interp,
int result)
{
Interp *iPtr = (Interp *) interp;
Tcl_ArraySearch *searchPtr = data[0];
Tcl_Obj *keyObj, *valueObj;
Tcl_Obj *keyVarObj = data[1];
Tcl_Obj *valueVarObj = data[2];
Tcl_Obj *scriptObj = data[3];
int done;
/*
* Process the result from the previous execution of the script body.
*/
if (result == TCL_CONTINUE) {
result = TCL_OK;
} else if (result != TCL_OK) {
if (result == TCL_BREAK) {
Tcl_ResetResult(interp);
result = TCL_OK;
} else if (result == TCL_ERROR) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (\"array for\" body line %d)",
Tcl_GetErrorLine(interp)));
}
goto done;
}
/*
* Get the next mapping from the array.
*/
keyObj = NULL;
valueObj = NULL;
if (valueVarObj != NULL) {
valueObj = Tcl_NewObj();
}
done = Tcl_ArrayObjNext (interp, searchPtr, &keyObj, &valueObj);
result = TCL_OK;
if (done) {
Tcl_ResetResult(interp);
goto done;
}
if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) {
result = TCL_ERROR;
goto done;
}
if (valueVarObj != NULL) {
if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) {
result = TCL_ERROR;
goto done;
}
}
/*
* Run the script.
*/
TclNRAddCallback(interp, ArrayForLoopCallback, searchPtr, keyVarObj,
valueVarObj, scriptObj);
return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
/*
* For unwinding everything once the iterating is done.
*/
done:
TclDecrRefCount(keyVarObj);
if (valueVarObj != NULL) {
TclDecrRefCount(valueVarObj);
}
TclDecrRefCount(scriptObj);
TclStackFree(interp, searchPtr);
return result;
}
/*
*----------------------------------------------------------------------
*
@@ -2905,7 +3190,7 @@ ArrayStartSearchCmd(
Var *varPtr;
Tcl_HashEntry *hPtr;
int isNew;
ArraySearch *searchPtr;
Tcl_ArraySearch *searchPtr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
@@ -2921,17 +3206,19 @@ ArrayStartSearchCmd(
* Make a new array search with a free name.
*/
searchPtr = ckalloc(sizeof(ArraySearch));
searchPtr = ckalloc(sizeof(Tcl_ArraySearch));
hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, varPtr, &isNew);
if (isNew) {
searchPtr->id = 1;
varPtr->flags |= VAR_SEARCH_ACTIVE;
searchPtr->nextPtr = NULL;
} else {
searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1;
searchPtr->nextPtr = Tcl_GetHashValue(hPtr);
searchPtr->id = ((Tcl_ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1;
searchPtr->nextPtr = (Tcl_ArraySearch *) Tcl_GetHashValue(hPtr);
}
searchPtr->varPtr = varPtr;
searchPtr->arrayNameObj = NULL;
searchPtr->flags = 0;
searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr,
&searchPtr->search);
Tcl_SetHashValue(hPtr, searchPtr);
@@ -2970,7 +3257,7 @@ ArrayAnyMoreCmd(
Var *varPtr;
Tcl_Obj *varNameObj, *searchObj;
int gotValue;
ArraySearch *searchPtr;
Tcl_ArraySearch *searchPtr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
@@ -3044,7 +3331,7 @@ ArrayNextElementCmd(
{
Var *varPtr;
Tcl_Obj *varNameObj, *searchObj;
ArraySearch *searchPtr;
Tcl_ArraySearch *searchPtr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
@@ -3123,7 +3410,7 @@ ArrayDoneSearchCmd(
Var *varPtr;
Tcl_HashEntry *hPtr;
Tcl_Obj *varNameObj, *searchObj;
ArraySearch *searchPtr, *prevPtr;
Tcl_ArraySearch *searchPtr, *prevPtr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
@@ -3152,7 +3439,7 @@ ArrayDoneSearchCmd(
*/
hPtr = Tcl_FindHashEntry(&iPtr->varSearches, varPtr);
if (searchPtr == Tcl_GetHashValue(hPtr)) {
if (searchPtr == (Tcl_ArraySearch *) Tcl_GetHashValue(hPtr)) {
if (searchPtr->nextPtr) {
Tcl_SetHashValue(hPtr, searchPtr->nextPtr);
} else {
@@ -3160,7 +3447,7 @@ ArrayDoneSearchCmd(
Tcl_DeleteHashEntry(hPtr);
}
} else {
for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) {
for (prevPtr= (Tcl_ArraySearch *) Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) {
if (prevPtr->nextPtr == searchPtr) {
prevPtr->nextPtr = searchPtr->nextPtr;
break;
@@ -4026,6 +4313,7 @@ TclInitArrayCmd(
{"anymore", ArrayAnyMoreCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"donesearch", ArrayDoneSearchCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"exists", ArrayExistsCmd, TclCompileArrayExistsCmd, NULL, NULL, 0},
{"for", NULL, TclCompileArrayForCmd, ArrayForNRCmd, NULL, 0},
{"get", ArrayGetCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
{"names", ArrayNamesCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
{"nextelement", ArrayNextElementCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
@@ -4820,7 +5108,7 @@ Tcl_UpvarObjCmd(
*----------------------------------------------------------------------
*/
static ArraySearch *
static Tcl_ArraySearch *
ParseSearchId(
Tcl_Interp *interp, /* Interpreter containing variable. */
const Var *varPtr, /* Array variable search is for. */
@@ -4832,7 +5120,7 @@ ParseSearchId(
* name. */
{
Interp *iPtr = (Interp *) interp;
ArraySearch *searchPtr;
Tcl_ArraySearch *searchPtr;
const char *handle = TclGetString(handleObj);
char *end;
@@ -4841,14 +5129,14 @@ ParseSearchId(
Tcl_FindHashEntry(&iPtr->varSearches, varPtr);
/* First look for same (Tcl_Obj *) */
for (searchPtr = Tcl_GetHashValue(hPtr); searchPtr != NULL;
for (searchPtr = (Tcl_ArraySearch *) Tcl_GetHashValue(hPtr); searchPtr != NULL;
searchPtr = searchPtr->nextPtr) {
if (searchPtr->name == handleObj) {
return searchPtr;
}
}
/* Fallback: do string compares. */
for (searchPtr = Tcl_GetHashValue(hPtr); searchPtr != NULL;
for (searchPtr = (Tcl_ArraySearch *) Tcl_GetHashValue(hPtr); searchPtr != NULL;
searchPtr = searchPtr->nextPtr) {
if (strcmp(TclGetString(searchPtr->name), handle) == 0) {
return searchPtr;
@@ -4895,12 +5183,12 @@ DeleteSearches(
register Var *arrayVarPtr) /* Variable whose searches are to be
* deleted. */
{
ArraySearch *searchPtr, *nextPtr;
Tcl_ArraySearch *searchPtr, *nextPtr;
Tcl_HashEntry *sPtr;
if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
sPtr = Tcl_FindHashEntry(&iPtr->varSearches, arrayVarPtr);
for (searchPtr = Tcl_GetHashValue(sPtr); searchPtr != NULL;
for (searchPtr = (Tcl_ArraySearch *) Tcl_GetHashValue(sPtr); searchPtr != NULL;
searchPtr = nextPtr) {
nextPtr = searchPtr->nextPtr;
Tcl_DecrRefCount(searchPtr->name);
+88 -63
View File
@@ -177,6 +177,8 @@ static Tcl_ObjCmdProc ZlibStreamPutCmd;
static void ConvertError(Tcl_Interp *interp, int code,
uLong adler);
static Tcl_Obj * ConvertErrorToList(int code, uLong adler);
static inline int Deflate(z_streamp strm, void *bufferPtr,
int bufferSize, int flush, int *writtenPtr);
static void ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj);
static int GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj,
GzipHeader *headerPtr, int *extraSizePtr);
@@ -578,6 +580,10 @@ ExtractHeader(
}
}
/*
* Disentangle the worst of how the zlib API is used.
*/
static int
SetInflateDictionary(
z_streamp strm,
@@ -605,6 +611,38 @@ SetDeflateDictionary(
}
return Z_OK;
}
static inline int
Deflate(
z_streamp strm,
void *bufferPtr,
int bufferSize,
int flush,
int *writtenPtr)
{
int e;
strm->next_out = (Bytef *) bufferPtr;
strm->avail_out = (unsigned) bufferSize;
e = deflate(strm, flush);
if (writtenPtr != NULL) {
*writtenPtr = bufferSize - strm->avail_out;
}
return e;
}
static inline void
AppendByteArray(
Tcl_Obj *listObj,
void *buffer,
int size)
{
if (size > 0) {
Tcl_Obj *baObj = Tcl_NewByteArrayObj((unsigned char *) buffer, size);
Tcl_ListObjAppendElement(NULL, listObj, baObj);
}
}
/*
*----------------------------------------------------------------------
@@ -1139,6 +1177,8 @@ Tcl_ZlibStreamSetCompressionDictionary(
*----------------------------------------------------------------------
*/
#define BUFFER_SIZE_LIMIT 0xFFFF
int
Tcl_ZlibStreamPut(
Tcl_ZlibStream zshandle, /* As obtained from Tcl_ZlibStreamInit */
@@ -1148,8 +1188,7 @@ Tcl_ZlibStreamPut(
{
ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
char *dataTmp = NULL;
int e, size, outSize;
Tcl_Obj *obj;
int e, size, outSize, toStore;
if (zshPtr->streamEnd) {
if (zshPtr->interp) {
@@ -1175,26 +1214,45 @@ Tcl_ZlibStreamPut(
if (HaveDictToSet(zshPtr)) {
e = SetDeflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
if (e != Z_OK) {
if (zshPtr->interp) {
ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
}
ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
return TCL_ERROR;
}
DictWasSet(zshPtr);
}
/*
* Deflatebound doesn't seem to take various header sizes into
* account, so we add 100 extra bytes.
* deflateBound() doesn't seem to take various header sizes into
* account, so we add 100 extra bytes. However, we can also loop
* around again so we also set an upper bound on the output buffer
* size.
*/
outSize = deflateBound(&zshPtr->stream, zshPtr->stream.avail_in)+100;
zshPtr->stream.avail_out = outSize;
dataTmp = ckalloc(zshPtr->stream.avail_out);
zshPtr->stream.next_out = (Bytef *) dataTmp;
outSize = deflateBound(&zshPtr->stream, size) + 100;
if (outSize > BUFFER_SIZE_LIMIT) {
outSize = BUFFER_SIZE_LIMIT;
}
dataTmp = ckalloc(outSize);
while (1) {
e = Deflate(&zshPtr->stream, dataTmp, outSize, flush, &toStore);
/*
* Test if we've filled the buffer up and have to ask deflate() to
* give us some more. Note that the condition for needing to
* repeat a buffer transfer when the result is Z_OK is whether
* there is no more space in the buffer we provided; the zlib
* library does not necessarily return a different code in that
* case. [Bug b26e38a3e4] [Tk Bug 10f2e7872b]
*/
if ((e != Z_BUF_ERROR) && (e != Z_OK || toStore < outSize)) {
if ((e == Z_OK) || (flush == Z_FINISH && e == Z_STREAM_END)) {
break;
}
ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
return TCL_ERROR;
}
e = deflate(&zshPtr->stream, flush);
while (e == Z_BUF_ERROR || (flush == Z_FINISH && e == Z_OK)) {
/*
* Output buffer too small to hold the data being generated or we
* are doing the end-of-stream flush (which can spit out masses of
@@ -1202,45 +1260,21 @@ Tcl_ZlibStreamPut(
* saving the old generated data to the outData list.
*/
obj = Tcl_NewByteArrayObj((unsigned char *) dataTmp, outSize);
Tcl_ListObjAppendElement(NULL, zshPtr->outData, obj);
AppendByteArray(zshPtr->outData, dataTmp, outSize);
if (outSize < 0xFFFF) {
outSize = 0xFFFF; /* There may be *lots* of data left to
* output... */
if (outSize < BUFFER_SIZE_LIMIT) {
outSize = BUFFER_SIZE_LIMIT;
/* There may be *lots* of data left to output... */
dataTmp = ckrealloc(dataTmp, outSize);
}
zshPtr->stream.avail_out = outSize;
zshPtr->stream.next_out = (Bytef *) dataTmp;
e = deflate(&zshPtr->stream, flush);
}
if (e != Z_OK && !(flush==Z_FINISH && e==Z_STREAM_END)) {
if (zshPtr->interp) {
ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
}
return TCL_ERROR;
}
/*
* And append the final data block.
* And append the final data block to the outData list.
*/
if (outSize - zshPtr->stream.avail_out > 0) {
obj = Tcl_NewByteArrayObj((unsigned char *) dataTmp,
outSize - zshPtr->stream.avail_out);
/*
* Now append the compressed data to the outData list.
*/
Tcl_ListObjAppendElement(NULL, zshPtr->outData, obj);
}
if (dataTmp) {
ckfree(dataTmp);
}
AppendByteArray(zshPtr->outData, dataTmp, toStore);
ckfree(dataTmp);
} else {
/*
* This is easy. Just append to the inData list.
@@ -1356,9 +1390,7 @@ Tcl_ZlibStreamGet(
if (IsRawStream(zshPtr) && HaveDictToSet(zshPtr)) {
e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
if (e != Z_OK) {
if (zshPtr->interp) {
ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
}
ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
return TCL_ERROR;
}
DictWasSet(zshPtr);
@@ -2879,10 +2911,8 @@ ZlibTransformClose(
if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
cd->outStream.avail_in = 0;
do {
cd->outStream.next_out = (Bytef *) cd->outBuffer;
cd->outStream.avail_out = (unsigned) cd->outAllocated;
e = deflate(&cd->outStream, Z_FINISH);
written = cd->outAllocated - cd->outStream.avail_out;
e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated,
Z_FINISH, &written);
/*
* Can't be sure that deflate() won't declare the buffer to be
@@ -3086,17 +3116,15 @@ ZlibTransformOutput(
cd->outStream.next_in = (Bytef *) buf;
cd->outStream.avail_in = toWrite;
do {
cd->outStream.next_out = (Bytef *) cd->outBuffer;
cd->outStream.avail_out = cd->outAllocated;
e = deflate(&cd->outStream, Z_NO_FLUSH);
produced = cd->outAllocated - cd->outStream.avail_out;
e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated,
Z_NO_FLUSH, &produced);
if ((e == Z_OK && produced > 0) || e == Z_BUF_ERROR) {
/*
* deflate() indicates that it is out of space by returning
* Z_BUF_ERROR; in that case, we must write the whole buffer out
* and retry to compress what is left.
* Z_BUF_ERROR *or* by simply returning Z_OK with no remaining
* space; in either case, we must write the whole buffer out and
* retry to compress what is left.
*/
if (e == Z_BUF_ERROR) {
@@ -3149,10 +3177,8 @@ ZlibTransformFlush(
* Get the bytes to go out of the compression engine.
*/
cd->outStream.next_out = (Bytef *) cd->outBuffer;
cd->outStream.avail_out = cd->outAllocated;
e = deflate(&cd->outStream, flushType);
e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated,
flushType, &len);
if (e != Z_OK && e != Z_BUF_ERROR) {
ConvertError(interp, e, cd->outStream.adler);
return TCL_ERROR;
@@ -3162,7 +3188,6 @@ ZlibTransformFlush(
* Write the bytes we've received to the next layer.
*/
len = cd->outStream.next_out - (Bytef *) cd->outBuffer;
if (len > 0 && Tcl_WriteRaw(cd->parent, cd->outBuffer, len) < 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"problem flushing channel: %s",
+24
View File
@@ -56,6 +56,30 @@ proc ::history {args} {
tailcall apply {arglist {tailcall history {*}$arglist} ::tcl} $args
}
# (unnamed) --
#
# Callback when [::history] is destroyed. Destroys the implementation.
#
# Parameters:
# oldName what the command was called.
# newName what the command is now called (an empty string).
# op the operation (= delete).
#
# Results:
# none
#
# Side Effects:
# The implementation of the [::history] command ceases to exist.
trace add command ::history delete [list apply {{oldName newName op} {
variable history
unset -nocomplain history
foreach c [info procs ::tcl::Hist*] {
rename $c {}
}
rename ::tcl::history {}
} ::tcl}]
# tcl::HistAdd --
#
# Add an item to the history, and optionally eval it at the global scope
+36 -4
View File
@@ -8,10 +8,10 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
package require Tcl 8.6
package require Tcl 8.6-
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
package provide http 2.8.9
package provide http 2.8.10
namespace eval http {
# Allow resourcing to not clobber existing data
@@ -1047,7 +1047,7 @@ proc http::Event {sock token} {
fconfigure $sock -translation binary
if {
$state(-binary) || ![string match -nocase text* $state(type)]
$state(-binary) || [IsBinaryContentType $state(type)]
} {
# Turn off conversions for non-text data
set state(binary) 1
@@ -1183,6 +1183,38 @@ proc http::Event {sock token} {
}
}
# http::IsBinaryContentType --
#
# Determine if the content-type means that we should definitely transfer
# the data as binary. [Bug 838e99a76d]
#
# Arguments
# type The content-type of the data.
#
# Results:
# Boolean, true if we definitely should be binary.
proc http::IsBinaryContentType {type} {
lassign [split [string tolower $type] "/;"] major minor
if {$major eq "text"} {
return false
}
# There's a bunch of XML-as-application-format things about. See RFC 3023
# and so on.
if {$major eq "application"} {
set minor [string trimright $minor]
if {$minor in {"xml" "xml-external-parsed-entity" "xml-dtd"}} {
return false
}
}
# Not just application/foobar+xml but also image/svg+xml, so let us not
# restrict things for now...
if {[string match "*+xml" $minor]} {
return false
}
return true
}
# http::getTextLine --
#
# Get one line with the stream in blocking crlf mode
@@ -1415,7 +1447,7 @@ proc http::mapReply {string} {
set converted [string map $formMap $string]
if {[string match "*\[\u0100-\uffff\]*" $converted]} {
regexp "\[\u0100-\uffff\]" $converted badChar
# Return this error message for maximum compatability... :^/
# Return this error message for maximum compatibility... :^/
return -code error \
"can't read \"formMap($badChar)\": no such element in array"
}
+2 -2
View File
@@ -1,2 +1,2 @@
if {![package vsatisfies [package provide Tcl] 8.6]} {return}
package ifneeded http 2.8.9 [list tclPkgSetup $dir http 2.8.9 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
package ifneeded http 2.8.10 [list tclPkgSetup $dir http 2.8.10 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+1 -1
View File
@@ -11,7 +11,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
package require Tcl 8.5
package require Tcl 8.5-
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the installation directory in the Makefiles.
package provide msgcat 1.6.0
+1 -1
View File
@@ -16,7 +16,7 @@
# Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
# All rights reserved.
package require Tcl 8.5 ;# -verbose line uses [info frame]
package require Tcl 8.5- ;# -verbose line uses [info frame]
namespace eval tcltest {
# When the version number changes, be sure to update the pkgIndex.tcl file,
+1
View File
@@ -7,4 +7,5 @@ set TZData(:Antarctica/Casey) {
{1267714800 28800 0 +08}
{1319738400 39600 0 +11}
{1329843600 28800 0 +08}
{1477065600 39600 0 +11}
}
+7 -7
View File
@@ -3,11 +3,11 @@
set TZData(:Asia/Colombo) {
{-9223372036854775808 19164 0 LMT}
{-2840159964 19172 0 MMT}
{-2019705572 19800 0 IST}
{-883287000 21600 1 IHST}
{-862639200 23400 1 IST}
{-764051400 19800 0 IST}
{832962600 23400 0 LKT}
{846266400 21600 0 LKT}
{1145039400 19800 0 IST}
{-2019705572 19800 0 +0530}
{-883287000 21600 1 +06}
{-862639200 23400 1 +0630}
{-764051400 19800 0 +0530}
{832962600 23400 0 +0630}
{846266400 21600 0 +06}
{1145039400 19800 0 +0530}
}
+84 -84
View File
@@ -108,171 +108,171 @@ set TZData(:Asia/Gaza) {
{1427493600 10800 1 EEST}
{1445547600 7200 0 EET}
{1458946800 10800 1 EEST}
{1476997200 7200 0 EET}
{1477692000 7200 0 EET}
{1490396400 10800 1 EEST}
{1509051600 7200 0 EET}
{1509141600 7200 0 EET}
{1522450800 10800 1 EEST}
{1540501200 7200 0 EET}
{1540591200 7200 0 EET}
{1553900400 10800 1 EEST}
{1571950800 7200 0 EET}
{1572040800 7200 0 EET}
{1585350000 10800 1 EEST}
{1603400400 7200 0 EET}
{1604095200 7200 0 EET}
{1616799600 10800 1 EEST}
{1634850000 7200 0 EET}
{1635544800 7200 0 EET}
{1648249200 10800 1 EEST}
{1666299600 7200 0 EET}
{1666994400 7200 0 EET}
{1679698800 10800 1 EEST}
{1698354000 7200 0 EET}
{1698444000 7200 0 EET}
{1711753200 10800 1 EEST}
{1729803600 7200 0 EET}
{1729893600 7200 0 EET}
{1743202800 10800 1 EEST}
{1761253200 7200 0 EET}
{1761343200 7200 0 EET}
{1774652400 10800 1 EEST}
{1792702800 7200 0 EET}
{1793397600 7200 0 EET}
{1806102000 10800 1 EEST}
{1824152400 7200 0 EET}
{1824847200 7200 0 EET}
{1837551600 10800 1 EEST}
{1856206800 7200 0 EET}
{1856296800 7200 0 EET}
{1869606000 10800 1 EEST}
{1887656400 7200 0 EET}
{1887746400 7200 0 EET}
{1901055600 10800 1 EEST}
{1919106000 7200 0 EET}
{1919196000 7200 0 EET}
{1932505200 10800 1 EEST}
{1950555600 7200 0 EET}
{1950645600 7200 0 EET}
{1963954800 10800 1 EEST}
{1982005200 7200 0 EET}
{1982700000 7200 0 EET}
{1995404400 10800 1 EEST}
{2013454800 7200 0 EET}
{2014149600 7200 0 EET}
{2026854000 10800 1 EEST}
{2045509200 7200 0 EET}
{2045599200 7200 0 EET}
{2058908400 10800 1 EEST}
{2076958800 7200 0 EET}
{2077048800 7200 0 EET}
{2090358000 10800 1 EEST}
{2108408400 7200 0 EET}
{2108498400 7200 0 EET}
{2121807600 10800 1 EEST}
{2139858000 7200 0 EET}
{2140552800 7200 0 EET}
{2153257200 10800 1 EEST}
{2171307600 7200 0 EET}
{2172002400 7200 0 EET}
{2184706800 10800 1 EEST}
{2202757200 7200 0 EET}
{2203452000 7200 0 EET}
{2216761200 10800 1 EEST}
{2234811600 7200 0 EET}
{2234901600 7200 0 EET}
{2248210800 10800 1 EEST}
{2266261200 7200 0 EET}
{2266351200 7200 0 EET}
{2279660400 10800 1 EEST}
{2297710800 7200 0 EET}
{2297800800 7200 0 EET}
{2311110000 10800 1 EEST}
{2329160400 7200 0 EET}
{2329855200 7200 0 EET}
{2342559600 10800 1 EEST}
{2360610000 7200 0 EET}
{2361304800 7200 0 EET}
{2374009200 10800 1 EEST}
{2392664400 7200 0 EET}
{2392754400 7200 0 EET}
{2406063600 10800 1 EEST}
{2424114000 7200 0 EET}
{2424204000 7200 0 EET}
{2437513200 10800 1 EEST}
{2455563600 7200 0 EET}
{2455653600 7200 0 EET}
{2468962800 10800 1 EEST}
{2487013200 7200 0 EET}
{2487708000 7200 0 EET}
{2500412400 10800 1 EEST}
{2518462800 7200 0 EET}
{2519157600 7200 0 EET}
{2531862000 10800 1 EEST}
{2549912400 7200 0 EET}
{2550607200 7200 0 EET}
{2563311600 10800 1 EEST}
{2581966800 7200 0 EET}
{2582056800 7200 0 EET}
{2595366000 10800 1 EEST}
{2613416400 7200 0 EET}
{2613506400 7200 0 EET}
{2626815600 10800 1 EEST}
{2644866000 7200 0 EET}
{2644956000 7200 0 EET}
{2658265200 10800 1 EEST}
{2676315600 7200 0 EET}
{2677010400 7200 0 EET}
{2689714800 10800 1 EEST}
{2707765200 7200 0 EET}
{2708460000 7200 0 EET}
{2721164400 10800 1 EEST}
{2739819600 7200 0 EET}
{2739909600 7200 0 EET}
{2753218800 10800 1 EEST}
{2771269200 7200 0 EET}
{2771359200 7200 0 EET}
{2784668400 10800 1 EEST}
{2802718800 7200 0 EET}
{2802808800 7200 0 EET}
{2816118000 10800 1 EEST}
{2834168400 7200 0 EET}
{2834258400 7200 0 EET}
{2847567600 10800 1 EEST}
{2865618000 7200 0 EET}
{2866312800 7200 0 EET}
{2879017200 10800 1 EEST}
{2897067600 7200 0 EET}
{2897762400 7200 0 EET}
{2910466800 10800 1 EEST}
{2929122000 7200 0 EET}
{2929212000 7200 0 EET}
{2942521200 10800 1 EEST}
{2960571600 7200 0 EET}
{2960661600 7200 0 EET}
{2973970800 10800 1 EEST}
{2992021200 7200 0 EET}
{2992111200 7200 0 EET}
{3005420400 10800 1 EEST}
{3023470800 7200 0 EET}
{3024165600 7200 0 EET}
{3036870000 10800 1 EEST}
{3054920400 7200 0 EET}
{3055615200 7200 0 EET}
{3068319600 10800 1 EEST}
{3086370000 7200 0 EET}
{3087064800 7200 0 EET}
{3100374000 10800 1 EEST}
{3118424400 7200 0 EET}
{3118514400 7200 0 EET}
{3131823600 10800 1 EEST}
{3149874000 7200 0 EET}
{3149964000 7200 0 EET}
{3163273200 10800 1 EEST}
{3181323600 7200 0 EET}
{3181413600 7200 0 EET}
{3194722800 10800 1 EEST}
{3212773200 7200 0 EET}
{3213468000 7200 0 EET}
{3226172400 10800 1 EEST}
{3244222800 7200 0 EET}
{3244917600 7200 0 EET}
{3257622000 10800 1 EEST}
{3276277200 7200 0 EET}
{3276367200 7200 0 EET}
{3289676400 10800 1 EEST}
{3307726800 7200 0 EET}
{3307816800 7200 0 EET}
{3321126000 10800 1 EEST}
{3339176400 7200 0 EET}
{3339266400 7200 0 EET}
{3352575600 10800 1 EEST}
{3370626000 7200 0 EET}
{3371320800 7200 0 EET}
{3384025200 10800 1 EEST}
{3402075600 7200 0 EET}
{3402770400 7200 0 EET}
{3415474800 10800 1 EEST}
{3433525200 7200 0 EET}
{3434220000 7200 0 EET}
{3446924400 10800 1 EEST}
{3465579600 7200 0 EET}
{3465669600 7200 0 EET}
{3478978800 10800 1 EEST}
{3497029200 7200 0 EET}
{3497119200 7200 0 EET}
{3510428400 10800 1 EEST}
{3528478800 7200 0 EET}
{3528568800 7200 0 EET}
{3541878000 10800 1 EEST}
{3559928400 7200 0 EET}
{3560623200 7200 0 EET}
{3573327600 10800 1 EEST}
{3591378000 7200 0 EET}
{3592072800 7200 0 EET}
{3604777200 10800 1 EEST}
{3623432400 7200 0 EET}
{3623522400 7200 0 EET}
{3636831600 10800 1 EEST}
{3654882000 7200 0 EET}
{3654972000 7200 0 EET}
{3668281200 10800 1 EEST}
{3686331600 7200 0 EET}
{3686421600 7200 0 EET}
{3699730800 10800 1 EEST}
{3717781200 7200 0 EET}
{3717871200 7200 0 EET}
{3731180400 10800 1 EEST}
{3749230800 7200 0 EET}
{3749925600 7200 0 EET}
{3762630000 10800 1 EEST}
{3780680400 7200 0 EET}
{3781375200 7200 0 EET}
{3794079600 10800 1 EEST}
{3812734800 7200 0 EET}
{3812824800 7200 0 EET}
{3826134000 10800 1 EEST}
{3844184400 7200 0 EET}
{3844274400 7200 0 EET}
{3857583600 10800 1 EEST}
{3875634000 7200 0 EET}
{3875724000 7200 0 EET}
{3889033200 10800 1 EEST}
{3907083600 7200 0 EET}
{3907778400 7200 0 EET}
{3920482800 10800 1 EEST}
{3938533200 7200 0 EET}
{3939228000 7200 0 EET}
{3951932400 10800 1 EEST}
{3969982800 7200 0 EET}
{3970677600 7200 0 EET}
{3983986800 10800 1 EEST}
{4002037200 7200 0 EET}
{4002127200 7200 0 EET}
{4015436400 10800 1 EEST}
{4033486800 7200 0 EET}
{4033576800 7200 0 EET}
{4046886000 10800 1 EEST}
{4064936400 7200 0 EET}
{4065026400 7200 0 EET}
{4078335600 10800 1 EEST}
{4096386000 7200 0 EET}
{4097080800 7200 0 EET}
}
+84 -84
View File
@@ -107,171 +107,171 @@ set TZData(:Asia/Hebron) {
{1427493600 10800 1 EEST}
{1445547600 7200 0 EET}
{1458946800 10800 1 EEST}
{1476997200 7200 0 EET}
{1477692000 7200 0 EET}
{1490396400 10800 1 EEST}
{1509051600 7200 0 EET}
{1509141600 7200 0 EET}
{1522450800 10800 1 EEST}
{1540501200 7200 0 EET}
{1540591200 7200 0 EET}
{1553900400 10800 1 EEST}
{1571950800 7200 0 EET}
{1572040800 7200 0 EET}
{1585350000 10800 1 EEST}
{1603400400 7200 0 EET}
{1604095200 7200 0 EET}
{1616799600 10800 1 EEST}
{1634850000 7200 0 EET}
{1635544800 7200 0 EET}
{1648249200 10800 1 EEST}
{1666299600 7200 0 EET}
{1666994400 7200 0 EET}
{1679698800 10800 1 EEST}
{1698354000 7200 0 EET}
{1698444000 7200 0 EET}
{1711753200 10800 1 EEST}
{1729803600 7200 0 EET}
{1729893600 7200 0 EET}
{1743202800 10800 1 EEST}
{1761253200 7200 0 EET}
{1761343200 7200 0 EET}
{1774652400 10800 1 EEST}
{1792702800 7200 0 EET}
{1793397600 7200 0 EET}
{1806102000 10800 1 EEST}
{1824152400 7200 0 EET}
{1824847200 7200 0 EET}
{1837551600 10800 1 EEST}
{1856206800 7200 0 EET}
{1856296800 7200 0 EET}
{1869606000 10800 1 EEST}
{1887656400 7200 0 EET}
{1887746400 7200 0 EET}
{1901055600 10800 1 EEST}
{1919106000 7200 0 EET}
{1919196000 7200 0 EET}
{1932505200 10800 1 EEST}
{1950555600 7200 0 EET}
{1950645600 7200 0 EET}
{1963954800 10800 1 EEST}
{1982005200 7200 0 EET}
{1982700000 7200 0 EET}
{1995404400 10800 1 EEST}
{2013454800 7200 0 EET}
{2014149600 7200 0 EET}
{2026854000 10800 1 EEST}
{2045509200 7200 0 EET}
{2045599200 7200 0 EET}
{2058908400 10800 1 EEST}
{2076958800 7200 0 EET}
{2077048800 7200 0 EET}
{2090358000 10800 1 EEST}
{2108408400 7200 0 EET}
{2108498400 7200 0 EET}
{2121807600 10800 1 EEST}
{2139858000 7200 0 EET}
{2140552800 7200 0 EET}
{2153257200 10800 1 EEST}
{2171307600 7200 0 EET}
{2172002400 7200 0 EET}
{2184706800 10800 1 EEST}
{2202757200 7200 0 EET}
{2203452000 7200 0 EET}
{2216761200 10800 1 EEST}
{2234811600 7200 0 EET}
{2234901600 7200 0 EET}
{2248210800 10800 1 EEST}
{2266261200 7200 0 EET}
{2266351200 7200 0 EET}
{2279660400 10800 1 EEST}
{2297710800 7200 0 EET}
{2297800800 7200 0 EET}
{2311110000 10800 1 EEST}
{2329160400 7200 0 EET}
{2329855200 7200 0 EET}
{2342559600 10800 1 EEST}
{2360610000 7200 0 EET}
{2361304800 7200 0 EET}
{2374009200 10800 1 EEST}
{2392664400 7200 0 EET}
{2392754400 7200 0 EET}
{2406063600 10800 1 EEST}
{2424114000 7200 0 EET}
{2424204000 7200 0 EET}
{2437513200 10800 1 EEST}
{2455563600 7200 0 EET}
{2455653600 7200 0 EET}
{2468962800 10800 1 EEST}
{2487013200 7200 0 EET}
{2487708000 7200 0 EET}
{2500412400 10800 1 EEST}
{2518462800 7200 0 EET}
{2519157600 7200 0 EET}
{2531862000 10800 1 EEST}
{2549912400 7200 0 EET}
{2550607200 7200 0 EET}
{2563311600 10800 1 EEST}
{2581966800 7200 0 EET}
{2582056800 7200 0 EET}
{2595366000 10800 1 EEST}
{2613416400 7200 0 EET}
{2613506400 7200 0 EET}
{2626815600 10800 1 EEST}
{2644866000 7200 0 EET}
{2644956000 7200 0 EET}
{2658265200 10800 1 EEST}
{2676315600 7200 0 EET}
{2677010400 7200 0 EET}
{2689714800 10800 1 EEST}
{2707765200 7200 0 EET}
{2708460000 7200 0 EET}
{2721164400 10800 1 EEST}
{2739819600 7200 0 EET}
{2739909600 7200 0 EET}
{2753218800 10800 1 EEST}
{2771269200 7200 0 EET}
{2771359200 7200 0 EET}
{2784668400 10800 1 EEST}
{2802718800 7200 0 EET}
{2802808800 7200 0 EET}
{2816118000 10800 1 EEST}
{2834168400 7200 0 EET}
{2834258400 7200 0 EET}
{2847567600 10800 1 EEST}
{2865618000 7200 0 EET}
{2866312800 7200 0 EET}
{2879017200 10800 1 EEST}
{2897067600 7200 0 EET}
{2897762400 7200 0 EET}
{2910466800 10800 1 EEST}
{2929122000 7200 0 EET}
{2929212000 7200 0 EET}
{2942521200 10800 1 EEST}
{2960571600 7200 0 EET}
{2960661600 7200 0 EET}
{2973970800 10800 1 EEST}
{2992021200 7200 0 EET}
{2992111200 7200 0 EET}
{3005420400 10800 1 EEST}
{3023470800 7200 0 EET}
{3024165600 7200 0 EET}
{3036870000 10800 1 EEST}
{3054920400 7200 0 EET}
{3055615200 7200 0 EET}
{3068319600 10800 1 EEST}
{3086370000 7200 0 EET}
{3087064800 7200 0 EET}
{3100374000 10800 1 EEST}
{3118424400 7200 0 EET}
{3118514400 7200 0 EET}
{3131823600 10800 1 EEST}
{3149874000 7200 0 EET}
{3149964000 7200 0 EET}
{3163273200 10800 1 EEST}
{3181323600 7200 0 EET}
{3181413600 7200 0 EET}
{3194722800 10800 1 EEST}
{3212773200 7200 0 EET}
{3213468000 7200 0 EET}
{3226172400 10800 1 EEST}
{3244222800 7200 0 EET}
{3244917600 7200 0 EET}
{3257622000 10800 1 EEST}
{3276277200 7200 0 EET}
{3276367200 7200 0 EET}
{3289676400 10800 1 EEST}
{3307726800 7200 0 EET}
{3307816800 7200 0 EET}
{3321126000 10800 1 EEST}
{3339176400 7200 0 EET}
{3339266400 7200 0 EET}
{3352575600 10800 1 EEST}
{3370626000 7200 0 EET}
{3371320800 7200 0 EET}
{3384025200 10800 1 EEST}
{3402075600 7200 0 EET}
{3402770400 7200 0 EET}
{3415474800 10800 1 EEST}
{3433525200 7200 0 EET}
{3434220000 7200 0 EET}
{3446924400 10800 1 EEST}
{3465579600 7200 0 EET}
{3465669600 7200 0 EET}
{3478978800 10800 1 EEST}
{3497029200 7200 0 EET}
{3497119200 7200 0 EET}
{3510428400 10800 1 EEST}
{3528478800 7200 0 EET}
{3528568800 7200 0 EET}
{3541878000 10800 1 EEST}
{3559928400 7200 0 EET}
{3560623200 7200 0 EET}
{3573327600 10800 1 EEST}
{3591378000 7200 0 EET}
{3592072800 7200 0 EET}
{3604777200 10800 1 EEST}
{3623432400 7200 0 EET}
{3623522400 7200 0 EET}
{3636831600 10800 1 EEST}
{3654882000 7200 0 EET}
{3654972000 7200 0 EET}
{3668281200 10800 1 EEST}
{3686331600 7200 0 EET}
{3686421600 7200 0 EET}
{3699730800 10800 1 EEST}
{3717781200 7200 0 EET}
{3717871200 7200 0 EET}
{3731180400 10800 1 EEST}
{3749230800 7200 0 EET}
{3749925600 7200 0 EET}
{3762630000 10800 1 EEST}
{3780680400 7200 0 EET}
{3781375200 7200 0 EET}
{3794079600 10800 1 EEST}
{3812734800 7200 0 EET}
{3812824800 7200 0 EET}
{3826134000 10800 1 EEST}
{3844184400 7200 0 EET}
{3844274400 7200 0 EET}
{3857583600 10800 1 EEST}
{3875634000 7200 0 EET}
{3875724000 7200 0 EET}
{3889033200 10800 1 EEST}
{3907083600 7200 0 EET}
{3907778400 7200 0 EET}
{3920482800 10800 1 EEST}
{3938533200 7200 0 EET}
{3939228000 7200 0 EET}
{3951932400 10800 1 EEST}
{3969982800 7200 0 EET}
{3970677600 7200 0 EET}
{3983986800 10800 1 EEST}
{4002037200 7200 0 EET}
{4002127200 7200 0 EET}
{4015436400 10800 1 EEST}
{4033486800 7200 0 EET}
{4033576800 7200 0 EET}
{4046886000 10800 1 EEST}
{4064936400 7200 0 EET}
{4065026400 7200 0 EET}
{4078335600 10800 1 EEST}
{4096386000 7200 0 EET}
{4097080800 7200 0 EET}
}
+11 -11
View File
@@ -71,23 +71,23 @@ set TZData(:Europe/Istanbul) {
{482792400 7200 0 EET}
{482796000 10800 1 EEST}
{496702800 7200 0 EET}
{512524800 10800 1 EEST}
{528249600 7200 0 EET}
{543974400 10800 1 EEST}
{559699200 7200 0 EET}
{575424000 10800 1 EEST}
{591148800 7200 0 EET}
{606873600 10800 1 EEST}
{622598400 7200 0 EET}
{638323200 10800 1 EEST}
{654652800 7200 0 EET}
{512521200 10800 1 EEST}
{528246000 7200 0 EET}
{543970800 10800 1 EEST}
{559695600 7200 0 EET}
{575420400 10800 1 EEST}
{591145200 7200 0 EET}
{606870000 10800 1 EEST}
{622594800 7200 0 EET}
{638319600 10800 1 EEST}
{654649200 7200 0 EET}
{670374000 10800 1 EEST}
{686098800 7200 0 EET}
{701823600 10800 1 EEST}
{717548400 7200 0 EET}
{733273200 10800 1 EEST}
{748998000 7200 0 EET}
{764722800 10800 1 EEST}
{764118000 10800 1 EEST}
{780447600 7200 0 EET}
{796172400 10800 1 EEST}
{811897200 7200 0 EET}
+14 -14
View File
@@ -3,23 +3,23 @@
set TZData(:Europe/Malta) {
{-9223372036854775808 3484 0 LMT}
{-2403478684 3600 0 CET}
{-1690851600 7200 1 CEST}
{-1680483600 3600 0 CET}
{-1690765200 7200 1 CEST}
{-1680487200 3600 0 CET}
{-1664758800 7200 1 CEST}
{-1649034000 3600 0 CET}
{-1648951200 3600 0 CET}
{-1635123600 7200 1 CEST}
{-1616979600 3600 0 CET}
{-1616896800 3600 0 CET}
{-1604278800 7200 1 CEST}
{-1585530000 3600 0 CET}
{-1585533600 3600 0 CET}
{-1571014800 7200 1 CEST}
{-1555290000 3600 0 CET}
{-1555293600 3600 0 CET}
{-932432400 7200 1 CEST}
{-857257200 3600 0 CET}
{-844556400 7200 1 CEST}
{-828226800 3600 0 CET}
{-812502000 7200 1 CEST}
{-796777200 3600 0 CET}
{-781052400 7200 0 CEST}
{-812588400 7200 1 CEST}
{-798073200 3600 0 CET}
{-781052400 7200 1 CEST}
{-766717200 3600 0 CET}
{-750898800 7200 1 CEST}
{-733359600 3600 0 CET}
@@ -30,17 +30,17 @@ set TZData(:Europe/Malta) {
{-114051600 7200 1 CEST}
{-103168800 3600 0 CET}
{-81997200 7200 1 CEST}
{-71719200 3600 0 CET}
{-71715600 3600 0 CET}
{-50547600 7200 1 CEST}
{-40269600 3600 0 CET}
{-40266000 3600 0 CET}
{-18493200 7200 1 CEST}
{-8215200 3600 0 CET}
{-8211600 3600 0 CET}
{12956400 7200 1 CEST}
{23234400 3600 0 CET}
{23238000 3600 0 CET}
{43801200 7200 1 CEST}
{54687600 3600 0 CET}
{75855600 7200 1 CEST}
{86738400 3600 0 CET}
{86742000 3600 0 CET}
{102380400 7200 0 CEST}
{118105200 3600 0 CET}
{135730800 7200 1 CEST}
+17 -16
View File
@@ -3,24 +3,25 @@
set TZData(:Europe/Rome) {
{-9223372036854775808 2996 0 LMT}
{-3259097396 2996 0 RMT}
{-2403564596 3600 0 CET}
{-1690851600 7200 1 CEST}
{-1680483600 3600 0 CET}
{-2403565200 3600 0 CET}
{-1690765200 7200 1 CEST}
{-1680487200 3600 0 CET}
{-1664758800 7200 1 CEST}
{-1649034000 3600 0 CET}
{-1648951200 3600 0 CET}
{-1635123600 7200 1 CEST}
{-1616979600 3600 0 CET}
{-1616896800 3600 0 CET}
{-1604278800 7200 1 CEST}
{-1585530000 3600 0 CET}
{-1585533600 3600 0 CET}
{-1571014800 7200 1 CEST}
{-1555290000 3600 0 CET}
{-1555293600 3600 0 CET}
{-932432400 7200 1 CEST}
{-857257200 3600 0 CET}
{-844556400 7200 1 CEST}
{-830307600 7200 0 CEST}
{-828226800 3600 0 CET}
{-812502000 7200 1 CEST}
{-804819600 3600 0 CET}
{-798080400 3600 0 CET}
{-807152400 7200 0 CEST}
{-798073200 3600 0 CET}
{-781052400 7200 1 CEST}
{-766717200 3600 0 CET}
{-750898800 7200 1 CEST}
@@ -32,21 +33,21 @@ set TZData(:Europe/Rome) {
{-114051600 7200 1 CEST}
{-103168800 3600 0 CET}
{-81997200 7200 1 CEST}
{-71719200 3600 0 CET}
{-71715600 3600 0 CET}
{-50547600 7200 1 CEST}
{-40269600 3600 0 CET}
{-40266000 3600 0 CET}
{-18493200 7200 1 CEST}
{-8215200 3600 0 CET}
{-8211600 3600 0 CET}
{12956400 7200 1 CEST}
{23234400 3600 0 CET}
{23238000 3600 0 CET}
{43801200 7200 1 CEST}
{54687600 3600 0 CET}
{75855600 7200 1 CEST}
{86738400 3600 0 CET}
{86742000 3600 0 CET}
{107910000 7200 1 CEST}
{118188000 3600 0 CET}
{118191600 3600 0 CET}
{138754800 7200 1 CEST}
{149637600 3600 0 CET}
{149641200 3600 0 CET}
{170809200 7200 1 CEST}
{181090800 3600 0 CET}
{202258800 7200 1 CEST}
+176 -9
View File
@@ -2,13 +2,180 @@
set TZData(:Pacific/Tongatapu) {
{-9223372036854775808 44360 0 LMT}
{-2177497160 44400 0 TOT}
{-915193200 46800 0 TOT}
{915102000 46800 0 TOT}
{939214800 50400 1 TOST}
{953384400 46800 0 TOT}
{973342800 50400 1 TOST}
{980596800 46800 0 TOT}
{1004792400 50400 1 TOST}
{1012046400 46800 0 TOT}
{-2177497160 44400 0 +1220}
{-915193200 46800 0 +13}
{915102000 46800 0 +13}
{939214800 50400 1 +14}
{953384400 46800 0 +13}
{973342800 50400 1 +14}
{980596800 46800 0 +13}
{1004792400 50400 1 +14}
{1012046400 46800 0 +13}
{1478350800 50400 1 +14}
{1484398800 46800 0 +13}
{1509800400 50400 1 +14}
{1516453200 46800 0 +13}
{1541250000 50400 1 +14}
{1547902800 46800 0 +13}
{1572699600 50400 1 +14}
{1579352400 46800 0 +13}
{1604149200 50400 1 +14}
{1610802000 46800 0 +13}
{1636203600 50400 1 +14}
{1642251600 46800 0 +13}
{1667653200 50400 1 +14}
{1673701200 46800 0 +13}
{1699102800 50400 1 +14}
{1705755600 46800 0 +13}
{1730552400 50400 1 +14}
{1737205200 46800 0 +13}
{1762002000 50400 1 +14}
{1768654800 46800 0 +13}
{1793451600 50400 1 +14}
{1800104400 46800 0 +13}
{1825506000 50400 1 +14}
{1831554000 46800 0 +13}
{1856955600 50400 1 +14}
{1863608400 46800 0 +13}
{1888405200 50400 1 +14}
{1895058000 46800 0 +13}
{1919854800 50400 1 +14}
{1926507600 46800 0 +13}
{1951304400 50400 1 +14}
{1957957200 46800 0 +13}
{1983358800 50400 1 +14}
{1989406800 46800 0 +13}
{2014808400 50400 1 +14}
{2020856400 46800 0 +13}
{2046258000 50400 1 +14}
{2052910800 46800 0 +13}
{2077707600 50400 1 +14}
{2084360400 46800 0 +13}
{2109157200 50400 1 +14}
{2115810000 46800 0 +13}
{2140606800 50400 1 +14}
{2147259600 46800 0 +13}
{2172661200 50400 1 +14}
{2178709200 46800 0 +13}
{2204110800 50400 1 +14}
{2210158800 46800 0 +13}
{2235560400 50400 1 +14}
{2242213200 46800 0 +13}
{2267010000 50400 1 +14}
{2273662800 46800 0 +13}
{2298459600 50400 1 +14}
{2305112400 46800 0 +13}
{2329909200 50400 1 +14}
{2336562000 46800 0 +13}
{2361963600 50400 1 +14}
{2368011600 46800 0 +13}
{2393413200 50400 1 +14}
{2400066000 46800 0 +13}
{2424862800 50400 1 +14}
{2431515600 46800 0 +13}
{2456312400 50400 1 +14}
{2462965200 46800 0 +13}
{2487762000 50400 1 +14}
{2494414800 46800 0 +13}
{2519816400 50400 1 +14}
{2525864400 46800 0 +13}
{2551266000 50400 1 +14}
{2557314000 46800 0 +13}
{2582715600 50400 1 +14}
{2589368400 46800 0 +13}
{2614165200 50400 1 +14}
{2620818000 46800 0 +13}
{2645614800 50400 1 +14}
{2652267600 46800 0 +13}
{2677064400 50400 1 +14}
{2683717200 46800 0 +13}
{2709118800 50400 1 +14}
{2715166800 46800 0 +13}
{2740568400 50400 1 +14}
{2747221200 46800 0 +13}
{2772018000 50400 1 +14}
{2778670800 46800 0 +13}
{2803467600 50400 1 +14}
{2810120400 46800 0 +13}
{2834917200 50400 1 +14}
{2841570000 46800 0 +13}
{2866971600 50400 1 +14}
{2873019600 46800 0 +13}
{2898421200 50400 1 +14}
{2904469200 46800 0 +13}
{2929870800 50400 1 +14}
{2936523600 46800 0 +13}
{2961320400 50400 1 +14}
{2967973200 46800 0 +13}
{2992770000 50400 1 +14}
{2999422800 46800 0 +13}
{3024219600 50400 1 +14}
{3030872400 46800 0 +13}
{3056274000 50400 1 +14}
{3062322000 46800 0 +13}
{3087723600 50400 1 +14}
{3093771600 46800 0 +13}
{3119173200 50400 1 +14}
{3125826000 46800 0 +13}
{3150622800 50400 1 +14}
{3157275600 46800 0 +13}
{3182072400 50400 1 +14}
{3188725200 46800 0 +13}
{3213522000 50400 1 +14}
{3220174800 46800 0 +13}
{3245576400 50400 1 +14}
{3251624400 46800 0 +13}
{3277026000 50400 1 +14}
{3283678800 46800 0 +13}
{3308475600 50400 1 +14}
{3315128400 46800 0 +13}
{3339925200 50400 1 +14}
{3346578000 46800 0 +13}
{3371374800 50400 1 +14}
{3378027600 46800 0 +13}
{3403429200 50400 1 +14}
{3409477200 46800 0 +13}
{3434878800 50400 1 +14}
{3440926800 46800 0 +13}
{3466328400 50400 1 +14}
{3472981200 46800 0 +13}
{3497778000 50400 1 +14}
{3504430800 46800 0 +13}
{3529227600 50400 1 +14}
{3535880400 46800 0 +13}
{3560677200 50400 1 +14}
{3567330000 46800 0 +13}
{3592731600 50400 1 +14}
{3598779600 46800 0 +13}
{3624181200 50400 1 +14}
{3630834000 46800 0 +13}
{3655630800 50400 1 +14}
{3662283600 46800 0 +13}
{3687080400 50400 1 +14}
{3693733200 46800 0 +13}
{3718530000 50400 1 +14}
{3725182800 46800 0 +13}
{3750584400 50400 1 +14}
{3756632400 46800 0 +13}
{3782034000 50400 1 +14}
{3788082000 46800 0 +13}
{3813483600 50400 1 +14}
{3820136400 46800 0 +13}
{3844933200 50400 1 +14}
{3851586000 46800 0 +13}
{3876382800 50400 1 +14}
{3883035600 46800 0 +13}
{3907832400 50400 1 +14}
{3914485200 46800 0 +13}
{3939886800 50400 1 +14}
{3945934800 46800 0 +13}
{3971336400 50400 1 +14}
{3977384400 46800 0 +13}
{4002786000 50400 1 +14}
{4009438800 46800 0 +13}
{4034235600 50400 1 +14}
{4040888400 46800 0 +13}
{4065685200 50400 1 +14}
{4072338000 46800 0 +13}
{4097134800 50400 1 +14}
}
+27 -2
View File
@@ -1,4 +1,29 @@
LibTomMath is hereby released into the Public Domain.
LibTomMath is licensed under DUAL licensing terms.
-- Tom St Denis
Choose and use the license of your needs.
[LICENSE #1]
LibTomMath is public domain. As should all quality software be.
Tom St Denis
[/LICENSE #1]
[LICENSE #2]
DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE
Version 2, December 2004
Copyright (C) 2004 Sam Hocevar <sam@hocevar.net>
Everyone is permitted to copy and distribute verbatim or modified
copies of this license document, and changing it is allowed as long
as the name is changed.
DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. You just DO WHAT THE FUCK YOU WANT TO.
[/LICENSE #2]
-6
View File
@@ -1,6 +0,0 @@
This is makeindex, version 2.14 [02-Oct-2002] (kpathsea + Thai support).
Scanning input file bn.idx....done (79 entries accepted, 0 rejected).
Sorting entries....done (511 comparisons).
Generating output file bn.ind....done (82 lines written, 0 warnings).
Output written in bn.ind.
Transcript written in bn.ilg.
-82
View File
@@ -1,82 +0,0 @@
\begin{theindex}
\item mp\_add, \hyperpage{29}
\item mp\_add\_d, \hyperpage{52}
\item mp\_and, \hyperpage{29}
\item mp\_clear, \hyperpage{11}
\item mp\_clear\_multi, \hyperpage{12}
\item mp\_cmp, \hyperpage{24}
\item mp\_cmp\_d, \hyperpage{25}
\item mp\_cmp\_mag, \hyperpage{23}
\item mp\_div, \hyperpage{30}
\item mp\_div\_2, \hyperpage{26}
\item mp\_div\_2d, \hyperpage{28}
\item mp\_div\_d, \hyperpage{52}
\item mp\_dr\_reduce, \hyperpage{40}
\item mp\_dr\_setup, \hyperpage{40}
\item MP\_EQ, \hyperpage{22}
\item mp\_error\_to\_string, \hyperpage{10}
\item mp\_expt\_d, \hyperpage{43}
\item mp\_exptmod, \hyperpage{43}
\item mp\_exteuclid, \hyperpage{51}
\item mp\_gcd, \hyperpage{51}
\item mp\_get\_int, \hyperpage{20}
\item mp\_grow, \hyperpage{16}
\item MP\_GT, \hyperpage{22}
\item mp\_init, \hyperpage{11}
\item mp\_init\_copy, \hyperpage{13}
\item mp\_init\_multi, \hyperpage{12}
\item mp\_init\_set, \hyperpage{21}
\item mp\_init\_set\_int, \hyperpage{21}
\item mp\_init\_size, \hyperpage{14}
\item mp\_int, \hyperpage{10}
\item mp\_invmod, \hyperpage{52}
\item mp\_jacobi, \hyperpage{52}
\item mp\_lcm, \hyperpage{51}
\item mp\_lshd, \hyperpage{28}
\item MP\_LT, \hyperpage{22}
\item MP\_MEM, \hyperpage{9}
\item mp\_mod, \hyperpage{35}
\item mp\_mod\_d, \hyperpage{52}
\item mp\_montgomery\_calc\_normalization, \hyperpage{38}
\item mp\_montgomery\_reduce, \hyperpage{37}
\item mp\_montgomery\_setup, \hyperpage{37}
\item mp\_mul, \hyperpage{31}
\item mp\_mul\_2, \hyperpage{26}
\item mp\_mul\_2d, \hyperpage{28}
\item mp\_mul\_d, \hyperpage{52}
\item mp\_n\_root, \hyperpage{44}
\item mp\_neg, \hyperpage{29}
\item MP\_NO, \hyperpage{9}
\item MP\_OKAY, \hyperpage{9}
\item mp\_or, \hyperpage{29}
\item mp\_prime\_fermat, \hyperpage{45}
\item mp\_prime\_is\_divisible, \hyperpage{45}
\item mp\_prime\_is\_prime, \hyperpage{46}
\item mp\_prime\_miller\_rabin, \hyperpage{45}
\item mp\_prime\_next\_prime, \hyperpage{46}
\item mp\_prime\_rabin\_miller\_trials, \hyperpage{46}
\item mp\_prime\_random, \hyperpage{47}
\item mp\_prime\_random\_ex, \hyperpage{47}
\item mp\_radix\_size, \hyperpage{49}
\item mp\_read\_radix, \hyperpage{49}
\item mp\_read\_unsigned\_bin, \hyperpage{50}
\item mp\_reduce, \hyperpage{36}
\item mp\_reduce\_2k, \hyperpage{41}
\item mp\_reduce\_2k\_setup, \hyperpage{41}
\item mp\_reduce\_setup, \hyperpage{36}
\item mp\_rshd, \hyperpage{28}
\item mp\_set, \hyperpage{19}
\item mp\_set\_int, \hyperpage{20}
\item mp\_shrink, \hyperpage{15}
\item mp\_sqr, \hyperpage{33}
\item mp\_sub, \hyperpage{29}
\item mp\_sub\_d, \hyperpage{52}
\item mp\_to\_unsigned\_bin, \hyperpage{50}
\item mp\_toradix, \hyperpage{49}
\item mp\_unsigned\_bin\_size, \hyperpage{50}
\item MP\_VAL, \hyperpage{9}
\item mp\_xor, \hyperpage{29}
\item MP\_YES, \hyperpage{9}
\end{theindex}
BIN
View File
Binary file not shown.
-1835
View File
File diff suppressed because it is too large Load Diff
+8 -4
View File
@@ -1,4 +1,4 @@
#include <tommath.h>
#include <tommath_private.h>
#ifdef BN_ERROR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
*
@@ -12,12 +12,12 @@
* The library is free for all purposes without any express
* guarantee it works.
*
* Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
* Tom St Denis, tstdenis82@gmail.com, http://libtom.org
*/
static const struct {
int code;
char *msg;
const char *msg;
} msgs[] = {
{ MP_OKAY, "Successful" },
{ MP_MEM, "Out of heap" },
@@ -25,7 +25,7 @@ static const struct {
};
/* return a char * string for a given code */
char *mp_error_to_string(int code)
const char *mp_error_to_string(int code)
{
int x;
@@ -41,3 +41,7 @@ char *mp_error_to_string(int code)
}
#endif
/* $Source$ */
/* $Revision$ */
/* $Date$ */
+12 -8
View File
@@ -1,4 +1,4 @@
#include <tommath.h>
#include <tommath_private.h>
#ifdef BN_FAST_MP_INVMOD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
*
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
* Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
* Tom St Denis, tstdenis82@gmail.com, http://libtom.org
*/
/* computes the modular inverse via binary extended euclidean algorithm,
@@ -27,7 +27,7 @@ int fast_mp_invmod (mp_int * a, mp_int * b, mp_int * c)
int res, neg;
/* 2. [modified] b must be odd */
if (mp_iseven (b) == 1) {
if (mp_iseven (b) == MP_YES) {
return MP_VAL;
}
@@ -57,13 +57,13 @@ int fast_mp_invmod (mp_int * a, mp_int * b, mp_int * c)
top:
/* 4. while u is even do */
while (mp_iseven (&u) == 1) {
while (mp_iseven (&u) == MP_YES) {
/* 4.1 u = u/2 */
if ((res = mp_div_2 (&u, &u)) != MP_OKAY) {
goto LBL_ERR;
}
/* 4.2 if B is odd then */
if (mp_isodd (&B) == 1) {
if (mp_isodd (&B) == MP_YES) {
if ((res = mp_sub (&B, &x, &B)) != MP_OKAY) {
goto LBL_ERR;
}
@@ -75,13 +75,13 @@ top:
}
/* 5. while v is even do */
while (mp_iseven (&v) == 1) {
while (mp_iseven (&v) == MP_YES) {
/* 5.1 v = v/2 */
if ((res = mp_div_2 (&v, &v)) != MP_OKAY) {
goto LBL_ERR;
}
/* 5.2 if D is odd then */
if (mp_isodd (&D) == 1) {
if (mp_isodd (&D) == MP_YES) {
/* D = (D-x)/2 */
if ((res = mp_sub (&D, &x, &D)) != MP_OKAY) {
goto LBL_ERR;
@@ -115,7 +115,7 @@ top:
}
/* if not zero goto step 4 */
if (mp_iszero (&u) == 0) {
if (mp_iszero (&u) == MP_NO) {
goto top;
}
@@ -142,3 +142,7 @@ LBL_ERR:mp_clear_multi (&x, &y, &u, &v, &B, &D, NULL);
return res;
}
#endif
/* $Source$ */
/* $Revision$ */
/* $Date$ */
+18 -14
View File
@@ -1,4 +1,4 @@
#include <tommath.h>
#include <tommath_private.h>
#ifdef BN_FAST_MP_MONTGOMERY_REDUCE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
*
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
* Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
* Tom St Denis, tstdenis82@gmail.com, http://libtom.org
*/
/* computes xR**-1 == x (mod N) via Montgomery Reduction
@@ -32,7 +32,7 @@ int fast_mp_montgomery_reduce (mp_int * x, mp_int * n, mp_digit rho)
olduse = x->used;
/* grow a as required */
if (x->alloc < n->used + 1) {
if (x->alloc < (n->used + 1)) {
if ((res = mp_grow (x, n->used + 1)) != MP_OKAY) {
return res;
}
@@ -42,8 +42,8 @@ int fast_mp_montgomery_reduce (mp_int * x, mp_int * n, mp_digit rho)
* an array of double precision words W[...]
*/
{
register mp_word *_W;
register mp_digit *tmpx;
mp_word *_W;
mp_digit *tmpx;
/* alias for the W[] array */
_W = W;
@@ -57,7 +57,7 @@ int fast_mp_montgomery_reduce (mp_int * x, mp_int * n, mp_digit rho)
}
/* zero the high words of W[a->used..m->used*2] */
for (; ix < n->used * 2 + 1; ix++) {
for (; ix < ((n->used * 2) + 1); ix++) {
*_W++ = 0;
}
}
@@ -72,7 +72,7 @@ int fast_mp_montgomery_reduce (mp_int * x, mp_int * n, mp_digit rho)
* by casting the value down to a mp_digit. Note this requires
* that W[ix-1] have the carry cleared (see after the inner loop)
*/
register mp_digit mu;
mp_digit mu;
mu = (mp_digit) (((W[ix] & MP_MASK) * rho) & MP_MASK);
/* a = a + mu * m * b**i
@@ -90,9 +90,9 @@ int fast_mp_montgomery_reduce (mp_int * x, mp_int * n, mp_digit rho)
* first m->used words of W[] have the carries fixed
*/
{
register int iy;
register mp_digit *tmpn;
register mp_word *_W;
int iy;
mp_digit *tmpn;
mp_word *_W;
/* alias for the digits of the modulus */
tmpn = n->dp;
@@ -115,8 +115,8 @@ int fast_mp_montgomery_reduce (mp_int * x, mp_int * n, mp_digit rho)
* significant digits we zeroed].
*/
{
register mp_digit *tmpx;
register mp_word *_W, *_W1;
mp_digit *tmpx;
mp_word *_W, *_W1;
/* nox fix rest of carries */
@@ -126,7 +126,7 @@ int fast_mp_montgomery_reduce (mp_int * x, mp_int * n, mp_digit rho)
/* alias for next word, where the carry goes */
_W = W + ++ix;
for (; ix <= n->used * 2 + 1; ix++) {
for (; ix <= ((n->used * 2) + 1); ix++) {
*_W++ += *_W1++ >> ((mp_word) DIGIT_BIT);
}
@@ -143,7 +143,7 @@ int fast_mp_montgomery_reduce (mp_int * x, mp_int * n, mp_digit rho)
/* alias for shifted double precision result */
_W = W + n->used;
for (ix = 0; ix < n->used + 1; ix++) {
for (ix = 0; ix < (n->used + 1); ix++) {
*tmpx++ = (mp_digit)(*_W++ & ((mp_word) MP_MASK));
}
@@ -166,3 +166,7 @@ int fast_mp_montgomery_reduce (mp_int * x, mp_int * n, mp_digit rho)
return MP_OKAY;
}
#endif
/* $Source$ */
/* $Revision$ */
/* $Date$ */
+10 -6
View File
@@ -1,4 +1,4 @@
#include <tommath.h>
#include <tommath_private.h>
#ifdef BN_FAST_S_MP_MUL_DIGS_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
*
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
* Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
* Tom St Denis, tstdenis82@gmail.com, http://libtom.org
*/
/* Fast (comba) multiplier
@@ -35,7 +35,7 @@ int fast_s_mp_mul_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
{
int olduse, res, pa, ix, iz;
mp_digit W[MP_WARRAY];
register mp_word _W;
mp_word _W;
/* grow the destination as required */
if (c->alloc < digs) {
@@ -78,16 +78,16 @@ int fast_s_mp_mul_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
/* make next carry */
_W = _W >> ((mp_word)DIGIT_BIT);
}
}
/* setup dest */
olduse = c->used;
c->used = pa;
{
register mp_digit *tmpc;
mp_digit *tmpc;
tmpc = c->dp;
for (ix = 0; ix < pa+1; ix++) {
for (ix = 0; ix < (pa + 1); ix++) {
/* now extract the previous digit [below the carry] */
*tmpc++ = W[ix];
}
@@ -101,3 +101,7 @@ int fast_s_mp_mul_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
return MP_OKAY;
}
#endif
/* $Source$ */
/* $Revision$ */
/* $Date$ */
+7 -3
View File
@@ -1,4 +1,4 @@
#include <tommath.h>
#include <tommath_private.h>
#ifdef BN_FAST_S_MP_MUL_HIGH_DIGS_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
*
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
* Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
* Tom St Denis, tstdenis82@gmail.com, http://libtom.org
*/
/* this is a modified version of fast_s_mul_digs that only produces
@@ -75,7 +75,7 @@ int fast_s_mp_mul_high_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
c->used = pa;
{
register mp_digit *tmpc;
mp_digit *tmpc;
tmpc = c->dp + digs;
for (ix = digs; ix < pa; ix++) {
@@ -92,3 +92,7 @@ int fast_s_mp_mul_high_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
return MP_OKAY;
}
#endif
/* $Source$ */
/* $Revision$ */
/* $Date$ */
+7 -3
View File
@@ -1,4 +1,4 @@
#include <tommath.h>
#include <tommath_private.h>
#ifdef BN_FAST_S_MP_SQR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
*
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
* Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
* Tom St Denis, tstdenis82@gmail.com, http://libtom.org
*/
/* the jist of squaring...
@@ -66,7 +66,7 @@ int fast_s_mp_sqr (mp_int * a, mp_int * b)
* we halve the distance since they approach at a rate of 2x
* and we have to round because odd cases need to be executed
*/
iy = MIN(iy, (ty-tx+1)>>1);
iy = MIN(iy, ((ty-tx)+1)>>1);
/* execute loop */
for (iz = 0; iz < iy; iz++) {
@@ -108,3 +108,7 @@ int fast_s_mp_sqr (mp_int * a, mp_int * b)
return MP_OKAY;
}
#endif
/* $Source$ */
/* $Revision$ */
/* $Date$ */
+8 -4
View File
@@ -1,4 +1,4 @@
#include <tommath.h>
#include <tommath_private.h>
#ifdef BN_MP_2EXPT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
*
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
* Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
* Tom St Denis, tstdenis82@gmail.com, http://libtom.org
*/
/* computes a = 2**b
@@ -29,12 +29,12 @@ mp_2expt (mp_int * a, int b)
mp_zero (a);
/* grow a to accomodate the single bit */
if ((res = mp_grow (a, b / DIGIT_BIT + 1)) != MP_OKAY) {
if ((res = mp_grow (a, (b / DIGIT_BIT) + 1)) != MP_OKAY) {
return res;
}
/* set the used count of where the bit will go */
a->used = b / DIGIT_BIT + 1;
a->used = (b / DIGIT_BIT) + 1;
/* put the single bit in its place */
a->dp[b / DIGIT_BIT] = ((mp_digit)1) << (b % DIGIT_BIT);
@@ -42,3 +42,7 @@ mp_2expt (mp_int * a, int b)
return MP_OKAY;
}
#endif
/* $Source$ */
/* $Revision$ */
/* $Date$ */
+6 -2
View File
@@ -1,4 +1,4 @@
#include <tommath.h>
#include <tommath_private.h>
#ifdef BN_MP_ABS_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
*
@@ -12,7 +12,7 @@
* The library is free for all purposes without any express
* guarantee it works.
*
* Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
* Tom St Denis, tstdenis82@gmail.com, http://libtom.org
*/
/* b = |a|
@@ -37,3 +37,7 @@ mp_abs (mp_int * a, mp_int * b)
return MP_OKAY;
}
#endif
/* $Source$ */
/* $Revision$ */
/* $Date$ */

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