Compare commits

..
Author SHA1 Message Date
pooryorick 5e7e1715af Merge unchained branch [22400aa71b] and resolve conflicts. 2023-06-26 07:24:26 +00:00
pooryorick 674dc6d84e Merge trunk-encoding-defaultstrict [c499122331]. 2023-06-18 21:30:00 +00:00
pooryorick f85eb13554 Merge trunk [7dc0ea8ca5]. 2023-06-12 10:19:50 +00:00
pooryorick 50eb79b797 Merge trunk [19e22d9bc5]. 2023-06-11 21:31:59 +00:00
pooryorick dd66ab423e Merge trunk [402ff62239]. 2023-06-11 20:21:28 +00:00
pooryorick 7600da9e6c Merge trunk [07d84ca4b3]. 2023-06-11 19:53:08 +00:00
pooryorick a1300ad826 Merge trunk [3389fba412]. 2023-06-11 19:41:42 +00:00
pooryorick fea0c84f2f Merge trunk [9d2e82fe49]. 2023-06-11 13:10:31 +00:00
pooryorick 25fb9a6a54 Merge trunk [b06ffa0e0e]. 2023-06-11 08:55:29 +00:00
pooryorick baf1eb36e4 Merge trunk [66350977dd]. 2023-06-11 08:07:01 +00:00
pooryorick 6c22f6b730 Merge trunk [20891426a8]. 2023-06-11 07:29:27 +00:00
pooryorick 2071be71b1 Merge trunk [874005b119] 2023-06-11 05:06:54 +00:00
pooryorick 51f0bfd5ae Merge "unchained branch [a03cbbdf63] and resolve conflicts. 2023-05-20 20:11:18 +00:00
pooryorick a7c911213a Merge trunk [b60a8ec69f]. 2023-05-20 16:02:09 +00:00
pooryorick 41da2b1489 Merge "unchained" branch [6b0efb4663] and resolve conflicts. 2023-05-20 14:10:31 +00:00
pooryorick b359029baa Merge trunk [c405bdd1f0]. 2023-05-19 12:08:53 +00:00
pooryorick c447bf4370 Merge trunk [402ff62239]. 2023-05-19 12:02:13 +00:00
pooryorick 68328fdcd5 Merge "unchained" branch commit [05b72c0b3f] and resolve conflicts. 2023-05-19 11:26:08 +00:00
pooryorick c8c0db5f21 Merge trunk [05eeae5d67] and resolve conflicts. 2023-05-11 21:47:17 +00:00
pooryorick c29132ab84 ptrdiff_t to Tcl_Size in tclListObj.c 2023-05-11 20:59:18 +00:00
pooryorick edbf195dff Add TclRelaxRefCount and TclObjGetScalar, and use them to try to take the fast path more often in byte-compiled [lindex].
See: [https://github.com/tcltk/tcl/actions/runs/4956385513] for build failure
2023-05-11 20:25:49 +00:00
pooryorick 6da79937df remove "forceUniChar" from TclStringCat() since it isn't used anymore. 2023-05-03 16:26:27 +00:00
pooryorick 66c0809095 Merge [842b3b3949]. 2023-05-03 11:31:30 +00:00
pooryorick 5f690c8fae Fix issue [b3628609ad73a105], by allowing TclStringCat to assume that each Tcl_Obj.bytes value is complete, i.e. concatenating such values does not change the interpretatin of any byte in any of the concatenated values. 2023-05-02 19:58:06 +00:00
pooryorick c811b1d642 Merge trunk [480bcbe193]. 2023-05-02 19:51:21 +00:00
pooryorick 50c851a04b Remove "deprecated" constraint in test suite. 2023-05-02 19:42:25 +00:00
pooryorick e1051201ce Merge trunk [6964e7e16a]. 2023-05-02 15:51:01 +00:00
pooryorick 410ffcdefa Fix issue [b3628609ad73a105], by allowing TclStringCat to assume that each
Tcl_Obj.bytes value is complete, i.e. concatenating such values does not change
the interpretatin of any byte in any of the concatenated values.
2023-05-02 12:47:10 +00:00
pooryorick 09dd330c44 Merge trunk [95cb1987c8]. 2023-05-01 09:46:41 +00:00
pooryorick 3458214e46 Delete related to TCL_BUILD_FOR and all code related to it. 2023-04-30 19:30:36 +00:00
pooryorick 0987bb4b63 Remove all code that is conditioned on TCL_MAJOR_VERSION. 2023-04-30 18:36:31 +00:00
pooryorick 64a0be31b9 Remove all code related to TCL_NO_DEPRECATED, and some related to TCL_MAJOR_VERSION. 2023-04-28 23:57:14 +00:00
pooryorick 2098e71e79 Remove TclUtfToUCS4(), TclUniCharToUCS4(), and TclUCS4Prev(). 2023-04-28 19:19:30 +00:00
pooryorick 4a24561f0b Remove all code related to TCL_UTF_MAX=3. 2023-04-28 17:34:24 +00:00
pooryorick df1dd156ed Merge trunk. 2023-04-28 12:20:52 +00:00
pooryorick 1a819d1063 Merge trunk. 2023-04-28 09:03:14 +00:00
pooryorick 6ee4d2b394 Merge trunk. 2023-04-24 00:08:18 +00:00
pooryorick 26c9f5e773 merge trunk [f867f44c9c]. 2023-04-23 11:48:15 +00:00
pooryorick 466e7c47c6 Set the encoding profile to strict in Tcl_FSEvalFileEx(). This is independent
of TIP 657:  A script to be evaluated must be properly encoded in any case.
2023-04-23 11:39:10 +00:00
pooryorick 37dceb3922 Merge trunk-encodingdefaultstrict [31278b27ed]. 2023-04-19 17:39:48 +00:00
pooryorick 0c2d0f0ab7 Merge trunk [08fc7dfb36]. 2023-04-19 17:05:58 +00:00
pooryorick 2fb58dc372 Merge trunk [c2d903f6ed]: apn-bigdata-tests. 2023-04-19 16:41:13 +00:00
pooryorick 2c78daa2b0 Fossil merge [1842599320]: TIP 660 accepted. 2023-04-19 12:20:25 +00:00
pooryorick 02c0281379 Merge trunk [883464ea32]. 2023-04-19 12:15:51 +00:00
pooryorick e736d151a0 Merge trunk-encodingdefaultstrict [d325b41eb8] 2023-04-19 12:11:55 +00:00
pooryorick dcb3b835e4 Merge trunk [1ef347e31d]. 2023-04-19 11:28:22 +00:00
pooryorick e027188168 Merge trunk [5995ca9b6c]. 2023-04-19 11:19:06 +00:00
pooryorick c4c090889c Merge trunk [f9c8bbde44]. 2023-04-19 07:43:57 +00:00
pooryorick 01570cabab Merge trunk [433637e689]. 2023-04-19 07:17:28 +00:00
pooryorick 182b7f85f6 Merge trunk [67baae2829]. 2023-04-18 23:57:32 +00:00
pooryorick e1b3b51a8f Merge trunk [32d5cdd8d0]. 2023-04-18 23:25:24 +00:00
pooryorick 23dd40e1a2 Merge trunk [8dba618fe6]. 2023-04-18 23:24:14 +00:00
pooryorick 9af2fb9efe Merge trunk [f9a80c2c9e]. 2023-04-18 23:22:43 +00:00
pooryorick 1a7bbea40c Merge trunk [4fc1f701cc] and resolve conflicts. 2023-04-18 22:56:24 +00:00
pooryorick aec3f90f4d Merge trunk [0d197907c6]. 2023-04-18 15:32:02 +00:00
pooryorick 198dbe0117 Merge trunk [e7fcdb7611]. 2023-04-18 13:24:40 +00:00
pooryorick 19eccf461d Merge trunk [cbaf88e90a]: Fix iocmd-12.11 testcase. 2023-04-18 13:16:54 +00:00
pooryorick ca96bc096f Merge trunk [a9fc905623] and resolve conflicts and test failures. 2023-04-18 13:05:39 +00:00
pooryorick 034957707a Merge trunk [79cd3ac351]. 2023-04-18 12:24:06 +00:00
pooryorick ce003df1ca Merge trunk [78beedf7e2] and resolve conflicts. 2023-04-18 12:12:41 +00:00
pooryorick 63e2ca9905 Merge trunk [c8983a2a94] and resolve conflicts. 2023-04-18 11:39:12 +00:00
pooryorick 9512351bc5 Merge trunk [48829d9671]: Fix [d7fd37ebd9]: handling leftover prefix in table
encoding.
2023-04-18 10:29:28 +00:00
pooryorick ce353e21ed Merge trunk [1253dd0211]:` Fix http11 test hang caused by trailing brace in
previous commit.
2023-04-18 08:07:56 +00:00
pooryorick fb61224892 Merge trunk [20cad126cd]: Don't let httpd11 depend on the system encoding any
more: All text files are now stored in utf-8.
2023-04-18 08:02:49 +00:00
pooryorick f10942c112 Merge trunk [b10e2b66a9], Tcl TIP 656 manpages. 2023-04-18 07:43:31 +00:00
pooryorick 62e806dc83 Merge trunk [49a4c8f8fb], "TIP 656 accepted", and resolve conflicts. 2023-04-17 21:33:41 +00:00
pooryorick 9831556bf7 Merge trunk [31788d9a4b] and resolve conflicts. 2023-04-17 13:30:36 +00:00
pooryorick 9586d2f54c Merge trunk [1997f71246]. 2023-04-17 11:31:50 +00:00
pooryorick 800f0a1edf Merge trunk [498ef65f88] and resolve conflicts. 2023-04-17 10:58:50 +00:00
pooryorick 304ca9a172 Merge trunk [91094999d0], resolve conflicts, and make Tcl_UtfToExternalDString
strict regarding encoding errors.
2023-04-16 18:30:54 +00:00
pooryorick d7fdb20ed5 Merge trunk [f868c40053] and resolve conflicts. 2023-04-16 17:07:15 +00:00
pooryorick 6e4c20e3a6 Merge trunk [32c5b5172b]. 2023-04-16 16:58:43 +00:00
pooryorick 704627190d Merge trunk [69fba9fb6b]: Fix [4bea02e811]: encoding convertfrom -strict
ascii \x7f generates exception Many other encodings had the same problem, and
also the reverse happened: encodings which should throw an exception with
-strict but didn't (within range 0x80-0x9F).
2023-04-16 16:40:37 +00:00
pooryorick a8075a956d Merge trunk [355a5e4733] and resolve conflicts and test failures. 2023-04-16 16:23:26 +00:00
pooryorick ab1a8089de Merge trunk [f64a19cf62] and resolve conflicts. 2023-04-16 14:05:13 +00:00
pooryorick 9c35850e30 Merge trunk [7b54fc6784]: Fix for [885c86a9a0]: convertfrom utf8 breaks for 4
byte utf encodings.
2023-04-16 13:48:59 +00:00
pooryorick 55bb2e9be3 Merge trunk [fc029613d5]. 2023-04-16 13:31:53 +00:00
pooryorick 0033456148 Merge trunk [e90924bb13]: test encoding-16.17. 2023-04-16 13:23:38 +00:00
pooryorick ce60562f86 Merge trunk [de933019a109d3d6]: Fix for [bd1a60eb9c]: convertfrom utf-8 strict
mode allows surrogates in input sequence.
2023-04-16 13:20:58 +00:00
pooryorick aad734db91 Merge trunk [2d036d968c] and resolve issues. 2023-04-16 08:29:10 +00:00
pooryorick c1ebc6273f Merge trunk [f118b6370b]. 2023-04-15 23:50:38 +00:00
pooryorick e08e3fbc09 Merge trunk [f9cdaa50ad]: First part of fix for [4a7397e0b3]. Not complete yet. 2023-04-15 22:52:02 +00:00
pooryorick ae955d6d24 merge trunk [77c37636f0]: DoReadChars() and Tcl_SetObjLength(). 2023-04-13 06:52:16 +00:00
pooryorick 756913ce13 Merge trunk [d65da06a77]: Correct spelling errors in comments and
documentation, but also a non-comment corections in history.tcl and
tcltest.test.
2023-04-12 14:44:08 +00:00
pooryorick 21fec5d3d1 Merge trunk [b921949acd]: More int -> Tcl_Size, so (theoretically) longer
lists could be handled. Thanks, Rolf!
2023-04-12 14:43:18 +00:00
pooryorick 72557b402d Merge trunk [9c60558723]: int -> Tcl_Size for tclWinDde.c/tclWinReg.c, so it
could (theoretically) handle larger lists in Tcl 9.
2023-04-12 14:42:10 +00:00
pooryorick a1d4fac3d8 Merge trunk [e825ea06803d4a61]: Editorial fix in Tcl_Panic() message. 2023-04-12 14:41:04 +00:00
pooryorick 3e3ef5f0be Merge trunk [b66d50b4d4]: Merge bug-[fa3d9fd818fa0072]. 2023-04-07 21:07:42 +00:00
pooryorick c70c765bc7 Merge trunk [c53063d69b]: TIP 602 - update manpages. 2023-04-07 20:26:47 +00:00
pooryorick a67d7e8610 Merge trunk [e1baa8ec4a]: Make sure that infoPtr->validMask only contains
TCL_READABLE|TCL_WRITABLE|TCL_EXCEPTION, no other flags.
2023-04-07 20:25:31 +00:00
pooryorick 2b4d8d160a Merge trunk [b27eacb7fc]: Fix [6390566ecd]: Testcase
cmdAH-4.3.13.00DC0000.tail.utf-32.tcl8.a fails sometimes.
2023-04-07 19:42:05 +00:00
pooryorick 3504682d15 Merge trunk [d29e69a635a0dc81]: TIP #628 addendum (various fixes to improve
handling of 8.7 <-> 9.0 header differences).
2023-04-07 18:43:26 +00:00
pooryorick 065cc78833 Merge trunk. 2023-04-04 18:56:27 +00:00
pooryorick 32aba95cdd Merge trunk. 2023-04-04 18:53:00 +00:00
pooryorick 15dbbaf497 Merge trunk [dc1e0b5f9a]: Minor fix in winConsole.test. 2023-04-04 14:11:05 +00:00
pooryorick f52fe2c0c0 Merge trunk [cbaf88e90a]: Fix iocmd-12.11 testcase. 2023-04-04 14:10:00 +00:00
pooryorick fc1e6cc187 Merge trunk [a9fc9056236f5775] : Fix [fa128568a5]: EOVERFLOW does not
necessarily mean "file too big". Synchronize many error-messages with what
Linux gives nowadays.
2023-04-04 14:08:38 +00:00
pooryorick dff9e4fbb2 Merge trunk [f8864b9541d149d2]: Merge 8.7. POSIX errors update and minizip fix. 2023-04-04 13:57:32 +00:00
pooryorick 92aeea296b Merge trunk [0569b8782f] : Remove unneeded parts from test in fileName.test. 2023-03-28 17:54:13 +00:00
pooryorick 42bbf78a33 Merge trunk [92ee031f32]: Make the documentation of [encoding] more concise
and readable.
2023-03-28 17:52:31 +00:00
pooryorick 04ef72b73b Merge trunk [4ebee22ffd]: Update reference-counting advice for Tcl_ObjSetVar2 and friends. 2023-03-28 17:51:26 +00:00
pooryorick e47a1c3779 Merge trunk [f8927d772b]: Avoid msvc "illegal indirection" error. 2023-03-28 16:32:57 +00:00
pooryorick ce09232ac7 Merge trunk [aa1a1096ac]: Fix memory leak in Tcl_JoinObjCmd(). 2023-03-28 16:32:01 +00:00
pooryorick 0a3bf031ac Merge trunk [79cd3ac351]: Update to tzdata 2023b. 2023-03-28 16:31:20 +00:00
pooryorick e78c831950 Merge trunk [7d005e0860]: Fix for [6d4e9d1af5bf5b7d]: Memory leak:
SetFsPathFromAny, assisted by the global literal table, causes a Tcl_Obj to
reference itself.
2023-03-28 16:30:24 +00:00
pooryorick e284637f4c Merge trunk [bb1378370e]: Fix [68417a8bb3]: No result/LF printed for 64-bit
integer type check.
2023-03-28 16:29:25 +00:00
pooryorick 97195d18a9 Merge trunk [6301de2138]: Fix various typos. 2023-03-28 16:27:57 +00:00
pooryorick 99af05cca8 Merge trunk [b29771bb5f]: Fix duplicate test name. 2023-03-28 16:25:38 +00:00
pooryorick 29a34b9b95 Merge trunk [5075be4f0b]: Add valgrind_each to Makefile.in. 2023-03-28 16:24:43 +00:00
pooryorick 30b1f27305 Merge trunk [82107b50c20baa70]: More TCL_INDEX_NONE. 2023-03-28 07:03:14 +00:00
pooryorick b2687dde17 Merge trunk [f25757b233]: Remove knownProfileBug constraint: this is already
fixed.
2023-03-28 06:51:54 +00:00
pooryorick a0ec63efa5 One missing int -> Tcl_Size change 2023-03-27 22:42:33 +00:00
pooryorick e1fca6fb5d Merge trunk [f4cf3c36b4] : Fix [0265750233]: invalid read in cmdAH-4.3.13.C1.solo.utf-8.tcl8 2023-03-27 22:36:04 +00:00
pooryorick 0fcfcc0f88 Merge trunk f8d60e395f: Move (TCL_ENCODING_PROFILE_MASK|GET|SET) from tcl.h to tclIO.h, since those are not public. Some formatting. 2023-03-24 13:27:08 +00:00
pooryorick 1852320cca Merge trunk e1cfef6bfd: Code cleanup: use more *SURROGATE() macros. 2023-03-24 13:25:14 +00:00
pooryorick 79e893e6f2 Merge trunk a9d278979e: Fix longIs64Bit->has64BitLengths else test will not run on 64-bit
Wind.
2023-03-24 13:20:27 +00:00
pooryorick 4232bc484d Merge trunk: Remove unneeded Tcl_IncrRefCount and TclDecrRefCount.
TclPtrSetVarIdx takes ownership of newValuePtr if its refCount is 0, and either
stores or frees it.
2023-03-24 13:19:44 +00:00
pooryorick af2c18d5ea Merge trunk 78beedf7e2: Fix [1bedc53c8c]: synchronous [read] with
-strictencoding does not produce an error on invalid input.
2023-03-24 13:18:51 +00:00
pooryorick fadb579028 Merge trunk c8983a2a94: Fix [154ed7ce56]: Tcl 9: [gets] on -strictencoding 1 configured
channel.
2023-03-24 13:16:26 +00:00
pooryorick ed01d27700 Merge trunk 037b767147: Missing backslashes in macro def. 2023-03-24 13:14:07 +00:00
pooryorick 09b9930667 Merge trunk dd8e66c296: More TclNewIndexObj() usages (for values between -1 and
SIZE_MAX-1).
2023-03-24 13:13:23 +00:00
pooryorick 657095d29a Merge trunk d89991c58b Fix [bdcb5126c0]: Failed assertion in test chan-io-7.3. 2023-03-23 21:38:14 +00:00
pooryorick 05277ab690 Merge trunk 15c9067453: Add longIs64bit constraint to lseq-4.4 (because this
isn't expected to work on 32-bit platforms). Remove some unused constraints.
2023-03-23 21:35:30 +00:00
pooryorick 333b4efa28 Merge trunk 1e23dd4876: Fix [5ae5ffc3f4]: Problem with -failindex on 32-bit platform. 2023-03-23 21:33:03 +00:00
pooryorick adbdca59a9 Merge trunk 1253dd0211: Fix http11 test hang caused by trailing brace in
previous commit.
2023-03-23 21:24:02 +00:00
pooryorick 2918f547d8 Merge trunk 20cad126cd: Don't let httpd11 depend on the system encoding any
more: All text files are now stored in utf-8.
2023-03-23 21:17:33 +00:00
pooryorick c52403ad33 Test TableFromUtfProc() with strict handling of encoding errors. 2023-01-25 19:56:57 +00:00
pooryorick 2b343d0207 Merge trunk. 2023-01-25 00:34:51 +00:00
pooryorick 5363b1f11f Rename [encoding convert*] option "-nocomplain"/"-ignore" to "-pass", and
"-nocomplainencoding"/"-encodingignore" to "-encodingpass".
2023-01-23 21:32:43 +00:00
pooryorick b49efc9ae0 Rename [encoding convert*] option "-nocomplain"/"-ignore" to "-pass", and
"-nocomplainencoding"/"-encodingignore" to  "-encodingpass"
2023-01-23 20:41:47 +00:00
pooryorick 7fe77d7ff8 Per TIP 601, the default behaviour of [encoding convert..] is to require valid input. 2023-01-23 13:53:51 +00:00
pooryorick f54d9a7c69 A branch for fixing TIP 346/601 issues, and other issues related to Unicode
encoding, while retaining the default of not raising an error when invalid data
for the encoding occurs.
2023-01-23 10:48:17 +00:00
pooryorick 9832ae4232 Fix issue with new options parsing in EncodingConvertfromObjCmd
EncodingConverttoObjCmd.
2023-01-22 11:45:56 +00:00
pooryorick 388bc52075 Merge trunk and resolve conflicts, including changing option processing for
EncodingConverttoObjCmd() and EncodingConvertfromObjCmd().
2023-01-20 00:19:38 +00:00
pooryorick 2c039a780e Add tests to verify the default behaviour for encoding errors. 2023-01-12 09:03:40 +00:00
pooryorick 5c70426f61 For [read] and [gets] encoding errors, used "-result read" in return options
dictionary instead of just "-result".
2023-01-08 00:01:50 +00:00
pooryorick d2fa0702bc Fix for [154ed7ce56], Tcl 9: [gets] on -strictencoding 1 configured channel. 2023-01-02 21:07:02 +00:00
pooryorick 530d3a7f83 Merge py-b8f575aa23. 2022-12-31 00:44:04 +00:00
pooryorick f98272ec1e Strict encoding conformance everywhere by default. Full test suite passes. 2022-12-29 18:11:24 +00:00
pooryorick ba64c646ee Unify TCL_ENCODING_STRICT and TCL_ENCODING_NOCOMPLAIN, and make strict encoding
conformance the default everywhere.
2022-12-28 23:35:24 +00:00
pooryorick f79b9fa715 Add Tcl_ObjTypeVersion(), fix memory errors in integer list functions, adjust
lset.test so that objInterface.test can use its tests.  All linsert.test and
lset.test tests pass for the integer list.
2021-11-13 09:09:00 +00:00
pooryorick 50baebbe77 Adjust [linsert] tests to check both compiled and uncompiled paths, and run
them for the integer list type as well.  All tests pass.
2021-11-03 14:34:17 +00:00
pooryorick 749fefd640 Fix memory errors in the "list replace" proc for the integer list type,
reorganize code, route "linsert" through the type interface, disable
compilation of linsert pending further developmnt,  and add more tests.
2021-11-03 00:34:21 +00:00
pooryorick 2e12764223 To test object type interfaces, add the beginnings of a list implementation
that stores items as an array of integers and the first few tests.  All tests
pass, and Valgrind reports that no memory leaks are possible.
2021-10-30 19:28:15 +00:00
pooryorick fc2acd077c Add the macro TCL_LENGTH_NONE. 2021-10-26 13:28:11 +00:00
jan.nijtmans e6c0a3dcfb Merge 9.0 2021-10-26 08:54:12 +00:00
jan.nijtmans 962a5361ab typo 2021-10-26 08:42:48 +00:00
pooryorick a15ae048d3 Fix memory errors in lsearch, add the first few string routines to Tcl_ObjType,
modify StringIndexCmd to use to use the Tcl_ObjType interface.  Valgrind
reports no memory errors.
2021-10-24 15:55:24 +00:00
pooryorick f91edb6f99 Add the first few string functions to the Tcl_ObjType interface, move function
declarations out of tclInt.h.
2021-10-18 15:02:39 +00:00
jan.nijtmans 3763c10f23 Adapt Makefile.in and makefile.vc (for Windows) too 2021-10-18 07:43:20 +00:00
jan.nijtmans 84f1110b9d More compiler warnings 2021-10-17 20:55:15 +00:00
jan.nijtmans 6bb895f4c6 Compiler warnings/errors 2021-10-17 15:05:47 +00:00
pooryorick c4329d52b1 Adapt Tcl_LsearchObjCmd to perform efficient binary search on non-finite
Tcl_ObjType list implementations.
2021-10-16 22:04:03 +00:00
jan.nijtmans 86ec6ab749 Make it compile on MacOS too 2021-10-16 11:39:37 +00:00
jan.nijtmans 07235a8a6f at least - make it compile/run on UNIX 2021-10-16 09:45:38 +00:00
pooryorick e36e170f46 Modify Tcl_LsearchObjCmd() to not use TclListObjGetElements. 2021-10-15 19:21:39 +00:00
pooryorick 5f1e5885b7 Add tests for Tcl_ObjType "lrange" interface. 2021-10-14 20:43:04 +00:00
pooryorick f04818aaa8 Modify Tcl_LrangeObjCmd() to handle lists having indeterminate end. Fix typo
in INST_LIST_RANGE_IMM.
2021-10-14 20:08:41 +00:00
pooryorick 2e1f7ff673 Fix TclObjectDispatchNoDefault macro, add a rangeEnd function to the list
interface, improve handling of indeterminate in  
INST_LIST_INDEX_IMM and add similar handling to  INST_LIST_RANGE_IMM,
2021-10-14 14:52:05 +00:00
pooryorick 6d704ccf07 Add "indexEnd" function to Tcl_Obj list interface
table, ditch idea of using ssize_t, add TclObjectDispatchNoDefault for
interface fucntions that have no existing Tcl implemntation, rework
TclLindexFlat to route "end" indices to the indexEnd interface if there is one.
2021-10-13 11:27:45 +00:00
pooryorick fef646d799 Use TCL_INDEX_NONE as the indicator of an invalid index, modify TclLindexFlat
to produce an error when "end" is used as an index of a list having
indeterminate size, and add tests for [lindex] "end" in this case.
2021-10-10 13:00:25 +00:00
pooryorick 2f0b5c46a2 For testing, Add testIndexHexType, a Tcl_ObjType that implements its own list
interface.
2021-10-09 16:46:42 +00:00
pooryorick 03a672aeea Add "interp" argument to TclListRange, add new C procedures "TclLengthIsFinite"
and "TclLindexLast", start using a length of -1 to indicate that a list is
unbounded, and modify TclListObjRange() to be more amenable to unbounded lists,
and modify INST_LIST_RANGE_IMM bytecode routine for the same reason.
2021-10-09 16:39:49 +00:00
pooryorick 3294957eb6 Add length to TclListObjRange since callers alread have it and it makes working
with a Tcl_ObjType interface easier.  Fix tclListType in tclStrToD.c Adapt
INST_LIST_INDEX_IMM in tclExecute.c to work with Tcl_ObjType interfaces.
2021-10-07 21:09:07 +00:00
pooryorick 4789965abd Rework TclLindexFlat to function with Tcl_ObjType interfaces. 2021-10-07 19:36:19 +00:00
pooryorick 9735f7b1a9 For backwards-compatibility, shoehorn Tcl_ObjType interface structure into
existing public interface.
2021-10-05 06:07:38 +00:00
pooryorick 0779620efd Rename the Tcl_ObjType interface.list.append to interface.list.appendlist, use
interface.list.append, and add Tcl_ListObjAppendElement to tclListtype.
2021-09-28 19:26:19 +00:00
pooryorick 69675d1a04 Add remaining list routines to the Tcl_ObjType interface. 2021-09-28 00:12:36 +00:00
pooryorick 57ed822ecb Add an "interface" member to Tcl_ObjType, and plug lindex
and lrange into the interface.
2021-09-27 16:07:11 +00:00
pooryorick 314feacb7c Create new branch named "pyk-objinterface" 2021-09-23 12:56:14 +00:00
168 changed files with 14131 additions and 14215 deletions
-2
View File
@@ -48,11 +48,9 @@ libtommath/*.tex
macosx/configure
unix/autoMkindex.tcl
unix/dltest.marker
unix/dltest/embtest
unix/dltest/*.bundle
unix/dltest/*.dll
unix/dltest/*.dylib
unix/dltest/*.exe
unix/dltest/*.o
unix/dltest/*.sl
unix/dltest/*.so
-11
View File
@@ -4,7 +4,6 @@ on:
branches:
- "main"
- "core-8-branch"
- "core-8-6-branch"
tags:
- "core-**"
permissions:
@@ -16,8 +15,6 @@ jobs:
matrix:
cfgopt:
- ""
- "CFLAGS=-DTCL_UTF_MAX=3"
- "CFLAGS=-DTCL_NO_DEPRECATED=1"
- "--disable-shared"
- "--enable-symbols"
- "--enable-symbols=mem"
@@ -29,7 +26,6 @@ jobs:
steps:
- name: Checkout
uses: actions/checkout@v3
timeout-minutes: 5
- name: Prepare
run: |
touch tclStubInit.c tclOOStubInit.c tclOOScript.h
@@ -40,30 +36,23 @@ jobs:
./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
env:
CFGOPT: ${{ matrix.cfgopt }}
timeout-minutes: 5
- name: Build
run: |
make all
timeout-minutes: 5
- name: Build Test Harness
run: |
make tcltest
timeout-minutes: 5
- name: Run Tests
run: |
make test
env:
ERROR_ON_FAILURES: 1
timeout-minutes: 30
- name: Test-Drive Installation
run: |
make install
timeout-minutes: 5
- name: Create Distribution Package
run: |
make dist
timeout-minutes: 5
- name: Convert Documentation to HTML
run: |
make html-tcl
timeout-minutes: 5
-8
View File
@@ -4,7 +4,6 @@ on:
branches:
- "main"
- "core-8-branch"
- "core-8-6-branch"
tags:
- "core-**"
permissions:
@@ -19,7 +18,6 @@ jobs:
steps:
- name: Checkout
uses: actions/checkout@v3
timeout-minutes: 5
- name: Prepare
run: |
touch tclStubInit.c tclOOStubInit.c tclOOScript.h
@@ -28,13 +26,11 @@ jobs:
run: make all
env:
CFLAGS: -arch x86_64 -arch arm64
timeout-minutes: 15
- name: Run Tests
run: make test styles=develop
env:
ERROR_ON_FAILURES: 1
MAC_CI: 1
timeout-minutes: 15
clang:
runs-on: macos-11
strategy:
@@ -52,7 +48,6 @@ jobs:
steps:
- name: Checkout
uses: actions/checkout@v3
timeout-minutes: 5
- name: Prepare
run: |
touch tclStubInit.c tclOOStubInit.c tclOOScript.h
@@ -64,17 +59,14 @@ jobs:
env:
CFLAGS: -arch x86_64 -arch arm64
CFGOPT: ${{ matrix.cfgopt }}
timeout-minutes: 5
- name: Build
run: |
make all tcltest
env:
CFLAGS: -arch x86_64 -arch arm64
timeout-minutes: 15
- name: Run Tests
run: |
make test
env:
ERROR_ON_FAILURES: 1
MAC_CI: 1
timeout-minutes: 15
-3
View File
@@ -15,7 +15,6 @@ jobs:
defaults:
run:
shell: bash
timeout-minutes: 10
steps:
- name: Checkout
uses: actions/checkout@v3
@@ -51,7 +50,6 @@ jobs:
defaults:
run:
shell: bash
timeout-minutes: 10
steps:
- name: Checkout
uses: actions/checkout@v3
@@ -114,7 +112,6 @@ jobs:
defaults:
run:
shell: msys2 {0}
timeout-minutes: 10
env:
CC: gcc
CFGOPT: --disable-symbols --disable-shared
-14
View File
@@ -4,7 +4,6 @@ on:
branches:
- "main"
- "core-8-branch"
- "core-8-6-branch"
tags:
- "core-**"
permissions:
@@ -31,31 +30,26 @@ jobs:
steps:
- name: Checkout
uses: actions/checkout@v3
timeout-minutes: 5
- name: Init MSVC
uses: ilammy/msvc-dev-cmd@v1
timeout-minutes: 5
- name: Build ${{ matrix.cfgopt }}
run: |
&nmake -f makefile.vc ${{ matrix.cfgopt }} all
if ($lastexitcode -ne 0) {
throw "nmake exit code: $lastexitcode"
}
timeout-minutes: 5
- name: Build Test Harness ${{ matrix.cfgopt }}
run: |
&nmake -f makefile.vc ${{ matrix.cfgopt }} tcltest
if ($lastexitcode -ne 0) {
throw "nmake exit code: $lastexitcode"
}
timeout-minutes: 5
- name: Run Tests ${{ matrix.cfgopt }}
run: |
&nmake -f makefile.vc ${{ matrix.cfgopt }} test
if ($lastexitcode -ne 0) {
throw "nmake exit code: $lastexitcode"
}
timeout-minutes: 30
gcc:
runs-on: windows-2022
defaults:
@@ -66,8 +60,6 @@ jobs:
matrix:
cfgopt:
- ""
- "CFLAGS=-DTCL_UTF_MAX=3"
- "CFLAGS=-DTCL_NO_DEPRECATED=1"
- "--disable-shared"
- "--enable-symbols"
- "--enable-symbols=mem"
@@ -79,10 +71,8 @@ jobs:
with:
msystem: MINGW64
install: git mingw-w64-x86_64-toolchain make
timeout-minutes: 10
- name: Checkout
uses: actions/checkout@v3
timeout-minutes: 5
- name: Prepare
run: |
touch tclStubInit.c tclOOStubInit.c tclOOScript.h
@@ -93,16 +83,12 @@ jobs:
./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
env:
CFGOPT: --enable-64bit ${{ matrix.cfgopt }}
timeout-minutes: 5
- name: Build
run: make all
timeout-minutes: 5
- name: Build Test Harness
run: make tcltest
timeout-minutes: 5
- name: Run Tests
run: make test
timeout-minutes: 30
# If you add builds with Wine, be sure to define the environment variable
# CI_USING_WINE when running them so that broken tests know not to run.
-1
View File
@@ -53,7 +53,6 @@ libtommath/*.tex
macosx/configure
unix/autoMkindex.tcl
unix/dltest.marker
unix/dltest/embtest
unix/tcl.pc
unix/tclIndex
unix/pkgs/*
-36
View File
@@ -20,20 +20,12 @@ jobs:
compiler: gcc
env:
- BUILD_DIR=unix
- name: "Linux/GCC/Shared: UTF_MAX=3"
os: linux
dist: focal
compiler: gcc
env:
- BUILD_DIR=unix
- CFGOPT="CFLAGS=-DTCL_UTF_MAX=3"
- name: "Linux/GCC/Shared: NO_DEPRECATED"
os: linux
dist: focal
compiler: gcc
env:
- BUILD_DIR=unix
- CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1"
- name: "Linux/GCC/Static"
os: linux
dist: focal
@@ -301,20 +293,6 @@ jobs:
- touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h
- choco install -y make zip
- cd ${BUILD_DIR}
- name: "Windows/GCC/Shared: UTF_MAX=3"
os: windows
compiler: gcc
env:
- BUILD_DIR=win
- CFGOPT="--enable-64bit CFLAGS=-DTCL_UTF_MAX=3"
before_install: *makepreinst
- name: "Windows/GCC/Shared: NO_DEPRECATED"
os: windows
compiler: gcc
env:
- BUILD_DIR=win
- CFGOPT="--enable-64bit CFLAGS=-DTCL_NO_DEPRECATED=1"
before_install: *makepreinst
- name: "Windows/GCC/Static"
os: windows
compiler: gcc
@@ -343,20 +321,6 @@ jobs:
env:
- BUILD_DIR=win
before_install: *makepreinst
- name: "Windows/GCC-x86/Shared: UTF_MAX=3"
os: windows
compiler: gcc
env:
- BUILD_DIR=win
- CFGOPT="CFLAGS=-DTCL_UTF_MAX=3"
before_install: *makepreinst
- name: "Windows/GCC-x86/Shared: NO_DEPRECATED"
os: windows
compiler: gcc
env:
- BUILD_DIR=win
- CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1"
before_install: *makepreinst
- name: "Windows/GCC-x86/Static"
os: windows
compiler: gcc
+1 -1
View File
@@ -8247,7 +8247,7 @@ Dropped support for OS X versions less than 10.4 (Tiger) (fellows)
2013-06-05 (bug fix)[2835313] [while 1 {foo [continue]}] crash (fellows)
2013-06-17 (bug fix)[a876646] [:cntrl:] includes \x00 to \x1F (nijtmans)
2013-06-17 (bug fix)[a876646] [:cntrl:] includes \x00 to \x1f (nijtmans)
2013-06-27 (bug fix)[983509] missing encodings for config values (nijtmans)
+21
View File
@@ -0,0 +1,21 @@
/*
* dirent.h --
*
* This file is a replacement for <dirent.h> in systems that
* support the old BSD-style <sys/dir.h> with a "struct direct".
*
* Copyright (c) 1991 The Regents of the University of California.
* Copyright (c) 1994 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#ifndef _DIRENT
#define _DIRENT
#include <sys/dir.h>
#define dirent direct
#endif /* _DIRENT */
+53
View File
@@ -0,0 +1,53 @@
/*
* dirent.h --
*
* Declarations of a library of directory-reading procedures
* in the POSIX style ("struct dirent").
*
* Copyright (c) 1991 The Regents of the University of California.
* Copyright (c) 1994 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#ifndef _DIRENT
#define _DIRENT
/*
* Dirent structure, which holds information about a single
* directory entry.
*/
#define MAXNAMLEN 255
#define DIRBLKSIZ 512
struct dirent {
long d_ino; /* Inode number of entry */
short d_reclen; /* Length of this record */
short d_namlen; /* Length of string in d_name */
char d_name[MAXNAMLEN + 1]; /* Name must be no longer than this */
};
/*
* State that keeps track of the reading of a directory (clients
* should never look inside this structure; the fields should
* only be accessed by the library procedures).
*/
typedef struct _dirdesc {
int dd_fd;
long dd_loc;
long dd_size;
char dd_buf[DIRBLKSIZ];
} DIR;
/*
* Procedures defined for reading directories:
*/
extern void closedir (DIR *dirp);
extern DIR * opendir (char *name);
extern struct dirent * readdir (DIR *dirp);
#endif /* _DIRENT */
+64
View File
@@ -0,0 +1,64 @@
/*
* memcmp.c --
*
* Source code for the "memcmp" library routine.
*
* Copyright (c) 1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclPort.h"
/*
* Here is the prototype just in case it is not included in tclPort.h.
*/
int memcmp(const void *s1, const void *s2, size_t n);
/*
*----------------------------------------------------------------------
*
* memcmp --
*
* Compares two bytes sequences.
*
* Results:
* Compares its arguments, looking at the first n bytes (each interpreted
* as an unsigned char), and returns an integer less than, equal to, or
* greater than 0, according as s1 is less than, equal to, or greater
* than s2 when taken to be unsigned 8 bit numbers.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
memcmp(
const void *s1, /* First string. */
const void *s2, /* Second string. */
size_t n) /* Length to compare. */
{
const unsigned char *ptr1 = (const unsigned char *) s1;
const unsigned char *ptr2 = (const unsigned char *) s2;
for ( ; n-- ; ptr1++, ptr2++) {
unsigned char u1 = *ptr1, u2 = *ptr2;
if (u1 != u2) {
return (u1-u2);
}
}
return 0;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
+109
View File
@@ -0,0 +1,109 @@
/*
* opendir.c --
*
* This file provides dirent-style directory-reading procedures for V7
* Unix systems that don't have such procedures. The origin of this code
* is unclear, but it seems to have come originally from Larry Wall.
*/
#include "tclInt.h"
#undef DIRSIZ
#define DIRSIZ(dp) \
((sizeof(struct dirent) - (MAXNAMLEN+1)) + (((dp)->d_namlen+1 + 3) &~ 3))
/*
* open a directory.
*/
DIR *
opendir(
char *name)
{
DIR *dirp;
int fd;
const char *myname;
myname = ((*name == '\0') ? "." : name);
if ((fd = open(myname, 0, 0)) == -1) {
return NULL;
}
dirp = (DIR *) Tcl_AttemptAlloc(sizeof(DIR));
if (dirp == NULL) {
close(fd);
return NULL;
}
dirp->dd_fd = fd;
dirp->dd_loc = 0;
return dirp;
}
/*
* read an old style directory entry and present it as a new one
*/
#ifndef pyr
#define ODIRSIZ 14
struct olddirect {
ino_t od_ino;
char od_name[ODIRSIZ];
};
#else /* a Pyramid in the ATT universe */
#define ODIRSIZ 248
struct olddirect {
long od_ino;
short od_fill1, od_fill2;
char od_name[ODIRSIZ];
};
#endif
/*
* get next entry in a directory.
*/
struct dirent *
readdir(
DIR *dirp)
{
struct olddirect *dp;
static struct dirent dir;
for (;;) {
if (dirp->dd_loc == 0) {
dirp->dd_size = read(dirp->dd_fd, dirp->dd_buf, DIRBLKSIZ);
if (dirp->dd_size <= 0) {
return NULL;
}
}
if (dirp->dd_loc >= dirp->dd_size) {
dirp->dd_loc = 0;
continue;
}
dp = (struct olddirect *)(dirp->dd_buf + dirp->dd_loc);
dirp->dd_loc += sizeof(struct olddirect);
if (dp->od_ino == 0) {
continue;
}
dir.d_ino = dp->od_ino;
strncpy(dir.d_name, dp->od_name, ODIRSIZ);
dir.d_name[ODIRSIZ] = '\0'; /* insure null termination */
dir.d_namlen = strlen(dir.d_name);
dir.d_reclen = DIRSIZ(&dir);
return &dir;
}
}
/*
* close a directory.
*/
void
closedir(
DIR *dirp)
{
close(dirp->dd_fd);
dirp->dd_fd = -1;
dirp->dd_loc = 0;
Tcl_Free(dirp);
}
+919
View File
@@ -0,0 +1,919 @@
/* A portable stdint.h
****************************************************************************
* BSD License:
****************************************************************************
*
* Copyright (c) 2005-2016 Paul Hsieh
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
*
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. The name of the author may not be used to endorse or promote products
* derived from this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
* IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
* OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
* IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
* INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
* NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
* THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*
****************************************************************************
*
* Version 0.1.16.0
*
* The ANSI C standard committee, for the C99 standard, specified the
* inclusion of a new standard include file called stdint.h. This is
* a very useful and long desired include file which contains several
* very precise definitions for integer scalar types that is critically
* important for making several classes of applications portable
* including cryptography, hashing, variable length integer libraries
* and so on. But for most developers its likely useful just for
* programming sanity.
*
* The problem is that some compiler vendors chose to ignore the C99
* standard and some older compilers have no opportunity to be updated.
* Because of this situation, simply including stdint.h in your code
* makes it unportable.
*
* So that's what this file is all about. It's an attempt to build a
* single universal include file that works on as many platforms as
* possible to deliver what stdint.h is supposed to. Even compilers
* that already come with stdint.h can use this file instead without
* any loss of functionality. A few things that should be noted about
* this file:
*
* 1) It is not guaranteed to be portable and/or present an identical
* interface on all platforms. The extreme variability of the
* ANSI C standard makes this an impossibility right from the
* very get go. Its really only meant to be useful for the vast
* majority of platforms that possess the capability of
* implementing usefully and precisely defined, standard sized
* integer scalars. Systems which are not intrinsically 2s
* complement may produce invalid constants.
*
* 2) There is an unavoidable use of non-reserved symbols.
*
* 3) Other standard include files are invoked.
*
* 4) This file may come in conflict with future platforms that do
* include stdint.h. The hope is that one or the other can be
* used with no real difference.
*
* 5) In the current version, if your platform can't represent
* int32_t, int16_t and int8_t, it just dumps out with a compiler
* error.
*
* 6) 64 bit integers may or may not be defined. Test for their
* presence with the test: #ifdef INT64_MAX or #ifdef UINT64_MAX.
* Note that this is different from the C99 specification which
* requires the existence of 64 bit support in the compiler. If
* this is not defined for your platform, yet it is capable of
* dealing with 64 bits then it is because this file has not yet
* been extended to cover all of your system's capabilities.
*
* 7) (u)intptr_t may or may not be defined. Test for its presence
* with the test: #ifdef PTRDIFF_MAX. If this is not defined
* for your platform, then it is because this file has not yet
* been extended to cover all of your system's capabilities, not
* because its optional.
*
* 8) The following might not been defined even if your platform is
* capable of defining it:
*
* WCHAR_MIN
* WCHAR_MAX
* (u)int64_t
* PTRDIFF_MIN
* PTRDIFF_MAX
* (u)intptr_t
*
* 9) The following have not been defined:
*
* WINT_MIN
* WINT_MAX
*
* 10) The criteria for defining (u)int_least(*)_t isn't clear,
* except for systems which don't have a type that precisely
* defined 8, 16, or 32 bit types (which this include file does
* not support anyways). Default definitions have been given.
*
* 11) The criteria for defining (u)int_fast(*)_t isn't something I
* would trust to any particular compiler vendor or the ANSI C
* committee. It is well known that "compatible systems" are
* commonly created that have very different performance
* characteristics from the systems they are compatible with,
* especially those whose vendors make both the compiler and the
* system. Default definitions have been given, but its strongly
* recommended that users never use these definitions for any
* reason (they do *NOT* deliver any serious guarantee of
* improved performance -- not in this file, nor any vendor's
* stdint.h).
*
* 12) The following macros:
*
* PRINTF_INTMAX_MODIFIER
* PRINTF_INT64_MODIFIER
* PRINTF_INT32_MODIFIER
* PRINTF_INT16_MODIFIER
* PRINTF_LEAST64_MODIFIER
* PRINTF_LEAST32_MODIFIER
* PRINTF_LEAST16_MODIFIER
* PRINTF_INTPTR_MODIFIER
*
* are strings which have been defined as the modifiers required
* for the "d", "u" and "x" printf formats to correctly output
* (u)intmax_t, (u)int64_t, (u)int32_t, (u)int16_t, (u)least64_t,
* (u)least32_t, (u)least16_t and (u)intptr_t types respectively.
* PRINTF_INTPTR_MODIFIER is not defined for some systems which
* provide their own stdint.h. PRINTF_INT64_MODIFIER is not
* defined if INT64_MAX is not defined. These are an extension
* beyond what C99 specifies must be in stdint.h.
*
* In addition, the following macros are defined:
*
* PRINTF_INTMAX_HEX_WIDTH
* PRINTF_INT64_HEX_WIDTH
* PRINTF_INT32_HEX_WIDTH
* PRINTF_INT16_HEX_WIDTH
* PRINTF_INT8_HEX_WIDTH
* PRINTF_INTMAX_DEC_WIDTH
* PRINTF_INT64_DEC_WIDTH
* PRINTF_INT32_DEC_WIDTH
* PRINTF_INT16_DEC_WIDTH
* PRINTF_UINT8_DEC_WIDTH
* PRINTF_UINTMAX_DEC_WIDTH
* PRINTF_UINT64_DEC_WIDTH
* PRINTF_UINT32_DEC_WIDTH
* PRINTF_UINT16_DEC_WIDTH
* PRINTF_UINT8_DEC_WIDTH
*
* Which specifies the maximum number of characters required to
* print the number of that type in either hexadecimal or decimal.
* These are an extension beyond what C99 specifies must be in
* stdint.h.
*
* Compilers tested (all with 0 warnings at their highest respective
* settings): Borland Turbo C 2.0, WATCOM C/C++ 11.0 (16 bits and 32
* bits), Microsoft Visual C++ 6.0 (32 bit), Microsoft Visual Studio
* .net (VC7), Intel C++ 4.0, GNU gcc v3.3.3
*
* This file should be considered a work in progress. Suggestions for
* improvements, especially those which increase coverage are strongly
* encouraged.
*
* Acknowledgements
*
* The following people have made significant contributions to the
* development and testing of this file:
*
* Chris Howie
* John Steele Scott
* Dave Thorup
* John Dill
* Florian Wobbe
* Christopher Sean Morrison
* Mikkel Fahnoe Jorgensen
*
*/
#include <stddef.h>
#include <limits.h>
#include <signal.h>
/*
* For gcc with _STDINT_H, fill in the PRINTF_INT*_MODIFIER macros, and
* do nothing else. On the Mac OS X version of gcc this is _STDINT_H_.
*/
#if ((defined(__SUNPRO_C) && __SUNPRO_C >= 0x570) || (defined(_MSC_VER) && _MSC_VER >= 1600) || (defined(__STDC__) && __STDC__ && defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || (defined (__WATCOMC__) && (defined (_STDINT_H_INCLUDED) || __WATCOMC__ >= 1250)) || (defined(__GNUC__) && (__GNUC__ > 3 || defined(_STDINT_H) || defined(_STDINT_H_) || defined (__UINT_FAST64_TYPE__)) )) && !defined (_PSTDINT_H_INCLUDED)
#include <stdint.h>
#define _PSTDINT_H_INCLUDED
# if defined(__GNUC__) && (defined(__x86_64__) || defined(__ppc64__)) && !(defined(__APPLE__) && defined(__MACH__))
# ifndef PRINTF_INT64_MODIFIER
# define PRINTF_INT64_MODIFIER "l"
# endif
# ifndef PRINTF_INT32_MODIFIER
# define PRINTF_INT32_MODIFIER ""
# endif
# else
# ifndef PRINTF_INT64_MODIFIER
# define PRINTF_INT64_MODIFIER "ll"
# endif
# ifndef PRINTF_INT32_MODIFIER
# if (UINT_MAX == UINT32_MAX)
# define PRINTF_INT32_MODIFIER ""
# else
# define PRINTF_INT32_MODIFIER "l"
# endif
# endif
# endif
# ifndef PRINTF_INT16_MODIFIER
# define PRINTF_INT16_MODIFIER "h"
# endif
# ifndef PRINTF_INTMAX_MODIFIER
# define PRINTF_INTMAX_MODIFIER PRINTF_INT64_MODIFIER
# endif
# ifndef PRINTF_INT64_HEX_WIDTH
# define PRINTF_INT64_HEX_WIDTH "16"
# endif
# ifndef PRINTF_UINT64_HEX_WIDTH
# define PRINTF_UINT64_HEX_WIDTH "16"
# endif
# ifndef PRINTF_INT32_HEX_WIDTH
# define PRINTF_INT32_HEX_WIDTH "8"
# endif
# ifndef PRINTF_UINT32_HEX_WIDTH
# define PRINTF_UINT32_HEX_WIDTH "8"
# endif
# ifndef PRINTF_INT16_HEX_WIDTH
# define PRINTF_INT16_HEX_WIDTH "4"
# endif
# ifndef PRINTF_UINT16_HEX_WIDTH
# define PRINTF_UINT16_HEX_WIDTH "4"
# endif
# ifndef PRINTF_INT8_HEX_WIDTH
# define PRINTF_INT8_HEX_WIDTH "2"
# endif
# ifndef PRINTF_UINT8_HEX_WIDTH
# define PRINTF_UINT8_HEX_WIDTH "2"
# endif
# ifndef PRINTF_INT64_DEC_WIDTH
# define PRINTF_INT64_DEC_WIDTH "19"
# endif
# ifndef PRINTF_UINT64_DEC_WIDTH
# define PRINTF_UINT64_DEC_WIDTH "20"
# endif
# ifndef PRINTF_INT32_DEC_WIDTH
# define PRINTF_INT32_DEC_WIDTH "10"
# endif
# ifndef PRINTF_UINT32_DEC_WIDTH
# define PRINTF_UINT32_DEC_WIDTH "10"
# endif
# ifndef PRINTF_INT16_DEC_WIDTH
# define PRINTF_INT16_DEC_WIDTH "5"
# endif
# ifndef PRINTF_UINT16_DEC_WIDTH
# define PRINTF_UINT16_DEC_WIDTH "5"
# endif
# ifndef PRINTF_INT8_DEC_WIDTH
# define PRINTF_INT8_DEC_WIDTH "3"
# endif
# ifndef PRINTF_UINT8_DEC_WIDTH
# define PRINTF_UINT8_DEC_WIDTH "3"
# endif
# ifndef PRINTF_INTMAX_HEX_WIDTH
# define PRINTF_INTMAX_HEX_WIDTH PRINTF_UINT64_HEX_WIDTH
# endif
# ifndef PRINTF_UINTMAX_HEX_WIDTH
# define PRINTF_UINTMAX_HEX_WIDTH PRINTF_UINT64_HEX_WIDTH
# endif
# ifndef PRINTF_INTMAX_DEC_WIDTH
# define PRINTF_INTMAX_DEC_WIDTH PRINTF_UINT64_DEC_WIDTH
# endif
# ifndef PRINTF_UINTMAX_DEC_WIDTH
# define PRINTF_UINTMAX_DEC_WIDTH PRINTF_UINT64_DEC_WIDTH
# endif
/*
* Something really weird is going on with Open Watcom. Just pull some of
* these duplicated definitions from Open Watcom's stdint.h file for now.
*/
# if defined (__WATCOMC__) && __WATCOMC__ >= 1250
# if !defined (INT64_C)
# define INT64_C(x) (x + (INT64_MAX - INT64_MAX))
# endif
# if !defined (UINT64_C)
# define UINT64_C(x) (x + (UINT64_MAX - UINT64_MAX))
# endif
# if !defined (INT32_C)
# define INT32_C(x) (x + (INT32_MAX - INT32_MAX))
# endif
# if !defined (UINT32_C)
# define UINT32_C(x) (x + (UINT32_MAX - UINT32_MAX))
# endif
# if !defined (INT16_C)
# define INT16_C(x) (x)
# endif
# if !defined (UINT16_C)
# define UINT16_C(x) (x)
# endif
# if !defined (INT8_C)
# define INT8_C(x) (x)
# endif
# if !defined (UINT8_C)
# define UINT8_C(x) (x)
# endif
# if !defined (UINT64_MAX)
# define UINT64_MAX 18446744073709551615ULL
# endif
# if !defined (INT64_MAX)
# define INT64_MAX 9223372036854775807LL
# endif
# if !defined (UINT32_MAX)
# define UINT32_MAX 4294967295UL
# endif
# if !defined (INT32_MAX)
# define INT32_MAX 2147483647L
# endif
# if !defined (INTMAX_MAX)
# define INTMAX_MAX INT64_MAX
# endif
# if !defined (INTMAX_MIN)
# define INTMAX_MIN INT64_MIN
# endif
# endif
#endif
/*
* I have no idea what is the truly correct thing to do on older Solaris.
* From some online discussions, this seems to be what is being
* recommended. For people who actually are developing on older Solaris,
* what I would like to know is, does this define all of the relevant
* macros of a complete stdint.h? Remember, in pstdint.h 64 bit is
* considered optional.
*/
#if (defined(__SUNPRO_C) && __SUNPRO_C >= 0x420) && !defined(_PSTDINT_H_INCLUDED)
#include <sys/inttypes.h>
#define _PSTDINT_H_INCLUDED
#endif
#ifndef _PSTDINT_H_INCLUDED
#define _PSTDINT_H_INCLUDED
#ifndef SIZE_MAX
# define SIZE_MAX ((size_t)-1)
#endif
/*
* Deduce the type assignments from limits.h under the assumption that
* integer sizes in bits are powers of 2, and follow the ANSI
* definitions.
*/
#ifndef UINT8_MAX
# define UINT8_MAX 0xff
#endif
#if !defined(uint8_t) && !defined(_UINT8_T) && !defined(vxWorks)
# if (UCHAR_MAX == UINT8_MAX) || defined (S_SPLINT_S)
typedef unsigned char uint8_t;
# define UINT8_C(v) ((uint8_t) v)
# else
# error "Platform not supported"
# endif
#endif
#ifndef INT8_MAX
# define INT8_MAX 0x7f
#endif
#ifndef INT8_MIN
# define INT8_MIN INT8_C(0x80)
#endif
#if !defined(int8_t) && !defined(_INT8_T) && !defined(vxWorks)
# if (SCHAR_MAX == INT8_MAX) || defined (S_SPLINT_S)
typedef signed char int8_t;
# define INT8_C(v) ((int8_t) v)
# else
# error "Platform not supported"
# endif
#endif
#ifndef UINT16_MAX
# define UINT16_MAX 0xffff
#endif
#if !defined(uint16_t) && !defined(_UINT16_T) && !defined(vxWorks)
#if (UINT_MAX == UINT16_MAX) || defined (S_SPLINT_S)
typedef unsigned int uint16_t;
# ifndef PRINTF_INT16_MODIFIER
# define PRINTF_INT16_MODIFIER ""
# endif
# define UINT16_C(v) ((uint16_t) (v))
#elif (USHRT_MAX == UINT16_MAX)
typedef unsigned short uint16_t;
# define UINT16_C(v) ((uint16_t) (v))
# ifndef PRINTF_INT16_MODIFIER
# define PRINTF_INT16_MODIFIER "h"
# endif
#else
#error "Platform not supported"
#endif
#endif
#ifndef INT16_MAX
# define INT16_MAX 0x7fff
#endif
#ifndef INT16_MIN
# define INT16_MIN INT16_C(0x8000)
#endif
#if !defined(int16_t) && !defined(_INT16_T) && !defined(vxWorks)
#if (INT_MAX == INT16_MAX) || defined (S_SPLINT_S)
typedef signed int int16_t;
# define INT16_C(v) ((int16_t) (v))
# ifndef PRINTF_INT16_MODIFIER
# define PRINTF_INT16_MODIFIER ""
# endif
#elif (SHRT_MAX == INT16_MAX)
typedef signed short int16_t;
# define INT16_C(v) ((int16_t) (v))
# ifndef PRINTF_INT16_MODIFIER
# define PRINTF_INT16_MODIFIER "h"
# endif
#else
#error "Platform not supported"
#endif
#endif
#ifndef UINT32_MAX
# define UINT32_MAX (0xffffffffUL)
#endif
#if !defined(uint32_t) && !defined(_UINT32_T) && !defined(vxWorks)
#if (ULONG_MAX == UINT32_MAX) || defined (S_SPLINT_S)
typedef unsigned long uint32_t;
# define UINT32_C(v) v ## UL
# ifndef PRINTF_INT32_MODIFIER
# define PRINTF_INT32_MODIFIER "l"
# endif
#elif (UINT_MAX == UINT32_MAX)
typedef unsigned int uint32_t;
# ifndef PRINTF_INT32_MODIFIER
# define PRINTF_INT32_MODIFIER ""
# endif
# define UINT32_C(v) v ## U
#elif (USHRT_MAX == UINT32_MAX)
typedef unsigned short uint32_t;
# define UINT32_C(v) ((unsigned short) (v))
# ifndef PRINTF_INT32_MODIFIER
# define PRINTF_INT32_MODIFIER ""
# endif
#else
#error "Platform not supported"
#endif
#endif
#ifndef INT32_MAX
# define INT32_MAX (0x7fffffffL)
#endif
#ifndef INT32_MIN
# define INT32_MIN INT32_C(0x80000000)
#endif
#if !defined(int32_t) && !defined(_INT32_T) && !defined(vxWorks)
#if (LONG_MAX == INT32_MAX) || defined (S_SPLINT_S)
typedef signed long int32_t;
# define INT32_C(v) v ## L
# ifndef PRINTF_INT32_MODIFIER
# define PRINTF_INT32_MODIFIER "l"
# endif
#elif (INT_MAX == INT32_MAX)
typedef signed int int32_t;
# define INT32_C(v) v
# ifndef PRINTF_INT32_MODIFIER
# define PRINTF_INT32_MODIFIER ""
# endif
#elif (SHRT_MAX == INT32_MAX)
typedef signed short int32_t;
# define INT32_C(v) ((short) (v))
# ifndef PRINTF_INT32_MODIFIER
# define PRINTF_INT32_MODIFIER ""
# endif
#else
#error "Platform not supported"
#endif
#endif
/*
* The macro stdint_int64_defined is temporarily used to record
* whether or not 64 integer support is available. It must be
* defined for any 64 integer extensions for new platforms that are
* added.
*/
#undef stdint_int64_defined
#if (defined(__STDC__) && defined(__STDC_VERSION__)) || defined (S_SPLINT_S)
# if (__STDC__ && __STDC_VERSION__ >= 199901L) || defined (S_SPLINT_S)
# define stdint_int64_defined
typedef long long int64_t;
typedef unsigned long long uint64_t;
# define UINT64_C(v) v ## ULL
# define INT64_C(v) v ## LL
# ifndef PRINTF_INT64_MODIFIER
# define PRINTF_INT64_MODIFIER "ll"
# endif
# endif
#endif
#if !defined (stdint_int64_defined)
# if defined(__GNUC__) && !defined(vxWorks)
# define stdint_int64_defined
__extension__ typedef long long int64_t;
__extension__ typedef unsigned long long uint64_t;
# define UINT64_C(v) v ## ULL
# define INT64_C(v) v ## LL
# ifndef PRINTF_INT64_MODIFIER
# define PRINTF_INT64_MODIFIER "ll"
# endif
# elif defined(__MWERKS__) || defined (__SUNPRO_C) || defined (__SUNPRO_CC) || defined (__APPLE_CC__) || defined (_LONG_LONG) || defined (_CRAYC) || defined (S_SPLINT_S)
# define stdint_int64_defined
typedef long long int64_t;
typedef unsigned long long uint64_t;
# define UINT64_C(v) v ## ULL
# define INT64_C(v) v ## LL
# ifndef PRINTF_INT64_MODIFIER
# define PRINTF_INT64_MODIFIER "ll"
# endif
# elif (defined(__WATCOMC__) && defined(__WATCOM_INT64__)) || (defined(_MSC_VER) && _INTEGRAL_MAX_BITS >= 64) || (defined (__BORLANDC__) && __BORLANDC__ > 0x460) || defined (__alpha) || defined (__DECC)
# define stdint_int64_defined
typedef __int64 int64_t;
typedef unsigned __int64 uint64_t;
# define UINT64_C(v) v ## UI64
# define INT64_C(v) v ## I64
# ifndef PRINTF_INT64_MODIFIER
# define PRINTF_INT64_MODIFIER "I64"
# endif
# endif
#endif
#if !defined (LONG_LONG_MAX) && defined (INT64_C)
# define LONG_LONG_MAX INT64_C (9223372036854775807)
#endif
#ifndef ULONG_LONG_MAX
# define ULONG_LONG_MAX UINT64_C (18446744073709551615)
#endif
#if !defined (INT64_MAX) && defined (INT64_C)
# define INT64_MAX INT64_C (9223372036854775807)
#endif
#if !defined (INT64_MIN) && defined (INT64_C)
# define INT64_MIN INT64_C (-9223372036854775808)
#endif
#if !defined (UINT64_MAX) && defined (INT64_C)
# define UINT64_MAX UINT64_C (18446744073709551615)
#endif
/*
* Width of hexadecimal for number field.
*/
#ifndef PRINTF_INT64_HEX_WIDTH
# define PRINTF_INT64_HEX_WIDTH "16"
#endif
#ifndef PRINTF_INT32_HEX_WIDTH
# define PRINTF_INT32_HEX_WIDTH "8"
#endif
#ifndef PRINTF_INT16_HEX_WIDTH
# define PRINTF_INT16_HEX_WIDTH "4"
#endif
#ifndef PRINTF_INT8_HEX_WIDTH
# define PRINTF_INT8_HEX_WIDTH "2"
#endif
#ifndef PRINTF_INT64_DEC_WIDTH
# define PRINTF_INT64_DEC_WIDTH "19"
#endif
#ifndef PRINTF_INT32_DEC_WIDTH
# define PRINTF_INT32_DEC_WIDTH "10"
#endif
#ifndef PRINTF_INT16_DEC_WIDTH
# define PRINTF_INT16_DEC_WIDTH "5"
#endif
#ifndef PRINTF_INT8_DEC_WIDTH
# define PRINTF_INT8_DEC_WIDTH "3"
#endif
#ifndef PRINTF_UINT64_DEC_WIDTH
# define PRINTF_UINT64_DEC_WIDTH "20"
#endif
#ifndef PRINTF_UINT32_DEC_WIDTH
# define PRINTF_UINT32_DEC_WIDTH "10"
#endif
#ifndef PRINTF_UINT16_DEC_WIDTH
# define PRINTF_UINT16_DEC_WIDTH "5"
#endif
#ifndef PRINTF_UINT8_DEC_WIDTH
# define PRINTF_UINT8_DEC_WIDTH "3"
#endif
/*
* Ok, lets not worry about 128 bit integers for now. Moore's law says
* we don't need to worry about that until about 2040 at which point
* we'll have bigger things to worry about.
*/
#ifdef stdint_int64_defined
typedef int64_t intmax_t;
typedef uint64_t uintmax_t;
# define INTMAX_MAX INT64_MAX
# define INTMAX_MIN INT64_MIN
# define UINTMAX_MAX UINT64_MAX
# define UINTMAX_C(v) UINT64_C(v)
# define INTMAX_C(v) INT64_C(v)
# ifndef PRINTF_INTMAX_MODIFIER
# define PRINTF_INTMAX_MODIFIER PRINTF_INT64_MODIFIER
# endif
# ifndef PRINTF_INTMAX_HEX_WIDTH
# define PRINTF_INTMAX_HEX_WIDTH PRINTF_INT64_HEX_WIDTH
# endif
# ifndef PRINTF_INTMAX_DEC_WIDTH
# define PRINTF_INTMAX_DEC_WIDTH PRINTF_INT64_DEC_WIDTH
# endif
#else
typedef int32_t intmax_t;
typedef uint32_t uintmax_t;
# define INTMAX_MAX INT32_MAX
# define UINTMAX_MAX UINT32_MAX
# define UINTMAX_C(v) UINT32_C(v)
# define INTMAX_C(v) INT32_C(v)
# ifndef PRINTF_INTMAX_MODIFIER
# define PRINTF_INTMAX_MODIFIER PRINTF_INT32_MODIFIER
# endif
# ifndef PRINTF_INTMAX_HEX_WIDTH
# define PRINTF_INTMAX_HEX_WIDTH PRINTF_INT32_HEX_WIDTH
# endif
# ifndef PRINTF_INTMAX_DEC_WIDTH
# define PRINTF_INTMAX_DEC_WIDTH PRINTF_INT32_DEC_WIDTH
# endif
#endif
/*
* Because this file currently only supports platforms which have
* precise powers of 2 as bit sizes for the default integers, the
* least definitions are all trivial. Its possible that a future
* version of this file could have different definitions.
*/
#ifndef stdint_least_defined
typedef int8_t int_least8_t;
typedef uint8_t uint_least8_t;
typedef int16_t int_least16_t;
typedef uint16_t uint_least16_t;
typedef int32_t int_least32_t;
typedef uint32_t uint_least32_t;
# define PRINTF_LEAST32_MODIFIER PRINTF_INT32_MODIFIER
# define PRINTF_LEAST16_MODIFIER PRINTF_INT16_MODIFIER
# define UINT_LEAST8_MAX UINT8_MAX
# define INT_LEAST8_MAX INT8_MAX
# define UINT_LEAST16_MAX UINT16_MAX
# define INT_LEAST16_MAX INT16_MAX
# define UINT_LEAST32_MAX UINT32_MAX
# define INT_LEAST32_MAX INT32_MAX
# define INT_LEAST8_MIN INT8_MIN
# define INT_LEAST16_MIN INT16_MIN
# define INT_LEAST32_MIN INT32_MIN
# ifdef stdint_int64_defined
typedef int64_t int_least64_t;
typedef uint64_t uint_least64_t;
# define PRINTF_LEAST64_MODIFIER PRINTF_INT64_MODIFIER
# define UINT_LEAST64_MAX UINT64_MAX
# define INT_LEAST64_MAX INT64_MAX
# define INT_LEAST64_MIN INT64_MIN
# endif
#endif
#undef stdint_least_defined
/*
* The ANSI C committee has defined *int*_fast*_t types as well. This,
* of course, defies rationality -- you can't know what will be fast
* just from the type itself. Even for a given architecture, compatible
* implementations might have different performance characteristics.
* Developers are warned to stay away from these types when using this
* or any other stdint.h.
*/
typedef int_least8_t int_fast8_t;
typedef uint_least8_t uint_fast8_t;
typedef int_least16_t int_fast16_t;
typedef uint_least16_t uint_fast16_t;
typedef int_least32_t int_fast32_t;
typedef uint_least32_t uint_fast32_t;
#define UINT_FAST8_MAX UINT_LEAST8_MAX
#define INT_FAST8_MAX INT_LEAST8_MAX
#define UINT_FAST16_MAX UINT_LEAST16_MAX
#define INT_FAST16_MAX INT_LEAST16_MAX
#define UINT_FAST32_MAX UINT_LEAST32_MAX
#define INT_FAST32_MAX INT_LEAST32_MAX
#define INT_FAST8_MIN INT_LEAST8_MIN
#define INT_FAST16_MIN INT_LEAST16_MIN
#define INT_FAST32_MIN INT_LEAST32_MIN
#ifdef stdint_int64_defined
typedef int_least64_t int_fast64_t;
typedef uint_least64_t uint_fast64_t;
# define UINT_FAST64_MAX UINT_LEAST64_MAX
# define INT_FAST64_MAX INT_LEAST64_MAX
# define INT_FAST64_MIN INT_LEAST64_MIN
#endif
#undef stdint_int64_defined
/*
* Whatever piecemeal, per compiler thing we can do about the wchar_t
* type limits.
*/
#if defined(__WATCOMC__) || defined(_MSC_VER) || defined (__GNUC__) && !defined(vxWorks)
# include <wchar.h>
# ifndef WCHAR_MIN
# define WCHAR_MIN 0
# endif
# ifndef WCHAR_MAX
# define WCHAR_MAX ((wchar_t)-1)
# endif
#endif
/*
* Whatever piecemeal, per compiler/platform thing we can do about the
* (u)intptr_t types and limits.
*/
#if (defined (_MSC_VER) && defined (_UINTPTR_T_DEFINED)) || defined (_UINTPTR_T)
# define STDINT_H_UINTPTR_T_DEFINED
#endif
#ifndef STDINT_H_UINTPTR_T_DEFINED
# if defined (__alpha__) || defined (__ia64__) || defined (__x86_64__) || defined (_WIN64) || defined (__ppc64__)
# define stdint_intptr_bits 64
# elif defined (__WATCOMC__) || defined (__TURBOC__)
# if defined(__TINY__) || defined(__SMALL__) || defined(__MEDIUM__)
# define stdint_intptr_bits 16
# else
# define stdint_intptr_bits 32
# endif
# elif defined (__i386__) || defined (_WIN32) || defined (WIN32) || defined (__ppc64__)
# define stdint_intptr_bits 32
# elif defined (__INTEL_COMPILER)
/* TODO -- what did Intel do about x86-64? */
# else
/* #error "This platform might not be supported yet" */
# endif
# ifdef stdint_intptr_bits
# define stdint_intptr_glue3_i(a,b,c) a##b##c
# define stdint_intptr_glue3(a,b,c) stdint_intptr_glue3_i(a,b,c)
# ifndef PRINTF_INTPTR_MODIFIER
# define PRINTF_INTPTR_MODIFIER stdint_intptr_glue3(PRINTF_INT,stdint_intptr_bits,_MODIFIER)
# endif
# ifndef PTRDIFF_MAX
# define PTRDIFF_MAX stdint_intptr_glue3(INT,stdint_intptr_bits,_MAX)
# endif
# ifndef PTRDIFF_MIN
# define PTRDIFF_MIN stdint_intptr_glue3(INT,stdint_intptr_bits,_MIN)
# endif
# ifndef UINTPTR_MAX
# define UINTPTR_MAX stdint_intptr_glue3(UINT,stdint_intptr_bits,_MAX)
# endif
# ifndef INTPTR_MAX
# define INTPTR_MAX stdint_intptr_glue3(INT,stdint_intptr_bits,_MAX)
# endif
# ifndef INTPTR_MIN
# define INTPTR_MIN stdint_intptr_glue3(INT,stdint_intptr_bits,_MIN)
# endif
# ifndef INTPTR_C
# define INTPTR_C(x) stdint_intptr_glue3(INT,stdint_intptr_bits,_C)(x)
# endif
# ifndef UINTPTR_C
# define UINTPTR_C(x) stdint_intptr_glue3(UINT,stdint_intptr_bits,_C)(x)
# endif
typedef stdint_intptr_glue3(uint,stdint_intptr_bits,_t) uintptr_t;
typedef stdint_intptr_glue3( int,stdint_intptr_bits,_t) intptr_t;
# else
/* TODO -- This following is likely wrong for some platforms, and does
nothing for the definition of uintptr_t. */
typedef ptrdiff_t intptr_t;
# endif
# define STDINT_H_UINTPTR_T_DEFINED
#endif
/*
* Assumes sig_atomic_t is signed and we have a 2s complement machine.
*/
#ifndef SIG_ATOMIC_MAX
# define SIG_ATOMIC_MAX ((((sig_atomic_t) 1) << (sizeof (sig_atomic_t)*CHAR_BIT-1)) - 1)
#endif
#endif
#if defined (__TEST_PSTDINT_FOR_CORRECTNESS)
/*
* Please compile with the maximum warning settings to make sure macros are
* not defined more than once.
*/
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#define glue3_aux(x,y,z) x ## y ## z
#define glue3(x,y,z) glue3_aux(x,y,z)
#define DECLU(bits) glue3(uint,bits,_t) glue3(u,bits,) = glue3(UINT,bits,_C) (0);
#define DECLI(bits) glue3(int,bits,_t) glue3(i,bits,) = glue3(INT,bits,_C) (0);
#define DECL(us,bits) glue3(DECL,us,) (bits)
#define TESTUMAX(bits) glue3(u,bits,) = ~glue3(u,bits,); if (glue3(UINT,bits,_MAX) != glue3(u,bits,)) printf ("Something wrong with UINT%d_MAX\n", bits)
#define REPORTERROR(msg) { err_n++; if (err_first <= 0) err_first = __LINE__; printf msg; }
#define X_SIZE_MAX ((size_t)-1)
int main () {
int err_n = 0;
int err_first = 0;
DECL(I,8)
DECL(U,8)
DECL(I,16)
DECL(U,16)
DECL(I,32)
DECL(U,32)
#ifdef INT64_MAX
DECL(I,64)
DECL(U,64)
#endif
intmax_t imax = INTMAX_C(0);
uintmax_t umax = UINTMAX_C(0);
char str0[256], str1[256];
sprintf (str0, "%" PRINTF_INT32_MODIFIER "d", INT32_C(2147483647));
if (0 != strcmp (str0, "2147483647")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str0));
if (atoi(PRINTF_INT32_DEC_WIDTH) != (int) strlen(str0)) REPORTERROR (("Something wrong with PRINTF_INT32_DEC_WIDTH : %s\n", PRINTF_INT32_DEC_WIDTH));
sprintf (str0, "%" PRINTF_INT32_MODIFIER "u", UINT32_C(4294967295));
if (0 != strcmp (str0, "4294967295")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str0));
if (atoi(PRINTF_UINT32_DEC_WIDTH) != (int) strlen(str0)) REPORTERROR (("Something wrong with PRINTF_UINT32_DEC_WIDTH : %s\n", PRINTF_UINT32_DEC_WIDTH));
#ifdef INT64_MAX
sprintf (str1, "%" PRINTF_INT64_MODIFIER "d", INT64_C(9223372036854775807));
if (0 != strcmp (str1, "9223372036854775807")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str1));
if (atoi(PRINTF_INT64_DEC_WIDTH) != (int) strlen(str1)) REPORTERROR (("Something wrong with PRINTF_INT64_DEC_WIDTH : %s, %d\n", PRINTF_INT64_DEC_WIDTH, (int) strlen(str1)));
sprintf (str1, "%" PRINTF_INT64_MODIFIER "u", UINT64_C(18446744073709550591));
if (0 != strcmp (str1, "18446744073709550591")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str1));
if (atoi(PRINTF_UINT64_DEC_WIDTH) != (int) strlen(str1)) REPORTERROR (("Something wrong with PRINTF_UINT64_DEC_WIDTH : %s, %d\n", PRINTF_UINT64_DEC_WIDTH, (int) strlen(str1)));
#endif
sprintf (str0, "%d %x\n", 0, ~0);
sprintf (str1, "%d %x\n", i8, ~0);
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i8 : %s\n", str1));
sprintf (str1, "%u %x\n", u8, ~0);
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u8 : %s\n", str1));
sprintf (str1, "%d %x\n", i16, ~0);
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i16 : %s\n", str1));
sprintf (str1, "%u %x\n", u16, ~0);
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u16 : %s\n", str1));
sprintf (str1, "%" PRINTF_INT32_MODIFIER "d %x\n", i32, ~0);
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i32 : %s\n", str1));
sprintf (str1, "%" PRINTF_INT32_MODIFIER "u %x\n", u32, ~0);
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u32 : %s\n", str1));
#ifdef INT64_MAX
sprintf (str1, "%" PRINTF_INT64_MODIFIER "d %x\n", i64, ~0);
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i64 : %s\n", str1));
#endif
sprintf (str1, "%" PRINTF_INTMAX_MODIFIER "d %x\n", imax, ~0);
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with imax : %s\n", str1));
sprintf (str1, "%" PRINTF_INTMAX_MODIFIER "u %x\n", umax, ~0);
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with umax : %s\n", str1));
TESTUMAX(8);
TESTUMAX(16);
TESTUMAX(32);
#ifdef INT64_MAX
TESTUMAX(64);
#endif
#define STR(v) #v
#define Q(v) printf ("sizeof " STR(v) " = %u\n", (unsigned) sizeof (v));
if (err_n) {
printf ("pstdint.h is not correct. Please use sizes below to correct it:\n");
}
Q(int)
Q(unsigned)
Q(long int)
Q(short int)
Q(int8_t)
Q(int16_t)
Q(int32_t)
#ifdef INT64_MAX
Q(int64_t)
#endif
#if UINT_MAX < X_SIZE_MAX
printf ("UINT_MAX < X_SIZE_MAX\n");
#else
printf ("UINT_MAX >= X_SIZE_MAX\n");
#endif
printf ("%" PRINTF_INT64_MODIFIER "u vs %" PRINTF_INT64_MODIFIER "u\n", UINT_MAX, X_SIZE_MAX);
return EXIT_SUCCESS;
}
#endif
+39
View File
@@ -0,0 +1,39 @@
/*
* stdlib.h --
*
* Declares facilities exported by the "stdlib" portion of the C library.
* This file isn't complete in the ANSI-C sense; it only declares things
* that are needed by Tcl. This file is needed even on many systems with
* their own stdlib.h (e.g. SunOS) because not all stdlib.h files declare
* all the procedures needed here (such as strtol/strtoul).
*
* Copyright (c) 1991 The Regents of the University of California.
* Copyright (c) 1994-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#ifndef _STDLIB
#define _STDLIB
extern void abort(void);
extern double atof(const char *string);
extern int atoi(const char *string);
extern long atol(const char *string);
extern void * calloc(unsigned long numElements, unsigned long size);
extern void exit(int status);
extern void free(void *blockPtr);
extern char * getenv(const char *name);
extern void * malloc(unsigned long numBytes);
extern void qsort(void *base, unsigned long n, unsigned long size, int (*compar)(
const void *element1, const void *element2));
extern void * realloc(void *ptr, unsigned long numBytes);
extern char * realpath(const char *path, char *resolved_path);
extern int mkstemps(char *templ, int suffixlen);
extern int mkstemp(char *templ);
extern char * mkdtemp(char *templ);
extern long strtol(const char *string, char **endPtr, int base);
extern unsigned long strtoul(const char *string, char **endPtr, int base);
#endif /* _STDLIB */
+70
View File
@@ -0,0 +1,70 @@
/*
* strstr.c --
*
* Source code for the "strstr" library routine.
*
* Copyright (c) 1988-1993 The Regents of the University of California.
* Copyright (c) 1994 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tcl.h"
#ifndef NULL
#define NULL 0
#endif
/*
*----------------------------------------------------------------------
*
* strstr --
*
* Locate the first instance of a substring in a string.
*
* Results:
* If string contains substring, the return value is the location of the
* first matching instance of substring in string. If string doesn't
* contain substring, the return value is 0. Matching is done on an exact
* character-for-character basis with no wildcards or special characters.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
char *
strstr(
const char *string, /* String to search. */
const char *substring) /* Substring to try to find in string. */
{
const char *a, *b;
/*
* First scan quickly through the two strings looking for a
* single-character match. When it's found, then compare the rest of the
* substring.
*/
b = substring;
if (*b == 0) {
return (char *)string;
}
for ( ; *string != 0; string += 1) {
if (*string != *b) {
continue;
}
a = string;
while (1) {
if (*b == 0) {
return (char *)string;
}
if (*a++ != *b++) {
break;
}
}
b = substring;
}
return NULL;
}
+77
View File
@@ -0,0 +1,77 @@
/*
* strtol.c --
*
* Source code for the "strtol" library procedure.
*
* Copyright (c) 1988 The Regents of the University of California.
* Copyright (c) 1994 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
/*
*----------------------------------------------------------------------
*
* strtol --
*
* Convert an ASCII string into an integer.
*
* Results:
* The return value is the integer equivalent of string. If endPtr is
* non-NULL, then *endPtr is filled in with the character after the last
* one that was part of the integer. If string doesn't contain a valid
* integer value, then zero is returned and *endPtr is set to string.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
long int
strtol(
const char *string, /* String of ASCII digits, possibly preceded
* by white space. For bases greater than 10,
* either lower- or upper-case digits may be
* used. */
char **endPtr, /* Where to store address of terminating
* character, or NULL. */
int base) /* Base for conversion. Must be less than 37.
* If 0, then the base is chosen from the
* leading characters of string: "0x" means
* hex, "0" means octal, anything else means
* decimal. */
{
const char *p;
long result;
/*
* Skip any leading blanks.
*/
p = string;
while (isspace(UCHAR(*p))) {
p += 1;
}
/*
* Check for a sign.
*/
if (*p == '-') {
p += 1;
result = -(strtoul(p, endPtr, base));
} else {
if (*p == '+') {
p += 1;
}
result = strtoul(p, endPtr, base);
}
if ((result == 0) && (endPtr != 0) && (*endPtr == p)) {
*endPtr = (char *) string;
}
return result;
}
+214
View File
@@ -0,0 +1,214 @@
/*
* strtoul.c --
*
* Source code for the "strtoul" library procedure.
*
* Copyright (c) 1988 The Regents of the University of California.
* Copyright (c) 1994 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
/*
* The table below is used to convert from ASCII digits to a numerical
* equivalent. It maps from '0' through 'z' to integers (100 for non-digit
* characters).
*/
static const char cvtIn[] = {
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, /* '0' - '9' */
100, 100, 100, 100, 100, 100, 100, /* punctuation */
10, 11, 12, 13, 14, 15, 16, 17, 18, 19, /* 'A' - 'Z' */
20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
30, 31, 32, 33, 34, 35,
100, 100, 100, 100, 100, 100, /* punctuation */
10, 11, 12, 13, 14, 15, 16, 17, 18, 19, /* 'a' - 'z' */
20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
30, 31, 32, 33, 34, 35};
/*
*----------------------------------------------------------------------
*
* strtoul --
*
* Convert an ASCII string into an integer.
*
* Results:
* The return value is the integer equivalent of string. If endPtr is
* non-NULL, then *endPtr is filled in with the character after the last
* one that was part of the integer. If string doesn't contain a valid
* integer value, then zero is returned and *endPtr is set to string.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
unsigned long int
strtoul(
const char *string, /* String of ASCII digits, possibly preceded
* by white space. For bases greater than 10,
* either lower- or upper-case digits may be
* used. */
char **endPtr, /* Where to store address of terminating
* character, or NULL. */
int base) /* Base for conversion. Must be less than 37.
* If 0, then the base is chosen from the
* leading characters of string: "0x" means
* hex, "0" means octal, anything else means
* decimal. */
{
const char *p;
unsigned long int result = 0;
unsigned digit;
int anyDigits = 0;
int negative=0;
int overflow=0;
/*
* Skip any leading blanks.
*/
p = string;
while (isspace(UCHAR(*p))) {
p += 1;
}
if (*p == '-') {
negative = 1;
p += 1;
} else {
if (*p == '+') {
p += 1;
}
}
/*
* If no base was provided, pick one from the leading characters of the
* string.
*/
if (base == 0) {
if (*p == '0') {
p += 1;
if ((*p == 'x') || (*p == 'X')) {
p += 1;
base = 16;
} else {
/*
* Must set anyDigits here, otherwise "0" produces a "no
* digits" error.
*/
anyDigits = 1;
base = 8;
}
} else {
base = 10;
}
} else if (base == 16) {
/*
* Skip a leading "0x" from hex numbers.
*/
if ((p[0] == '0') && ((p[1] == 'x') || (p[1] == 'X'))) {
p += 2;
}
}
/*
* Sorry this code is so messy, but speed seems important. Do different
* things for base 8, 10, 16, and other.
*/
if (base == 8) {
unsigned long maxres = ULONG_MAX >> 3;
for ( ; ; p += 1) {
digit = *p - '0';
if (digit > 7) {
break;
}
if (result > maxres) { overflow = 1; }
result = (result << 3);
if (digit > (ULONG_MAX - result)) { overflow = 1; }
result += digit;
anyDigits = 1;
}
} else if (base == 10) {
unsigned long maxres = ULONG_MAX / 10;
for ( ; ; p += 1) {
digit = *p - '0';
if (digit > 9) {
break;
}
if (result > maxres) { overflow = 1; }
result *= 10;
if (digit > (ULONG_MAX - result)) { overflow = 1; }
result += digit;
anyDigits = 1;
}
} else if (base == 16) {
unsigned long maxres = ULONG_MAX >> 4;
for ( ; ; p += 1) {
digit = *p - '0';
if (digit > ('z' - '0')) {
break;
}
digit = cvtIn[digit];
if (digit > 15) {
break;
}
if (result > maxres) { overflow = 1; }
result = (result << 4);
if (digit > (ULONG_MAX - result)) { overflow = 1; }
result += digit;
anyDigits = 1;
}
} else if (base >= 2 && base <= 36) {
unsigned long maxres = ULONG_MAX / base;
for ( ; ; p += 1) {
digit = *p - '0';
if (digit > ('z' - '0')) {
break;
}
digit = cvtIn[digit];
if (digit >= ( (unsigned) base )) {
break;
}
if (result > maxres) { overflow = 1; }
result *= base;
if (digit > (ULONG_MAX - result)) { overflow = 1; }
result += digit;
anyDigits = 1;
}
}
/*
* See if there were any digits at all.
*/
if (!anyDigits) {
p = string;
}
if (endPtr != 0) {
/* unsafe, but required by the strtoul prototype */
*endPtr = (char *) p;
}
if (overflow) {
errno = ERANGE;
return ULONG_MAX;
}
if (negative) {
return -result;
}
return result;
}
View File
+1 -1
View File
@@ -32,7 +32,7 @@ void
\fBTcl_GetMemoryInfo\fR(\fIdsPtr\fR)
.SH ARGUMENTS
.AS char *size
.AP "size_t" size in
.AP "unsigned int" size in
Size in bytes of the memory block to allocate.
.AP char *ptr in
Pointer to memory block to free or realloc.
+1 -1
View File
@@ -9,7 +9,7 @@
.so man.macros
.BS
.SH NAME
Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult, Tcl_DStringToObj \- manipulate dynamic strings
Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
+14 -13
View File
@@ -218,16 +218,17 @@ used. The return value is a pointer to the value stored in the DString.
be used to specify the profile to be used for the transform. The
\fBTCL_ENCODING_START\fR and \fBTCL_ENCODING_END\fR bits in \fBflags\fR are
ignored as the function assumes the entire source string to be decoded is passed
into the function. On success, the function returns \fBTCL_OK\fR with the
converted string stored in \fB*dstPtr\fR. For errors \fIother than conversion
errors\fR, such as invalid flags, the function returns \fBTCL_ERROR\fR with an error
into the function. On success, the function returns \fBTCL_ERROR\fR with the
converted string stored in \fB*dstPtr\fR. For errors other than conversion
errors, such as invalid flags, the function returns \fBTCL_OK\fR with an error
message in \fBinterp\fR if it is not NULL.
.PP
For conversion errors, \fBTcl_ExternalToUtfDStringEx\fR returns one
of the \fBTCL_CONVERT_*\fR errors listed below for \fBTcl_ExternalToUtf\fR.
When one of these conversion errors is returned, an error message is
stored in \fBinterp\fR only if \fBerrorIdxPtr\fR is NULL. Otherwise, no error message
is stored as the function expects the caller is interested the decoded data
up to that point and not treating this as an immediate error condition.
is stored as the function expects the caller is interested whatever is
decoded to that point and not treating this as an immediate error condition.
The index of the error location is stored in \fB*errorIdxPtr\fR.
.PP
The caller must call \fBTcl_DStringFree\fR to free up the \fB*dstPtr\fR resources
@@ -546,13 +547,13 @@ encoding:
E
init {}
final {}
iso8859-1 \ex1B(B
jis0201 \ex1B(J
jis0208 \ex1B$@
jis0208 \ex1B$B
jis0212 \ex1B$(D
gb2312 \ex1B$A
ksc5601 \ex1B$(C
iso8859-1 \ex1b(B
jis0201 \ex1b(J
jis0208 \ex1b$@
jis0208 \ex1b$B
jis0212 \ex1b$(D
gb2312 \ex1b$A
ksc5601 \ex1b$(C
.CE
.PP
In the file, the first column represents an option and the second column
@@ -564,7 +565,7 @@ marks that encoding. Tcl syntax is used for the values; in the above
example, for instance,
.QW \fB{}\fR
represents the empty string and
.QW \fB\ex1B\fR
.QW \fB\ex1b\fR
represents character 27.
.PP
When \fBTcl_GetEncoding\fR encounters an encoding \fIname\fR that has not
+25 -46
View File
@@ -23,8 +23,6 @@ Tcl_Obj *
.sp
\fBTcl_DecrRefCount\fR(\fIobjPtr\fR)
.sp
\fBTcl_BounceRefCount\fR(\fIobjPtr\fR)
.sp
int
\fBTcl_IsShared\fR(\fIobjPtr\fR)
.sp
@@ -280,27 +278,26 @@ The string representation is now \fB124\fR
and both representations are again valid.
.SH "STORAGE MANAGEMENT OF VALUES"
.PP
Tcl values are allocated on the heap and are shared as much as
possible to reduce storage requirements. Reference counting is used
to determine when a value is no longer needed and can safely be freed.
A value just created by \fBTcl_NewObj\fR, \fBTcl_NewStringObj\fR, or
any Abstract List command or function, has \fIrefCount\fR 0, meaning
that the object can often be given to a function like
\fBTcl_SetObjResult\fR, \fBTcl_ListObjAppendElement\fR, or
\fBTcl_DictObjPut\fR (as a value) without explicit reference
management, all of which are common use cases. (The latter two require
that the target list or dictionary be well-formed, but that is
often easy to arrange when the value is being initially constructed.)
The macro \fBTcl_IncrRefCount\fR increments the reference count when a
new reference to the value is created.
The macro \fBTcl_DecrRefCount\fR decrements the count when a reference is no longer needed.
If the value's reference count drops to zero, frees
its storage.
The macro \fBTcl_BounceRefCount\fR will check if the value has no references (i.e. in a "new" state) and free the value.
Tcl values are allocated on the heap and are shared as much as possible
to reduce storage requirements.
Reference counting is used to determine when a value is
no longer needed and can safely be freed.
A value just created by \fBTcl_NewObj\fR or \fBTcl_NewStringObj\fR
has \fIrefCount\fR 0, meaning that the object can often be given to a function
like \fBTcl_SetObjResult\fR, \fBTcl_ListObjAppendElement\fR, or
\fBTcl_DictObjPut\fR (as a value) without explicit reference management, all
of which are common use cases. (The latter two require that the the target
list or dictionary be well-formed, but that is often easy to arrange when the
value is being initially constructed.)
The macro \fBTcl_IncrRefCount\fR increments the reference count
when a new reference to the value is created.
The macro \fBTcl_DecrRefCount\fR decrements the count
when a reference is no longer needed and,
if the value's reference count drops to zero, frees its storage.
A value shared by different code or data structures has
\fIrefCount\fR greater than 1. Incrementing a value's reference count
ensures that it will not be freed too early or have its value change
accidentally.
\fIrefCount\fR greater than 1.
Incrementing a value's reference count ensures that
it will not be freed too early or have its value change accidentally.
.PP
As an example, the bytecode interpreter shares argument values
between calling and called Tcl procedures to avoid having to copy values.
@@ -314,25 +311,12 @@ the interpreter calls \fBTcl_DecrRefCount\fR to decrement
each argument's reference count.
When a value's reference count drops less than or equal to zero,
\fBTcl_DecrRefCount\fR reclaims its storage.
.PP
Most command procedures have not been concerned about reference
counting since they use a value's value immediately and do not retain
a pointer to the value after they return. However, there are some
procedures that may return a new value, with a refCount of 0. In this
situation, it is the caller's responsibility to free the value before
the procedure returns. One way to cover this is to always call
\fBTcl_IncrRefCount\fR before using the value, then call
\fBTcl_DecrRefCount\fR before returning. The other way is to use
\fBTcl_BounceRefCount\fR after the value is no longer needed or
referenced. This macro will free the value if there are no other
references to the value. When retaining a pointer to a value in a data
structure the procedure must be careful to increment its reference
count since the retained pointer is a new reference. Examples of
procedures that return new values are \fBTcl_NewIntObj\fR, and
commands like \fBlseq\fR, which creates an Abstract List, and an
lindex on this list may return a new Obj with a refCount of 0.
Most command procedures do not have to be concerned about
reference counting since they use a value's value immediately
and do not retain a pointer to the value after they return.
However, if they do retain a pointer to a value in a data structure,
they must be careful to increment its reference count
since the retained pointer is a new reference.
.PP
Command procedures that directly modify values
such as those for \fBlappend\fR and \fBlinsert\fR must be careful to
@@ -366,11 +350,6 @@ must check whether the variable's value is shared before
incrementing the integer in its internal representation.
If it is shared, it needs to duplicate the value
in order to avoid accidentally changing values in other data structures.
.PP
In cases where a value is obtained, used, and not retained, the value
can be freed using \fBTcl_BounceRefCount\fR. This
is functionally equivalent to calling \fBTcl_IncrRefCount\fR followed
\fBTcl_DecrRefCount\fR.
.SH "SEE ALSO"
Tcl_ConvertToType(3), Tcl_GetIntFromObj(3), Tcl_ListObjAppendElement(3), Tcl_ListObjIndex(3), Tcl_ListObjReplace(3), Tcl_RegisterObjType(3)
.SH KEYWORDS
+12 -164
View File
@@ -4,7 +4,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_ObjType 3 9.0 Tcl "Tcl Library Procedures"
.TH Tcl_ObjType 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
@@ -93,13 +93,14 @@ free to set the internal representation for \fIobjPtr\fR to make
use of another related Tcl_ObjType, if it sees fit.
.SH "THE TCL_OBJTYPE STRUCTURE"
.PP
Extension writers can define new value types by defining four to eight
procedures and initializing a Tcl_ObjType structure to describe the
type. Extension writers may also pass a pointer to their Tcl_ObjType
structure to \fBTcl_RegisterObjType\fR if they wish to permit other
extensions to look up their Tcl_ObjType by name with the
\fBTcl_GetObjType\fR routine. The \fBTcl_ObjType\fR structure is
defined as follows:
Extension writers can define new value types by defining four
procedures and
initializing a Tcl_ObjType structure to describe the type.
Extension writers may also pass a pointer to their Tcl_ObjType
structure to \fBTcl_RegisterObjType\fR if they wish to permit
other extensions to look up their Tcl_ObjType by name with
the \fBTcl_GetObjType\fR routine.
The \fBTcl_ObjType\fR structure is defined as follows:
.PP
.CS
typedef struct Tcl_ObjType {
@@ -109,16 +110,6 @@ typedef struct Tcl_ObjType {
Tcl_UpdateStringProc *\fIupdateStringProc\fR;
Tcl_SetFromAnyProc *\fIsetFromAnyProc\fR;
size_t \fIversion\fR;
/* List emulation functions - ObjType Version 1 & 2 */
Tcl_ObjTypeLengthProc *lengthProc;
/* List emulation functions - ObjType Version 2 */
Tcl_ObjTypeIndexProc *\fIindexProc\fR;
Tcl_ObjTypeSliceProc *\fIsliceProc\fR;
Tcl_ObjTypeReverseProc *\fIreverseProc\fR;
Tcl_ObjTypeGetElements *\fIgetElementsProc\fR;
Tcl_ObjTypeSetElement *\fIsetElementProc\fR;
Tcl_ObjTypeReplaceProc *\fIreplaceProc\fR;
Tcl_ObjTypeInOperatorProc *\fIinOperProc\fR;
} \fBTcl_ObjType\fR;
.CE
.SS "THE NAME FIELD"
@@ -215,7 +206,6 @@ The \fIdupIntRepProc\fR member contains the address of a function
called to copy an internal representation from one value to another.
.PP
.CS
typedef void \fBTcl_DupInternalRepProc\fR(
Tcl_Obj *\fIsrcPtr\fR,
Tcl_Obj *\fIdupPtr\fR);
@@ -239,7 +229,6 @@ The \fIfreeIntRepProc\fR member contains the address of a function
that is called when a value is freed.
.PP
.CS
typedef void \fBTcl_FreeInternalRepProc\fR(
Tcl_Obj *\fIobjPtr\fR);
.CE
@@ -267,149 +256,8 @@ immediately, in order to limit stack usage. However, the value will be freed
before the outermost current \fBTcl_DecrRefCount\fR returns.
.SS "THE VERSION FIELD"
.PP
The \fIversion\fR member provides for future extensibility of the
structure and should be set to \fBTCL_OBJTYPE_V0\fR for compatability
of ObjType definitions prior to version 9.0. Specifics about versions
will be described further in the sections below.
.SH "ABSTRACT LIST TYPES"
.PP
Additional fields in the Tcl_ObjType descriptor allow for control over
how custom data values can be manipulated using Tcl's List commands
without converting the value to a List type. This requires the custom
type to provide functions that will perform the given operation on the
custom data representation. Not all functions are required. In the
absence of a particular function (set to NULL), the fallback is to
allow the internal List operation to perform the operation, most
likely causing the value type to be converted to a traditional list.
.SS "SCALAR VALUE TYPES"
.PP
For a custom value type that is scalar or atomic in nature, i.e., not
a divisible collection, version \fBTCL_OBJTYPE_V1\fR is
recommended. In this case, List commands will treat the scalar value
as if it where a list of length 1, and not convert the value to a List
type.
.SS "VERSION 2: ABSTRACT LISTS"
.PP
Version 2, \fBTCL_OBJTYPE_V2\fR, allows full List support when the
functions described below are provided. This allows for script level
use of the List commands without causing the type of the Tcl_Obj value
to be converted to a list.
.SS "THE LENGTHPROC FIELD"
.PP
The \fBLengthProc\fR function correlates with the \fBTcl_ListObjLength\fR
C API. The function returns the number of elements in the list. It
is used in every List operation and is required for all Abstract List
implementations.
.CS
typedef Tcl_Size
(Tcl_ObjTypeLengthProc) (Tcl_Obj *listPtr);
.CE
.PP
.SS "THE INDEXPROC FIELD"
.PP
The \fBIndexProc\fR function correlates with with the
\fBTcl_ListObjIndex\fR C API. The function returns a Tcl_Obj value for
the element at the specified index.
.CS
typedef int
(Tcl_ObjTypeIndexProc) (
Tcl_Interp *interp,
Tcl_Obj *listPtr,
Tcl_Size index,
Tcl_Obj** elemObj);
.CE
.SS "THE SLICEPROC FIELD"
.PP
The \fBSliceProc\fR correlates with the \fBlrange\fR command,
returning a new List or Abstract List for the portion of the original
list specifed.
.CS
typedef int
(Tcl_ObjTypeSliceProc) (
Tcl_Interp *interp,
Tcl_Obj *listPtr,
Tcl_Size fromIdx,
Tcl_Size toIdx,
Tcl_Obj **newObjPtr);
.CE
.SS "THE REVERSEPROC FIELD"
.PP
The \fBReverseProc\fR correlates with the \fBlreverse\fR command,
returning a List or Abstract List that has the same elements as the
input Abstract List, with the elements in the reverse order.
.CS
typedef int
(Tcl_ObjTypeReverseProc) (
Tcl_Interp *interp,
Tcl_Obj *listPtr,
Tcl_Obj **newObjPtr);
.CE
.SS "THE GETELEMENTS FIELD"
.PP
The \fBGetElements\fR function returns a count and a pointer to an
array of Tcl_Obj values for the entire Abstract List. This is a
correlary to the \fBTcl_ListObjGetElements\fR C API call.
.CS
typedef int
(Tcl_ObjTypeGetElements) (
Tcl_Interp *interp,
Tcl_Obj *listPtr,
Tcl_Size *objcptr,
Tcl_Obj ***objvptr);
.CE
.SS "THE SETELEMENT FIELD"
.PP
The \fBSetElement\fR function replaces the element within the
specified list at the give index. This function correlates to the
\fBlset\fR command.
.CS
typedef Tcl_Obj*
Tcl_ObjTypeSetElement) (
Tcl_Interp *interp,
Tcl_Obj *listPtr,
Tcl_Size indexCount,
Tcl_Obj *const indexArray[],
Tcl_Obj *valueObj);
.CE
.SS "REPLACEPROC FIELD"
.PP
The \fBReplaceProc\fR returns a new list after modfying the list
replacing the elements to be deleted, and adding the elements to be
inserted. This function correlates to the \fBTcl_ListObjReplace\fR C API.
.CS
typedef int
(Tcl_ObjTypeReplaceProc) (
Tcl_Interp *interp,
Tcl_Obj *listObj,
Tcl_Size first,
Tcl_Size numToDelete,
Tcl_Size numToInsert,
Tcl_Obj *const insertObjs[]);
.CE
.SS "THE INOPERATORPROC FIELD"
.PP
The \fBInOperProc\fR function determines whether the value is present in the
given list, according to equivalent string comparison of elements. The
\fBboolResult\fR is set to 1 (true) if the value is present, and 0
(false) if it is not present. This function implements the "in" and
"ni" math operators for an abstract list.
.CS
typedef int
(Tcl_ObjTypeInOperatorProc) (
Tcl_Interp *interp,
Tcl_Obj *valueObj,
Tcl_Obj *listObj,
int *boolResult);
.CE
The \fIversion\fR member provides for future extensibility of the structure
and should be set to \fITCL_OBJTYPE_V0\fR.
.SH "REFERENCE COUNT MANAGEMENT"
.PP
The \fIobjPtr\fR argument to \fBTcl_AppendAllObjTypes\fR should be an unshared
@@ -428,6 +276,6 @@ modify the reference count of their arguments, but if the values contain
subsidiary values (e.g., the elements of a list or the keys of a dictionary)
then those subsidiary values may have their reference counts modified.
.SH "SEE ALSO"
Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_BounceRefCount(3)
Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3)
.SH KEYWORDS
internal representation, value, value type, string representation, type conversion
+2 -2
View File
@@ -47,10 +47,10 @@ int
int
\fBTcl_Close\fR(\fIinterp, channel\fR)
.sp
Tcl_Size
int
\fBTcl_ReadChars\fR(\fIchannel, readObjPtr, charsToRead, appendFlag\fR)
.sp
Tcl_Size
int
\fBTcl_Read\fR(\fIchannel, readBuf, bytesToRead\fR)
.sp
Tcl_Size
+50 -56
View File
@@ -8,7 +8,7 @@
.so man.macros
.BS
.SH NAME
Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UtfToChar16, Tcl_UtfToWChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_Char16ToUtfDString, Tcl_UtfToWCharDString, Tcl_UtfToChar16DString, Tcl_WCharToUtfDString, Tcl_WCharLen, Tcl_Char16Len, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharNcasecmp, Tcl_UniCharCaseMatch, Tcl_UtfNcmp, Tcl_UtfNcasecmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings
Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UtfToChar16, Tcl_UtfToWChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_Char16ToUtfDString, Tcl_UtfToWCharDString, Tcl_UtfToChar16DString, Tcl_WCharLen, Tcl_Char16Len, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharNcasecmp, Tcl_UniCharCaseMatch, Tcl_UtfNcmp, Tcl_UtfNcasecmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -28,28 +28,28 @@ Tcl_Size
\fBTcl_UtfToWChar\fR(\fIsrc, wPtr\fR)
.sp
char *
\fBTcl_UniCharToUtfDString\fR(\fIuniStr, numUniChars, dsPtr\fR)
\fBTcl_UniCharToUtfDString\fR(\fIuniStr, uniLength, dsPtr\fR)
.sp
char *
\fBTcl_Char16ToUtfDString\fR(\fIutf16, numUtf16, dsPtr\fR)
\fBTcl_Char16ToUtfDString\fR(\fIuStr, uniLength, dsPtr\fR)
.sp
char *
\fBTcl_WCharToUtfDString\fR(\fIwcharStr, numWChars, dsPtr\fR)
\fBTcl_WCharToUtfDString\fR(\fIwStr, uniLength, dsPtr\fR)
.sp
Tcl_UniChar *
\fBTcl_UtfToUniCharDString\fR(\fIsrc, numBytes, dsPtr\fR)
\fBTcl_UtfToUniCharDString\fR(\fIsrc, length, dsPtr\fR)
.sp
unsigned short *
\fBTcl_UtfToChar16DString\fR(\fIsrc, numBytes, dsPtr\fR)
\fBTcl_UtfToChar16DString\fR(\fIsrc, length, dsPtr\fR)
.sp
wchar_t *
\fBTcl_UtfToWCharDString\fR(\fIsrc, numBytes, dsPtr\fR)
\fBTcl_UtfToWCharDString\fR(\fIsrc, length, dsPtr\fR)
.sp
int
\fBTcl_Char16Len\fR(\fIutf16\fR)
\fBTcl_Char16Len\fR(\fIuniStr\fR)
.sp
int
\fBTcl_WCharLen\fR(\fIwcharStr\fR)
\fBTcl_WCharLen\fR(\fIuniStr\fR)
.sp
int
\fBTcl_UniCharLen\fR(\fIuniStr\fR)
@@ -70,10 +70,10 @@ int
\fBTcl_UtfNcasecmp\fR(\fIcs, ct, length\fR)
.sp
int
\fBTcl_UtfCharComplete\fR(\fIsrc, numBytes\fR)
\fBTcl_UtfCharComplete\fR(\fIsrc, length\fR)
.sp
int
\fBTcl_NumUtfChars\fR(\fIsrc, numBytes\fR)
\fBTcl_NumUtfChars\fR(\fIsrc, length\fR)
.sp
const char *
\fBTcl_UtfFindFirst\fR(\fIsrc, ch\fR)
@@ -115,32 +115,28 @@ Pointer to a UTF-8 string.
.AP "const char" *ct in
Pointer to a UTF-8 string.
.AP "const Tcl_UniChar" *uniStr in
A sequence of \fBTcl_UniChar\fR units with null-termination optional
depending on function.
A null-terminated Unicode string.
.AP "const Tcl_UniChar" *ucs in
A null-terminated sequence of \fBTcl_UniChar\fR.
A null-terminated Unicode string.
.AP "const Tcl_UniChar" *uct in
A null-terminated sequence of \fBTcl_UniChar\fR.
A null-terminated Unicode string.
.AP "const Tcl_UniChar" *uniPattern in
A null-terminated sequence of \fBTcl_UniChar\fR.
.AP "const unsigned short" *utf16 in
A sequence of UTF-16 units with null-termination optional
depending on function.
.AP "const wchar_t" *wcharStr in
A sequence of \fBwchar_t\fR units with null-termination optional
depending on function.
.AP int numBytes in
The length of the UTF-8 input in bytes. If
negative, the length includes all bytes until the first null byte.
.AP int numUtf16 in
The length of the input in UTF-16 units.
If negative, the length includes all bytes until the first null.
.AP int numUniChars in
The length of the input in Tcl_UniChar units.
If negative, the length includes all bytes until the first null.
.AP int numWChars in
The length of the input in wchar_t units.
If negative, the length includes all bytes until the first null.
A null-terminated Unicode string.
.AP "const unsigned short" *uStr in
A null-terminated UTF-16 string.
.AP "const wchar_t" *wStr in
A null-terminated wchar_t string.
.AP "const unsigned short" *utf16s in
A null-terminated utf-16 string.
.AP "const unsigned short" *utf16t in
A null-terminated utf-16 string.
.AP "const unsigned short" *utf16Pattern in
A null-terminated utf-16 string.
.AP Tcl_Size length in
The length of the UTF-8 string in bytes (not UTF-8 characters). If
negative, all bytes up to the first null byte are used.
.AP Tcl_Size uniLength in
The length of the Unicode string in characters.
.AP "Tcl_DString" *dsPtr in/out
A pointer to a previously initialized \fBTcl_DString\fR.
.AP "const char" *start in
@@ -190,32 +186,30 @@ not in proper UTF-8 format, \fBTcl_UtfToUniChar\fR will store the first
byte of \fIsrc\fR in \fI*chPtr\fR as a Tcl_UniChar between 0x00A0 and
0x00FF and return 1.
.PP
\fBTcl_UniCharToUtfDString\fR converts the input in the form of a
sequence of \fBTcl_UniChar\fR code points to UTF-8, appending the result to the
previously initialized output \fBTcl_DString\fR. The return value is a pointer
to the UTF-8 representation of the \fBappended\fR string.
\fBTcl_UniCharToUtfDString\fR converts the given Unicode string
to UTF-8, storing the result in a previously initialized \fBTcl_DString\fR.
The return value is a pointer to the UTF-8 representation of the
Unicode string. Storage for the return value is appended to the
end of the \fBTcl_DString\fR.
.PP
\fBTcl_UtfToUniCharDString\fR converts the input in the form of
a UTF-8 encoded string to a \fBTcl_UniChar\fR sequence
appending the result in the previously initialized \fBTcl_DString\fR.
The return value is a pointer to the appended result which is also
terminated with a \fBTcl_UniChar\fR null character.
.PP
\fBTcl_WCharToUtfDString\fR and \fBTcl_UtfToWCharDString\fR are similar to
\fBTcl_UniCharToUtfDString\fR and \fBTcl_UtfToUniCharDString\fR except they
operate on sequences of \fBwchar_t\fR instead of \fBTcl_UniChar\fR.
.PP
\fBTcl_Char16ToUtfDString\fR and \fBTcl_UtfToChar16DString\fR are similar to
\fBTcl_UniCharToUtfDString\fR and \fBTcl_UtfToUniCharDString\fR except they
operate on sequences of \fBUTF-16\fR units instead of \fBTcl_UniChar\fR.
\fBTcl_UtfToUniCharDString\fR converts the given UTF-8 string to Unicode,
storing the result in the previously initialized \fBTcl_DString\fR.
In the argument \fIlength\fR, you may either specify the length of
the given UTF-8 string in bytes or
.QW \-1 ,
in which case \fBTcl_UtfToUniCharDString\fR uses \fBstrlen\fR to
calculate the length. The return value is a pointer to the Unicode
representation of the UTF-8 string. Storage for the return value
is appended to the end of the \fBTcl_DString\fR. The Unicode string
is terminated with a Unicode null character.
.PP
\fBTcl_Char16Len\fR corresponds to \fBstrlen\fR for UTF-16
characters. It accepts a null-terminated UTF-16 sequence and returns
the number of UTF-16 units until the null.
characters. It accepts a null-terminated Unicode string and returns
the number of Unicode characters (not bytes) in that string.
.PP
\fBTcl_WCharLen\fR corresponds to \fBstrlen\fR for wchar_t
characters. It accepts a null-terminated \fBwchar_t\fR sequence and returns
the number of \fBwchar_t\fR units until the null.
characters. It accepts a null-terminated Unicode string and returns
the number of Unicode characters (not bytes) in that string.
.PP
\fBTcl_UniCharLen\fR corresponds to \fBstrlen\fR for Unicode
characters. It accepts a null-terminated Unicode string and returns
@@ -251,7 +245,7 @@ differences in case when comparing upper, lower or title case
characters.
.PP
\fBTcl_UtfCharComplete\fR returns 1 if the source UTF-8 string \fIsrc\fR
of \fInumBytes\fR bytes is long enough to be decoded by
of \fIlength\fR bytes is long enough to be decoded by
\fBTcl_UtfToUniChar\fR/\fBTcl_UtfNext\fR, or 0 otherwise. This function
does not guarantee that the UTF-8 string is properly formed. This routine
is used by procedures that are operating on a byte at a time and need to
+20 -20
View File
@@ -241,7 +241,7 @@ which returns a binary string equivalent to:
\fB\e254\fR
.CE
.PP
(i.e. \fB\exAC\fR) by
(i.e. \fB\exac\fR) by
truncating the high-bits of the character, and which is probably not
what is desired.
.RE
@@ -299,7 +299,7 @@ high-to-low order within each byte. For example,
will return a binary string equivalent to:
.PP
.CS
\fB\exE0\exE1\exA0\fR
\fB\exe0\exe1\exa0\fR
.CE
.RE
.IP \fBH\fR 5
@@ -326,7 +326,7 @@ remaining bits of the last byte will be zeros. For example,
will return a binary string equivalent to:
.PP
.CS
\fB\exAB\ex00\exDE\exF0\ex98\fR
\fB\exab\ex00\exde\exf0\ex98\fR
.CE
.RE
.IP \fBh\fR 5
@@ -341,7 +341,7 @@ low-to-high order within each byte. This is seldom required. For example,
will return a binary string equivalent to:
.PP
.CS
\fB\exBA\ex00\exED\ex0F\ex89\fR
\fB\exba\ex00\exed\ex0f\ex89\fR
.CE
.RE
.IP \fBc\fR 5
@@ -363,7 +363,7 @@ than \fIcount\fR, then the extra elements are ignored. For example,
will return a binary string equivalent to:
.PP
.CS
\fB\ex03\exFD\ex80\ex04\ex02\ex05\fR
\fB\ex03\exfd\ex80\ex04\ex02\ex05\fR
.CE
.PP
whereas:
@@ -389,7 +389,7 @@ example,
will return a binary string equivalent to:
.PP
.CS
\fB\ex03\ex00\exFD\exFF\ex02\ex01\fR
\fB\ex03\ex00\exfd\exff\ex02\ex01\fR
.CE
.RE
.IP \fBS\fR 5
@@ -405,7 +405,7 @@ example,
will return a binary string equivalent to:
.PP
.CS
\fB\ex00\ex03\exFF\exFD\ex01\ex02\fR
\fB\ex00\ex03\exff\exfd\ex01\ex02\fR
.CE
.RE
.IP \fBt\fR 5
@@ -429,7 +429,7 @@ example,
will return a binary string equivalent to:
.PP
.CS
\fB\ex03\ex00\ex00\ex00\exFD\exFF\exFF\exFF\ex00\ex00\ex01\ex00\fR
\fB\ex03\ex00\ex00\ex00\exfd\exff\exff\exff\ex00\ex00\ex01\ex00\fR
.CE
.RE
.IP \fBI\fR 5
@@ -445,7 +445,7 @@ For example,
will return a binary string equivalent to:
.PP
.CS
\fB\ex00\ex00\ex00\ex03\exFF\exFF\exFF\exFD\ex00\ex01\ex00\ex00\fR
\fB\ex00\ex00\ex00\ex03\exff\exff\exff\exfd\ex00\ex01\ex00\ex00\fR
.CE
.RE
.IP \fBn\fR 5
@@ -510,7 +510,7 @@ on a Windows system running on an Intel Pentium processor,
will return a binary string equivalent to:
.PP
.CS
\fB\exCD\exCC\exCC\ex3F\ex9A\ex99\ex59\ex40\fR
\fB\excd\excc\excc\ex3f\ex9a\ex99\ex59\ex40\fR
.CE
.RE
.IP \fBr\fR 5
@@ -536,7 +536,7 @@ Windows system running on an Intel Pentium processor,
will return a binary string equivalent to:
.PP
.CS
\fB\ex9A\ex99\ex99\ex99\ex99\ex99\exF9\ex3F\fR
\fB\ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f\fR
.CE
.RE
.IP \fBq\fR 5
@@ -788,7 +788,7 @@ scanned. For example,
.RS
.PP
.CS
\fBbinary scan\fR \ex07\exC6\ex05\ex1F\ex34 H3H* var1 var2
\fBbinary scan\fR \ex07\exC6\ex05\ex1f\ex34 H3H* var1 var2
.CE
.PP
will return \fB2\fR with \fB07c\fR stored in \fIvar1\fR and
@@ -839,7 +839,7 @@ example,
.RS
.PP
.CS
\fBbinary scan\fR \ex05\ex00\ex07\ex00\exF0\exFF s2s* var1 var2
\fBbinary scan\fR \ex05\ex00\ex07\ex00\exf0\exff s2s* var1 var2
.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
@@ -853,7 +853,7 @@ order. For example,
.RS
.PP
.CS
\fBbinary scan\fR \ex00\ex05\ex00\ex07\exFF\exF0 S2S* var1 var2
\fBbinary scan\fR \ex00\ex05\ex00\ex07\exff\exf0 S2S* var1 var2
.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
@@ -878,7 +878,7 @@ example,
.RS
.PP
.CS
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exF0\exFF\exFF\exFF
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff
\fBbinary scan\fR $str i2i* var1 var2
.CE
.PP
@@ -894,7 +894,7 @@ immediately after the \fBI\fR. For example,
.RS
.PP
.CS
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exFF\exFF\exFF\exF0
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0
\fBbinary scan\fR $str I2I* var1 var2
.CE
.PP
@@ -920,7 +920,7 @@ example,
.RS
.PP
.CS
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exF0\exFF\exFF\exFF
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff
\fBbinary scan\fR $str wi* var1 var2
.CE
.PP
@@ -935,7 +935,7 @@ immediately after the \fBW\fR. For example,
.RS
.PP
.CS
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exFF\exFF\exFF\exF0
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0
\fBbinary scan\fR $str WI* var1 var2
.CE
.PP
@@ -966,7 +966,7 @@ Intel Pentium processor,
.RS
.PP
.CS
\fBbinary scan\fR \ex3F\exCC\exCC\exCD f var1
\fBbinary scan\fR \ex3f\excc\excc\excd f var1
.CE
.PP
will return \fB1\fR with \fB1.6000000238418579\fR stored in
@@ -990,7 +990,7 @@ running on an Intel Pentium processor,
.RS
.PP
.CS
\fBbinary scan\fR \ex9A\ex99\ex99\ex99\ex99\ex99\exF9\ex3F d var1
\fBbinary scan\fR \ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f d var1
.CE
.PP
will return \fB1\fR with \fB1.6000000000000001\fR
+3 -3
View File
@@ -152,7 +152,7 @@ If \fIchar\fR is the empty string, there is no special character that marks
the end of the data.
The default value is the empty string. The acceptable range is \ex01 -
\ex7F. A value outside this range results in an error.
\ex7f. A value outside this range results in an error.
.VS "TCL8.7 TIP656"
.TP
\fB\-profile\fR \fIprofile\fR
@@ -245,10 +245,10 @@ files to slow destinations like network sockets.
.PP
\fB\-size\fR limits the number of characters copied.
.PP
If \fB\-command\fR is given, \fBchan copy\fR returns immediately, works in the
If \fB\-command\fR is gviven, \fBchan copy\fR returns immediately, works in the
background, and calls \fIcallback\fR when the copy completes, providing as an
additional argument the number of characters written to \fIoutputChan\fR. If
an error occurs during the background copy, another argument provides message
an error occurres during the background copy, another argument provides message
for the error. \fIinputChan\fR and \fIoutputChan\fR are automatically
configured for non-blocking mode if needed. Background copying only works
correctly if events are being processed, e.g. via \fBvwait\fR or Tk.
-16
View File
@@ -119,22 +119,6 @@ Volume-relative path to a file \fBfoo\fR in the root directory of the current
volume. This is not a valid UNC path, so the assumption is that the
extra backslashes are superfluous.
.RE
.SH "TILDE SUBSTITUTION"
.PP
Unlike earlier versions of Tcl, Tcl 9 does not do implicit tilde substitution
on file paths with the exception noted below. The commands \fBfile home\fR and
\fBfile tildeexpand\fR may be used to explicitly accomplish the same.
.PP
The exception to the above is initialization of the \fBauto_path\fR variable
and the Tcl module search paths as documented in the manpages for
\fBtclvars\fR and \fBtm\fR. When any path in an environment variable used to
initialize these starts with a tilde, it will be interpreted as if the first
element is replaced with the location of the home directory for the given
user. If the tilde is followed immediately by a separator, the
\fB$HOME\fR environment variable is substituted. Otherwise the characters
between the tilde and the next separator are taken as a user name, which is
used to retrieve the user's home directory for substitution. This works on
POSIX, MacOS X and Windows platforms.
.SH "PORTABILITY ISSUES"
.PP
Not all file systems are case sensitive, so scripts should avoid code
-3
View File
@@ -248,9 +248,6 @@ For example, to print the contents of the \fBtcl_platform\fR array, do:
\fBparray\fR tcl_platform
.CE
.RE
.SS "WORD BOUNDARY HELPERS"
.PP
These procedures are mainly used internally by Tk.
.TP
\fBtcl_endOfWord \fIstr start\fR
.
+33 -62
View File
@@ -20,47 +20,18 @@ lseq \- Build a numeric sequence returned as a list
.SH DESCRIPTION
.PP
The \fBlseq\fR command creates a sequence of numeric values using the given
parameters \fIstart\fR, \fIend\fR, and \fIstep\fR. The \fIoperation\fR
argument "\fB..\fR" or "\fBto\fR" defines the range. The "\fBcount\fR" option
is used to define a count of the number of elements in the list. A short form
use of the command, with a single count value, will create a range from 0 to
count-1.
The \fBlseq\fR command can produce both increasing and decreasing
sequences. When both \fIstart\fR and \fIend\fR are provided without a
\fIstep\fR value, then if \fIstart\fR <= \fIend\fR, the sequence will be
increasing and if \fIstart\fR > \fIend\fR it will be decreasing. If a
\fIstep\fR vale is included, it's sign should agree with the direction of the
sequence (descending -> negative and ascending -> positive), otherwise an
empty list is returned. For example:
.CS \"
% \fBlseq\fR 1 to 5 ;# increasing
\fI\(-> 1 2 3 4 5
% \fBlseq\fR 5 to 1 ;# decreasing
\fI\(-> 5 4 3 2 1
% \fBlseq\fR 6 to 1 by 2 ;# decreasing, step wrong sign, empty list
% \fBlseq\fR 1 to 5 by 0 ;# all step sizes of 0 produce an empty list
.\"
.CE
The numeric arguments, \fIstart\fR, \fIend\fR, \fIstep\fR, and \fIcount\fR,
may also be a valid expression. The expression will be evaluated and the
numeric result will be used. An expression that does not evaluate to a number
will produce an invalid argument error.
.PP
\fIStart\fR defines the initial value and \fIend\fR defines the limit, not
necessarily the last value. \fBlseq\fR produces a list with \fIcount\fR
elements, and if \fIcount\fR is not supplied, it is computed as
.CS \"
\fIcount\fR = int( (\fIend\fR - \fIstart\fR + \fIstep\fR) / \fIstep\fR )
.\"
.CE
parameters \fIstart\fR, \fIend\fR, and \fIstep\fR.
The \fIoperation\fR argument
.QW \fB..\fR
or
.QW \fBto\fR
defines an inclusive range; if it is omitted, the range is exclusive.
The \fBcount\fR option is used to define a count of the number of elements in
the list.
The \fIstep\fR (which may be preceded by \fBby\fR) is 1 if not provided.
The short form with a
single \fIcount\fR value will create a range from 0 to \fIcount\fR-1 (i.e.,
\fIcount\fR values).
.PP
The numeric arguments, \fIstart\fR, \fIend\fR, \fIstep\fR, and \fIcount\fR,
can also be a valid expression. the \fBlseq\fR command will evaluate the
@@ -72,53 +43,53 @@ value; a non-numeric expression result will result in an error.
.CS
.\"
\fBlseq\fR 3
\fI\(-> 0 1 2\fR
\fI\(-> 0 1 2\fR
\fBlseq\fR 3 0
\fI\(-> 3 2 1 0\fR
\fI\(-> 3 2 1 0\fR
\fBlseq\fR 10 .. 1 by -2
\fI\(-> 10 8 6 4 2\fR
\fI\(-> 10 8 6 4 2\fR
set l [\fBlseq\fR 0 -5]
\fI\(-> 0 -1 -2 -3 -4 -5\fR
\fI\(-> 0 -1 -2 -3 -4 -5\fR
foreach i [\fBlseq\fR [llength $l]] {
puts l($i)=[lindex $l $i]
}
\fI\(-> l(0)=0\fR
\fI\(-> l(1)=-1\fR
\fI\(-> l(2)=-2\fR
\fI\(-> l(3)=-3\fR
\fI\(-> l(4)=-4\fR
\fI\(-> l(5)=-5\fR
\fI\(-> l(0)=0\fR
\fI\(-> l(1)=-1\fR
\fI\(-> l(2)=-2\fR
\fI\(-> l(3)=-3\fR
\fI\(-> l(4)=-4\fR
\fI\(-> l(5)=-5\fR
foreach i [\fBlseq\fR {[llength $l]-1} 0] {
puts l($i)=[lindex $l $i]
}
\fI\(-> l(5)=-5\fR
\fI\(-> l(4)=-4\fR
\fI\(-> l(3)=-3\fR
\fI\(-> l(2)=-2\fR
\fI\(-> l(1)=-1\fR
\fI\(-> l(0)=0\fR
\fI\(-> l(5)=-5\fR
\fI\(-> l(4)=-4\fR
\fI\(-> l(3)=-3\fR
\fI\(-> l(2)=-2\fR
\fI\(-> l(1)=-1\fR
\fI\(-> l(0)=0\fR
set i 17
\fI\(-> 17\fR
if {$i in [\fBlseq\fR 0 50]} { # equivalent to: (0 <= $i && $i <= 50)
if {$i in [\fBlseq\fR 0 50]} { # equivalent to: (0 <= $i && $i < 50)
puts "Ok"
} else {
puts "outside :("
}
\fI\(-> Ok\fR
\fI\(-> Ok\fR
set sqrs [lmap i [\fBlseq\fR 1 10] { expr {$i*$i} }]
\fI\(-> 1 4 9 16 25 36 49 64 81 100\fR
\fI\(-> 1 4 9 16 25 36 49 64 81 100\fR
.\"
.CE
.SH "SEE ALSO"
foreach(n), list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n),
lmap(n), lpop(n), lrange(n), lremove(n), lreplace(n),
foreach(n), list(n), lappend(n), lassign(n), ledit(n), lindex(n), linsert(n),
llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lreplace(n),
lreverse(n), lsearch(n), lset(n), lsort(n)
.SH KEYWORDS
element, index, list
-4
View File
@@ -30,10 +30,6 @@ the parent directory of \fBtcl_library\fR,
the directories listed in the \fBtcl_pkgPath\fR variable.
Additional locations to look for files and package indices should
normally be added to this variable using \fBlappend\fR.
Initialization of auto_path from the TCLLIBPATH environment
variable undergoes tilde substitution (see \fBfilename\fR) on each
path. Any tilde substitution that fails because the user is unknown
will be omitted from auto_path.
.RS
.PP
Additional variables relating to package management exist. More
-4
View File
@@ -295,10 +295,6 @@ environment variables:
\fB$::env(TCL8.1_TM_PATH)\fR \fB$::env(TCL8_1_TM_PATH)\fR
\fB$::env(TCL8.0_TM_PATH)\fR \fB$::env(TCL8_0_TM_PATH)\fR
.CE
.PP
Paths initialized from the environment variables undergo tilde
substitution (see \fBfilename\fR). Any path whose tilde substitution
fails because the user is unknown will be omitted from search paths.
.SH "SEE ALSO"
package(n), Tcl Improvement Proposal #189
.QW "\fITcl Modules\fR"
+1 -1
View File
@@ -231,7 +231,7 @@ When the trace triggers, three arguments are appended to
.PP
\fIName1\fR gives the name for the variable being accessed.
This is not necessarily the same as the name used in the
\fBtrace add variable\fR command: the \fBupvar\fR command allows a
\fBtrace variable\fR command: the \fBupvar\fR command allows a
procedure to reference a variable under a different name.
If the trace was originally set on an array or array element,
\fIname2\fR provides which index into the array was affected.
+1 -1
View File
@@ -94,7 +94,7 @@ proc \fIsetByUpvar\fR { name value } {
set localVar $value
}
set originalVar 1
trace add variable originalVar write \fItraceproc\fR
trace variable originalVar w \fItraceproc\fR
\fIsetByUpvar\fR originalVar 2
.CE
.PP
-6
View File
@@ -84,15 +84,9 @@ typedef int celt; /* Type to hold chr, or NOCELT */
#define NOCELT (-1) /* Celt value which is not valid chr */
#define CHR(c) (UCHAR(c)) /* Turn char literal into chr literal */
#define DIGITVAL(c) ((c)-'0') /* Turn chr digit into its value */
#if TCL_UTF_MAX > 3
#define CHRBITS 32 /* Bits in a chr; must not use sizeof */
#define CHR_MIN 0x00000000 /* Smallest and largest chr; the value */
#define CHR_MAX 0x10FFFF /* CHR_MAX-CHR_MIN+1 should fit in uchr */
#else
#define CHRBITS 16 /* Bits in a chr; must not use sizeof */
#define CHR_MIN 0x0000 /* Smallest and largest chr; the value */
#define CHR_MAX 0xFFFF /* CHR_MAX-CHR_MIN+1 should fit in uchr */
#endif
/*
* Functions operating on chr.
+39 -202
View File
@@ -9,6 +9,7 @@
* Copyright (c) 1994-1998 Sun Microsystems, Inc.
* Copyright (c) 1998-2000 by Scriptics Corporation.
* Copyright (c) 2002 by Kevin B. Kenny. All rights reserved.
* Copyright (c) 2021 by Nathan Coulter. All rights reserved.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -105,6 +106,9 @@ extern "C" {
#include <stdio.h>
#include <stddef.h>
#define TCL_COMMENT(x)
#if defined(__GNUC__) && (__GNUC__ > 2)
# if defined(_WIN32) && defined(__USE_MINGW_ANSI_STDIO) && __USE_MINGW_ANSI_STDIO
# define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__MINGW_PRINTF_FORMAT, a, b)))
@@ -208,10 +212,6 @@ extern "C" {
# endif
#endif
#if !defined(CONST86) && !defined(TCL_NO_DEPRECATED)
# define CONST86 const
#endif
/*
* Make sure EXTERN isn't defined elsewhere.
*/
@@ -321,24 +321,12 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
#define Tcl_WideAsDouble(val) ((double)((Tcl_WideInt)(val)))
#define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val)))
#if TCL_MAJOR_VERSION < 9
typedef int Tcl_Size;
# define TCL_SIZE_MODIFIER ""
# define TCL_SIZE_MAX INT_MAX
#else
typedef ptrdiff_t Tcl_Size;
# define TCL_SIZE_MAX PTRDIFF_MAX
# define TCL_SIZE_MODIFIER TCL_T_MODIFIER
#endif /* TCL_MAJOR_VERSION */
typedef ptrdiff_t Tcl_Size;
#define TCL_SIZE_MAX PTRDIFF_MAX
#define TCL_SIZE_MODIFIER TCL_T_MODIFIER
#ifdef _WIN32
# if TCL_MAJOR_VERSION > 8 || defined(_WIN64) || defined(_USE_64BIT_TIME_T)
typedef struct __stat64 Tcl_StatBuf;
# elif defined(_USE_32BIT_TIME_T)
typedef struct _stati64 Tcl_StatBuf;
# else
typedef struct _stat32i64 Tcl_StatBuf;
# endif
typedef struct __stat64 Tcl_StatBuf;
#elif defined(__CYGWIN__)
typedef struct {
unsigned st_dev;
@@ -355,6 +343,8 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
struct {long tv_sec;} st_mtim;
struct {long tv_sec;} st_ctim;
} Tcl_StatBuf;
#elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__)
typedef struct stat64 Tcl_StatBuf;
#else
typedef struct stat Tcl_StatBuf;
#endif
@@ -463,28 +453,18 @@ typedef void (Tcl_ThreadCreateProc) (void *clientData);
*/
typedef struct Tcl_RegExpIndices {
#if TCL_MAJOR_VERSION > 8
Tcl_Size start; /* Character offset of first character in
* match. */
Tcl_Size end; /* Character offset of first character after
* the match. */
#else
long start;
long end;
#endif
} Tcl_RegExpIndices;
typedef struct Tcl_RegExpInfo {
Tcl_Size nsubs; /* Number of subexpressions in the compiled
* expression. */
Tcl_RegExpIndices *matches; /* Array of nsubs match offset pairs. */
#if TCL_MAJOR_VERSION > 8
Tcl_Size extendStart; /* The offset at which a subsequent match
* might begin. */
#else
long extendStart;
long reserved; /* Reserved for later use. */
#endif
} Tcl_RegExpInfo;
/*
@@ -606,32 +586,6 @@ typedef void *(Tcl_InitNotifierProc) (void);
typedef void (Tcl_FinalizeNotifierProc) (void *clientData);
typedef void (Tcl_MainLoopProc) (void);
/* Abstract List functions */
typedef Tcl_Size (Tcl_ObjTypeLengthProc) (struct Tcl_Obj *listPtr);
typedef int (Tcl_ObjTypeIndexProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
Tcl_Size index, struct Tcl_Obj** elemObj);
typedef int (Tcl_ObjTypeSliceProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
Tcl_Size fromIdx, Tcl_Size toIdx,
struct Tcl_Obj **newObjPtr);
typedef int (Tcl_ObjTypeReverseProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
struct Tcl_Obj **newObjPtr);
typedef int (Tcl_ObjTypeGetElements) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
Tcl_Size *objcptr, struct Tcl_Obj ***objvptr);
typedef struct Tcl_Obj* (Tcl_ObjTypeSetElement) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
Tcl_Size indexCount,
struct Tcl_Obj *const indexArray[],
struct Tcl_Obj *valueObj);
typedef int (Tcl_ObjTypeReplaceProc) (Tcl_Interp *interp, struct Tcl_Obj *listObj,
Tcl_Size first, Tcl_Size numToDelete,
Tcl_Size numToInsert,
struct Tcl_Obj *const insertObjs[]);
typedef int (Tcl_ObjTypeInOperatorProc) (Tcl_Interp *interp, struct Tcl_Obj *valueObj,
struct Tcl_Obj *listObj, int *boolResult);
#ifndef TCL_NO_DEPRECATED
# define Tcl_PackageInitProc Tcl_LibraryInitProc
# define Tcl_PackageUnloadProc Tcl_LibraryUnloadProc
#endif
/*
*----------------------------------------------------------------------------
@@ -640,6 +594,10 @@ typedef int (Tcl_ObjTypeInOperatorProc) (Tcl_Interp *interp, struct T
* standard operations on objects of that type.
*/
/* forward declaration */
typedef struct Tcl_Obj Tcl_Obj;
typedef struct Tcl_ObjInterface Tcl_ObjInterface;
typedef struct Tcl_ObjType {
const char *name; /* Name of the type, e.g. "int". */
Tcl_FreeInternalRepProc *freeIntRepProc;
@@ -656,40 +614,12 @@ typedef struct Tcl_ObjType {
/* Called to convert the object's internal rep
* to this type. Frees the internal rep of the
* old type. Returns TCL_ERROR on failure. */
#if TCL_MAJOR_VERSION > 8
size_t version;
/* List emulation functions - ObjType Version 1 */
Tcl_ObjTypeLengthProc *lengthProc; /* Return the [llength] of the
** AbstractList */
Tcl_ObjTypeIndexProc *indexProc; /* Return a value (Tcl_Obj) for
** [lindex $al $index] */
Tcl_ObjTypeSliceProc *sliceProc; /* Return an AbstractList for
** [lrange $al $start $end] */
Tcl_ObjTypeReverseProc *reverseProc; /* Return an AbstractList for
** [lreverse $al] */
Tcl_ObjTypeGetElements *getElementsProc; /* Return an objv[] of all elements in
** the list */
Tcl_ObjTypeSetElement *setElementProc; /* Replace the element at the indicie
** with the given valueObj. */
Tcl_ObjTypeReplaceProc *replaceProc; /* Replace subset with subset */
Tcl_ObjTypeInOperatorProc *inOperProc; /* "in" and "ni" expr list
** operation Determine if the given
** string value matches an element in
** the list */
#endif
} Tcl_ObjType;
#if TCL_MAJOR_VERSION > 8
# define TCL_OBJTYPE_V0 0, \
0,0,0,0,0,0,0,0 /* Pre-Tcl 9 */
# define TCL_OBJTYPE_V1(a) offsetof(Tcl_ObjType, indexProc), \
a,0,0,0,0,0,0,0 /* Tcl 9 Version 1 */
# define TCL_OBJTYPE_V2(a,b,c,d,e,f,g,h) sizeof(Tcl_ObjType), \
a,b,c,d,e,f,g,h /* Tcl 9 - AbstractLists */
#else
# define TCL_OBJTYPE_V0 /* just empty */
#endif
#define TCL_OBJTYPE_V0 0 /* Pre-Tcl 9. Set to 0 so compiler will auto-init
* when existing code that does not init this
* field is compiled with Tcl9 headers */
#define TCL_OBJTYPE_CURRENT TCL_OBJTYPE_V0
/*
* The following structure stores an internal representation (internalrep) for
@@ -720,7 +650,7 @@ typedef union Tcl_ObjInternalRep { /* The internal representation: */
* or both.
*/
typedef struct Tcl_Obj {
struct Tcl_Obj {
Tcl_Size refCount; /* When 0 the object will be freed. */
char *bytes; /* This points to the first byte of the
* object's string representation. The array
@@ -740,8 +670,9 @@ typedef struct Tcl_Obj {
* internal rep. NULL indicates the object has
* no internal rep (has no type). */
Tcl_ObjInternalRep internalRep; /* The internal representation: */
} Tcl_Obj;
};
/*
*----------------------------------------------------------------------------
* The following definitions support Tcl's namespace facility. Note: the first
@@ -930,11 +861,7 @@ typedef struct Tcl_DString {
* TCL_COMBINE Combine surrogates
*/
#if TCL_MAJOR_VERSION > 8
# define TCL_COMBINE 0x1000000
#else
# define TCL_COMBINE 0
#endif
#define TCL_COMBINE 0x1000000
/*
*----------------------------------------------------------------------------
* Flag values passed to Tcl_RecordAndEval, Tcl_EvalObj, Tcl_EvalObjv.
@@ -1048,11 +975,7 @@ typedef struct Tcl_DString {
*/
#ifndef TCL_HASH_TYPE
#if TCL_MAJOR_VERSION > 8
# define TCL_HASH_TYPE size_t
#else
# define TCL_HASH_TYPE unsigned
#endif
#define TCL_HASH_TYPE size_t
#endif
typedef struct Tcl_HashKeyType Tcl_HashKeyType;
@@ -1169,15 +1092,10 @@ struct Tcl_HashTable {
* table. */
Tcl_Size rebuildSize; /* Enlarge table when numEntries gets to be
* this large. */
#if TCL_MAJOR_VERSION > 8
size_t mask; /* Mask value used in hashing function. */
#endif
int downShift; /* Shift count used in hashing function.
* Designed to use high-order bits of
* randomized keys. */
#if TCL_MAJOR_VERSION < 9
int mask; /* Mask value used in hashing function. */
#endif
int keyType; /* Type of keys used in this table. It's
* either TCL_CUSTOM_KEYS, TCL_STRING_KEYS,
* TCL_ONE_WORD_KEYS, or an integer giving the
@@ -1343,11 +1261,7 @@ typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, void *clientData);
* interface.
*/
#if TCL_MAJOR_VERSION > 8
# define TCL_CLOSE2PROC NULL
#else
# define TCL_CLOSE2PROC ((void *) 1)
#endif
#define TCL_CLOSE2PROC NULL
/*
* Channel version tag. This was introduced in 8.3.2/8.4.
@@ -1897,12 +1811,10 @@ typedef struct Tcl_Parse {
* *tokenPtr. */
int errorType; /* One of the parsing error types defined
* above. */
#if TCL_MAJOR_VERSION > 8
int incomplete; /* This field is set to 1 by Tcl_ParseCommand
* if the command appears to be incomplete.
* This information is used by
* Tcl_CommandComplete. */
#endif
/*
* The fields below are intended only for the private use of the parser.
@@ -1921,9 +1833,6 @@ typedef struct Tcl_Parse {
* beginning of region where the error
* occurred (e.g. the open brace if the close
* brace is missing). */
#if TCL_MAJOR_VERSION < 9
int incomplete;
#endif
Tcl_Token staticTokens[NUM_STATIC_TOKENS];
/* Initial space for tokens for command. This
* space should be large enough to accommodate
@@ -1980,7 +1889,7 @@ typedef struct Tcl_EncodingType {
* reset to an initial state. If the source
* buffer contains the entire input stream to be
* converted, this flag should be set.
* TCL_ENCODING_STOPONERROR - Not used any more.
* TCL_ENCODING_STOPONERROR - Obsolete.
* TCL_ENCODING_NO_TERMINATE - If set, Tcl_ExternalToUtf does not append a
* terminating NUL byte. Since it does not need
* an extra byte for a terminating NUL, it fills
@@ -2005,11 +1914,7 @@ typedef struct Tcl_EncodingType {
#define TCL_ENCODING_START 0x01
#define TCL_ENCODING_END 0x02
#if TCL_MAJOR_VERSION > 8
# define TCL_ENCODING_STOPONERROR 0x0 /* Not used any more */
#else
# define TCL_ENCODING_STOPONERROR 0x04
#endif
#define TCL_ENCODING_STOPONERROR 0x0 /* Not used any more */
#define TCL_ENCODING_NO_TERMINATE 0x08
#define TCL_ENCODING_CHAR_LIMIT 0x10
/* Internal use bits, do not define bits in this space. See above comment */
@@ -2022,11 +1927,7 @@ typedef struct Tcl_EncodingType {
#define TCL_ENCODING_PROFILE_TCL8 0x01000000
#define TCL_ENCODING_PROFILE_STRICT 0x02000000
#define TCL_ENCODING_PROFILE_REPLACE 0x03000000
#if TCL_MAJOR_VERSION < 9
#define TCL_ENCODING_PROFILE_DEFAULT TCL_ENCODING_PROFILE_TCL8
#else
#define TCL_ENCODING_PROFILE_DEFAULT TCL_ENCODING_PROFILE_TCL8
#endif
#define TCL_ENCODING_PROFILE_DEFAULT TCL_ENCODING_PROFILE_STRICT
/*
* The following definitions are the error codes returned by the conversion
@@ -2060,18 +1961,15 @@ typedef struct Tcl_EncodingType {
/*
* The maximum number of bytes that are necessary to represent a single
* Unicode character in UTF-8. The valid values are 3 and 4. If > 3,
* Unicode character in UTF-8. The valid values are 3 and 4
* (or perhaps 1 if we want to support a non-unicode enabled core). If > 3,
* then Tcl_UniChar must be 4-bytes in size (UCS-4) (the default). If == 3,
* then Tcl_UniChar must be 2-bytes in size (UTF-16). Since Tcl 9.0, UCS-4
* mode is the default and recommended mode.
*/
#ifndef TCL_UTF_MAX
# if TCL_MAJOR_VERSION > 8
# define TCL_UTF_MAX 4
# else
# define TCL_UTF_MAX 3
# endif
#endif
/*
@@ -2079,16 +1977,12 @@ typedef struct Tcl_EncodingType {
* reflected in regcustom.h.
*/
#if TCL_UTF_MAX > 3
/*
* int isn't 100% accurate as it should be a strict 4-byte value
* (perhaps int32_t). ILP64/SILP64 systems may have troubles. The
* size of this value must be reflected correctly in regcustom.h.
*/
/*
* int isn't 100% accurate as it should be a strict 4-byte value
* (perhaps int32_t). ILP64/SILP64 systems may have troubles. The
* size of this value must be reflected correctly in regcustom.h.
*/
typedef int Tcl_UniChar;
#else
typedef unsigned short Tcl_UniChar;
#endif
/*
*----------------------------------------------------------------------------
@@ -2260,6 +2154,7 @@ typedef int (Tcl_ArgvGenFuncProc)(void *clientData, Tcl_Interp *interp,
#define TCL_IO_FAILURE ((Tcl_Size)-1)
#define TCL_AUTO_LENGTH ((Tcl_Size)-1)
#define TCL_INDEX_NONE ((Tcl_Size)-1)
#define TCL_LENGTH_NONE ((Tcl_Size)-1)
/*
*----------------------------------------------------------------------------
@@ -2275,11 +2170,7 @@ typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp,
* stubs tables.
*/
#if TCL_MAJOR_VERSION > 8
# define TCL_STUB_MAGIC ((int) 0xFCA3BACB + (int) sizeof(void *))
#else
# define TCL_STUB_MAGIC ((int) 0xFCA3BACF)
#endif
#define TCL_STUB_MAGIC ((int) 0xFCA3BACB + (int) sizeof(void *))
/*
* The following function is required to be defined in all stubs aware
@@ -2301,19 +2192,7 @@ void * TclStubCall(void *arg);
#endif
#ifdef USE_TCL_STUBS
#if TCL_MAJOR_VERSION < 9
# if TCL_UTF_MAX < 4
# define Tcl_InitStubs(interp, version, exact) \
(Tcl_InitStubs)(interp, version, \
(exact)|(TCL_MAJOR_VERSION<<8)|(0xFF<<16), \
TCL_STUB_MAGIC)
# else
# define Tcl_InitStubs(interp, version, exact) \
(Tcl_InitStubs)(interp, "8.7.0", \
(exact)|(TCL_MAJOR_VERSION<<8)|(0xFF<<16), \
TCL_STUB_MAGIC)
# endif
#elif TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
# define Tcl_InitStubs(interp, version, exact) \
(Tcl_InitStubs)(interp, version, \
(exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
@@ -2325,9 +2204,7 @@ void * TclStubCall(void *arg);
TCL_STUB_MAGIC)
#endif
#else
#if TCL_MAJOR_VERSION < 9
# error "Please define -DUSE_TCL_STUBS"
#elif TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
# define Tcl_InitStubs(interp, version, exact) \
Tcl_PkgInitStubsCheck(interp, version, \
(exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16))
@@ -2359,9 +2236,6 @@ EXTERN void Tcl_StaticLibrary(Tcl_Interp *interp,
const char *prefix,
Tcl_LibraryInitProc *initProc,
Tcl_LibraryInitProc *safeInitProc);
#ifndef TCL_NO_DEPRECATED
# define Tcl_StaticPackage Tcl_StaticLibrary
#endif
EXTERN Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc);
#ifdef _WIN32
EXTERN const char *TclZipfs_AppHook(int *argc, wchar_t ***argv);
@@ -2376,7 +2250,7 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
EXTERN TCL_NORETURN void Tcl_MainExW(Tcl_Size argc, wchar_t **argv,
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
#endif
#if defined(USE_TCL_STUBS) && (TCL_MAJOR_VERSION > 8)
#if defined(USE_TCL_STUBS)
#define Tcl_SetPanicProc(panicProc) \
TclInitStubTable(((const char *(*)(Tcl_PanicProc *))TclStubCall((void *)panicProc))(panicProc))
#define Tcl_InitSubsystems() \
@@ -2473,25 +2347,6 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
# undef Tcl_IsShared
# define Tcl_IsShared(objPtr) \
Tcl_DbIsShared(objPtr, __FILE__, __LINE__)
/*
* Free the Obj by effectively doing:
*
* Tcl_IncrRefCount(objPtr);
* Tcl_DecrRefCount(objPtr);
*
* This will free the obj if there are no references to the obj.
*/
# define Tcl_BounceRefCount(objPtr) \
TclBounceRefCount(objPtr, __FILE__, __LINE__)
static inline void TclBounceRefCount(Tcl_Obj* objPtr, const char* fn, int line)
{
if (objPtr) {
if ((objPtr)->refCount == 0) {
Tcl_DbDecrRefCount(objPtr, fn, line);
}
}
}
#else
# undef Tcl_IncrRefCount
# define Tcl_IncrRefCount(objPtr) \
@@ -2511,24 +2366,6 @@ static inline void TclBounceRefCount(Tcl_Obj* objPtr, const char* fn, int line)
# undef Tcl_IsShared
# define Tcl_IsShared(objPtr) \
((objPtr)->refCount > 1)
/*
* Declare that obj will no longer be used or referenced.
* This will release the obj if there is no referece count,
* otherwise let it be.
*/
# define Tcl_BounceRefCount(objPtr) \
TclBounceRefCount(objPtr);
static inline void TclBounceRefCount(Tcl_Obj* objPtr)
{
if (objPtr) {
if ((objPtr)->refCount == 0) {
Tcl_DecrRefCount(objPtr);
}
}
}
#endif
/*
+352 -445
View File
File diff suppressed because it is too large Load Diff
+48
View File
@@ -0,0 +1,48 @@
/*
* tclArithSeries.h --
*
* This file contains the ArithSeries concrete abstract list
* implementation. It implements the inner workings of the lseq command.
*
* Copyright © 2022 Brian S. Griffin.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
/*
* The structure used for the ArithSeries internal representation.
* Note that the len can in theory be always computed by start,end,step
* but it's faster to cache it inside the internal representation.
*/
typedef struct {
Tcl_WideInt len;
Tcl_Obj **elements;
int isDouble;
Tcl_WideInt start;
Tcl_WideInt end;
Tcl_WideInt step;
} ArithSeries;
typedef struct {
Tcl_WideInt len;
Tcl_Obj **elements;
int isDouble;
double start;
double end;
double step;
int precision;
} ArithSeriesDbl;
MODULE_SCOPE int TclNewArithSeriesObj(Tcl_Interp *interp,
Tcl_Obj **arithSeriesObj, int useDoubles,
Tcl_Obj *startObj, Tcl_Obj *endObj,
Tcl_Obj *stepObj, Tcl_Obj *lenObj);
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
+1 -1
View File
@@ -224,7 +224,7 @@ typedef struct AssemblyEnv {
* offsets of the labels. */
Tcl_Size cmdLine; /* Current line number within the assembly
* code */
Tcl_Size* clNext; /* Invisible continuation line for
int* clNext; /* Invisible continuation line for
* [info frame] */
BasicBlock* head_bb; /* First basic block in the code */
BasicBlock* curr_bb; /* Current basic block */
+25 -22
View File
@@ -5147,7 +5147,7 @@ TclEvalEx(
* evaluation of the script. Only
* TCL_EVAL_GLOBAL is currently supported. */
Tcl_Size line, /* The line the script starts on. */
Tcl_Size *clNextOuter, /* Information about an outer context for */
int *clNextOuter, /* Information about an outer context for */
const char *outerScript) /* continuation line data. This is set only in
* TclSubstTokens(), to properly handle
* [...]-nested commands. The 'outerScript'
@@ -5169,8 +5169,7 @@ TclEvalEx(
const char *p, *next;
const int minObjs = 20;
Tcl_Obj **objv, **objvSpace;
int *expand;
Tcl_Size *lines, *lineSpace;
int *expand, *lines, *lineSpace;
Tcl_Token *tokenPtr;
int expandRequested, code = TCL_OK;
Tcl_Size bytesLeft, commandLength;
@@ -5188,10 +5187,10 @@ TclEvalEx(
Tcl_Obj **stackObjArray = (Tcl_Obj **)
TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *));
int *expandStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int));
Tcl_Size *linesStack = (Tcl_Size *)TclStackAlloc(interp, minObjs * sizeof(Tcl_Size));
int *linesStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int));
/* TIP #280 Structures for tracking of command
* locations. */
Tcl_Size *clNext = NULL; /* Pointer for the tracking of invisible
int *clNext = NULL; /* Pointer for the tracking of invisible
* continuation lines. Initialized only if the
* caller gave us a table of locations to
* track, via scriptCLLocPtr. It always refers
@@ -5315,7 +5314,7 @@ TclEvalEx(
Tcl_Size wordLine = line;
const char *wordStart = parsePtr->commandStart;
Tcl_Size *wordCLNext = clNext;
int *wordCLNext = clNext;
Tcl_Size objectsNeeded = 0;
Tcl_Size numWords = parsePtr->numWords;
@@ -5326,7 +5325,7 @@ TclEvalEx(
if (numWords > minObjs) {
expand = (int *)Tcl_Alloc(numWords * sizeof(int));
objvSpace = (Tcl_Obj **)Tcl_Alloc(numWords * sizeof(Tcl_Obj *));
lineSpace = (Tcl_Size *)Tcl_Alloc(numWords * sizeof(Tcl_Size));
lineSpace = (int *)Tcl_Alloc(numWords * sizeof(int));
}
expandRequested = 0;
objv = objvSpace;
@@ -5352,7 +5351,7 @@ TclEvalEx(
wordStart = tokenPtr->start;
lines[objectsUsed] = TclWordKnownAtCompileTime(tokenPtr, NULL)
? wordLine : -1;
? (int)wordLine : -1;
if (eeFramePtr->type == TCL_LOCATION_SOURCE) {
iPtr->evalFlags |= TCL_EVAL_FILE;
@@ -5418,14 +5417,14 @@ TclEvalEx(
*/
Tcl_Obj **copy = objvSpace;
Tcl_Size *lcopy = lineSpace;
Tcl_Size wordIdx = numWords;
Tcl_Size objIdx = objectsNeeded - 1;
int *lcopy = lineSpace;
int wordIdx = numWords;
int objIdx = objectsNeeded - 1;
if ((numWords > minObjs) || (objectsNeeded > minObjs)) {
objv = objvSpace =
(Tcl_Obj **)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *));
lines = lineSpace = (Tcl_Size *)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Size));
lines = lineSpace = (int *)Tcl_Alloc(objectsNeeded * sizeof(int));
}
objectsUsed = 0;
@@ -5660,7 +5659,7 @@ TclAdvanceLines(
void
TclAdvanceContinuations(
Tcl_Size *line,
Tcl_Size **clNextPtrPtr,
int **clNextPtrPtr,
int loc)
{
/*
@@ -5838,7 +5837,7 @@ TclArgumentBCEnter(
int objc,
void *codePtr,
CmdFrame *cfPtr,
Tcl_Size cmd,
int cmd,
Tcl_Size pc)
{
ExtCmdLoc *eclPtr;
@@ -6153,7 +6152,11 @@ TclNREvalObjEx(
*/
Tcl_IncrRefCount(objPtr);
listPtr = TclListObjCopy(interp, objPtr);
listPtr = TclDuplicatePureObj(interp, objPtr, tclListType);
if (!listPtr) {
Tcl_DecrRefCount(objPtr);
return TCL_ERROR;
}
Tcl_IncrRefCount(listPtr);
if (word != INT_MIN) {
@@ -7047,7 +7050,7 @@ ExprCeilFunc(
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
if (code != TCL_OK) {
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
if (irPtr) {
Tcl_SetObjResult(interp, objv[1]);
@@ -7087,7 +7090,7 @@ ExprFloorFunc(
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
if (code != TCL_OK) {
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
if (irPtr) {
Tcl_SetObjResult(interp, objv[1]);
@@ -7233,7 +7236,7 @@ ExprSqrtFunc(
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
if (code != TCL_OK) {
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
if (irPtr) {
Tcl_SetObjResult(interp, objv[1]);
@@ -7287,7 +7290,7 @@ ExprUnaryFunc(
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
if (code != TCL_OK) {
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
if (irPtr) {
d = irPtr->doubleValue;
@@ -7351,7 +7354,7 @@ ExprBinaryFunc(
code = Tcl_GetDoubleFromObj(interp, objv[1], &d1);
#ifdef ACCEPT_NAN
if (code != TCL_OK) {
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
if (irPtr) {
d1 = irPtr->doubleValue;
@@ -7366,7 +7369,7 @@ ExprBinaryFunc(
code = Tcl_GetDoubleFromObj(interp, objv[2], &d2);
#ifdef ACCEPT_NAN
if (code != TCL_OK) {
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
if (irPtr) {
d2 = irPtr->doubleValue;
@@ -7527,7 +7530,7 @@ ExprDoubleFunc(
}
if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) {
#ifdef ACCEPT_NAN
if (TclHasInternalRep(objv[1], &tclDoubleType)) {
if (TclHasInternalRep(objv[1], tclDoubleType)) {
Tcl_SetObjResult(interp, objv[1]);
return TCL_OK;
}
+7 -36
View File
@@ -381,35 +381,6 @@ Tcl_GetBytesFromObj(
return baPtr->bytes;
}
#if !defined(TCL_NO_DEPRECATED)
unsigned char *
TclGetBytesFromObj(
Tcl_Interp *interp, /* For error reporting */
Tcl_Obj *objPtr, /* Value to extract from */
void *numBytesPtr) /* If non-NULL, write the number of bytes
* in the array here */
{
Tcl_Size numBytes = 0;
unsigned char *bytes = Tcl_GetBytesFromObj(interp, objPtr, &numBytes);
if (bytes && numBytesPtr) {
if (numBytes > INT_MAX) {
/* Caller asked for numBytes to be written to an int, but the
* value is outside the int range. */
if (interp) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"byte sequence length exceeds INT_MAX", -1));
Tcl_SetErrorCode(interp, "TCL", "API", "OUTDATED", NULL);
}
return NULL;
} else {
*(int *)numBytesPtr = (int) numBytes;
}
}
return bytes;
}
#endif
/*
*----------------------------------------------------------------------
@@ -509,7 +480,7 @@ MakeByteArray(
for (; src < srcEnd && dst < dstEnd; ) {
int ch;
int count = TclUtfToUCS4(src, &ch);
int count = Tcl_UtfToUniChar(src, &ch);
if (ch > 255) {
proper = 0;
@@ -2001,7 +1972,7 @@ FormatNumber(
*/
if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, &tclDoubleType);
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, tclDoubleType);
if (irPtr == NULL) {
return TCL_ERROR;
}
@@ -2021,7 +1992,7 @@ FormatNumber(
*/
if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, &tclDoubleType);
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, tclDoubleType);
if (irPtr == NULL) {
return TCL_ERROR;
@@ -2561,7 +2532,7 @@ BinaryDecodeHex(
if (pure) {
ucs4 = c;
} else {
TclUtfToUCS4((const char *)(data - 1), &ucs4);
Tcl_UtfToUniChar((const char *)(data - 1), &ucs4);
}
TclDecrRefCount(resultObj);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -2629,7 +2600,7 @@ BinaryEncode64(
}
switch (index) {
case OPT_MAXLEN:
if (TclGetSizeIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) {
if (Tcl_GetSizeIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) {
return TCL_ERROR;
}
if (maxlen < 0) {
@@ -3026,7 +2997,7 @@ BinaryDecodeUu(
if (pure) {
ucs4 = c;
} else {
TclUtfToUCS4((const char *)(data - 1), &ucs4);
Tcl_UtfToUniChar((const char *)(data - 1), &ucs4);
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"invalid uuencode character \"%c\" (U+%06X) at position %"
@@ -3201,7 +3172,7 @@ BinaryDecode64(
* of a multi-byte character. */
/* Safe because we know data is NUL-terminated */
TclUtfToUCS4((const char *)(data - 1), &ucs4);
Tcl_UtfToUniChar((const char *)(data - 1), &ucs4);
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+1 -1
View File
@@ -433,7 +433,7 @@ ClockGetdatefieldsObjCmd(
* that it isn't.
*/
if (TclHasInternalRep(objv[1], &tclBignumType)) {
if (TclHasInternalRep(objv[1], tclBignumType)) {
Tcl_SetObjResult(interp, lit[LIT_INTEGER_VALUE_TOO_LARGE]);
return TCL_ERROR;
}
+61 -51
View File
@@ -434,7 +434,7 @@ EncodingConvertParseOptions (
Tcl_Encoding encoding;
Tcl_Obj *dataObj;
Tcl_Obj *failVarObj;
int profile = TCL_ENCODING_PROFILE_TCL8;
int profile = TCL_ENCODING_PROFILE_STRICT;
/*
* Possible combinations:
@@ -551,11 +551,11 @@ EncodingConvertfromObjCmd(
/* NOTE: ds must be freed beyond this point even on error */
switch (result) {
case TCL_OK:
errorLocation = TCL_INDEX_NONE;
break;
errorLocation = TCL_INDEX_NONE;
break;
case TCL_ERROR:
/* Error in parameters. Should not happen. interp will have error */
Tcl_DStringFree(&ds);
Tcl_DStringFree(&ds);
return TCL_ERROR;
default:
/*
@@ -565,10 +565,10 @@ EncodingConvertfromObjCmd(
* what could be decoded and the returned error location.
*/
if (failVarObj == NULL) {
Tcl_DStringFree(&ds);
Tcl_DStringFree(&ds);
return TCL_ERROR;
}
break;
break;
}
/*
@@ -653,7 +653,7 @@ EncodingConverttoObjCmd(
break;
case TCL_ERROR:
/* Error in parameters. Should not happen. interp will have error */
Tcl_DStringFree(&ds);
Tcl_DStringFree(&ds);
return TCL_ERROR;
default:
/*
@@ -663,10 +663,10 @@ EncodingConverttoObjCmd(
* what could be decoded and the returned error location.
*/
if (failVarObj == NULL) {
Tcl_DStringFree(&ds);
Tcl_DStringFree(&ds);
return TCL_ERROR;
}
break;
break;
}
/*
* TCL_OK or a TCL_CONVERT_* error where the caller wants back as much
@@ -1199,10 +1199,10 @@ FileAttrAccessTimeCmd(
#if defined(_WIN32)
/* We use a value of 0 to indicate the access time not available */
if (Tcl_GetAccessTimeFromStat(&buf) == 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"could not get access time for file \"%s\"",
TclGetString(objv[1])));
return TCL_ERROR;
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"could not get access time for file \"%s\"",
TclGetString(objv[1])));
return TCL_ERROR;
}
#endif
@@ -1281,10 +1281,10 @@ FileAttrModifyTimeCmd(
#if defined(_WIN32)
/* We use a value of 0 to indicate the modification time not available */
if (Tcl_GetModificationTimeFromStat(&buf) == 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"could not get modification time for file \"%s\"",
TclGetString(objv[1])));
return TCL_ERROR;
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"could not get modification time for file \"%s\"",
TclGetString(objv[1])));
return TCL_ERROR;
}
#endif
if (objc == 3) {
@@ -2324,34 +2324,34 @@ StoreStatData(
unsigned short mode;
if (varName == NULL) {
TclNewObj(result);
Tcl_IncrRefCount(result);
TclNewObj(result);
Tcl_IncrRefCount(result);
#define DOBJPUT(key, objValue) \
Tcl_DictObjPut(NULL, result, \
Tcl_NewStringObj((key), -1), \
(objValue));
DOBJPUT("dev", Tcl_NewWideIntObj((long)statPtr->st_dev));
DOBJPUT("ino", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));
DOBJPUT("nlink", Tcl_NewWideIntObj((long)statPtr->st_nlink));
DOBJPUT("uid", Tcl_NewWideIntObj((long)statPtr->st_uid));
DOBJPUT("gid", Tcl_NewWideIntObj((long)statPtr->st_gid));
DOBJPUT("size", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
DOBJPUT("dev", Tcl_NewWideIntObj((long)statPtr->st_dev));
DOBJPUT("ino", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));
DOBJPUT("nlink", Tcl_NewWideIntObj((long)statPtr->st_nlink));
DOBJPUT("uid", Tcl_NewWideIntObj((long)statPtr->st_uid));
DOBJPUT("gid", Tcl_NewWideIntObj((long)statPtr->st_gid));
DOBJPUT("size", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
DOBJPUT("blocks", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
DOBJPUT("blocks", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
DOBJPUT("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize));
DOBJPUT("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize));
#endif
DOBJPUT("atime", Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
DOBJPUT("mtime", Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr)));
DOBJPUT("ctime", Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
mode = (unsigned short) statPtr->st_mode;
DOBJPUT("mode", Tcl_NewWideIntObj(mode));
DOBJPUT("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1));
DOBJPUT("atime", Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
DOBJPUT("mtime", Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr)));
DOBJPUT("ctime", Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
mode = (unsigned short) statPtr->st_mode;
DOBJPUT("mode", Tcl_NewWideIntObj(mode));
DOBJPUT("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1));
#undef DOBJPUT
Tcl_SetObjResult(interp, result);
Tcl_DecrRefCount(result);
return TCL_OK;
Tcl_SetObjResult(interp, result);
Tcl_DecrRefCount(result);
return TCL_OK;
}
/*
@@ -2787,8 +2787,9 @@ EachloopCmd(
for (i=0 ; i<numLists ; i++) {
/* List */
/* Variables */
statePtr->vCopyList[i] = TclListObjCopy(interp, objv[1+i*2]);
if (statePtr->vCopyList[i] == NULL) {
statePtr->vCopyList[i] = TclDuplicatePureObj(
interp, objv[1+i*2], tclListType);
if (!statePtr->vCopyList[i]) {
result = TCL_ERROR;
goto done;
}
@@ -2812,19 +2813,26 @@ EachloopCmd(
&statePtr->varcList[i], &statePtr->varvList[i]);
/* Values */
if (TclObjTypeHasProc(objv[2+i*2],indexProc)) {
/* Special case for AbstractList */
if (TclObjectHasInterface(objv[2+i*2], list, length)) {
int status;
statePtr->aCopyList[i] = Tcl_DuplicateObj(objv[2+i*2]);
Tcl_IncrRefCount(statePtr->aCopyList[i]);
if (statePtr->aCopyList[i] == NULL) {
result = TCL_ERROR;
goto done;
}
/* Don't compute values here, wait until the last moment */
statePtr->argcList[i] = TclObjTypeLength(statePtr->aCopyList[i]);
TclObjectDispatchNoDefault(interp, status, statePtr->aCopyList[i], list,
length, interp, statePtr->aCopyList[i], &statePtr->argcList[i]);
if (status != TCL_OK) {
result = TCL_ERROR;
goto done;
}
} else {
/* List values */
statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]);
if (statePtr->aCopyList[i] == NULL) {
statePtr->aCopyList[i] = TclDuplicatePureObj(
interp, objv[2+i*2], tclListType);
if (!statePtr->aCopyList[i]) {
result = TCL_ERROR;
goto done;
}
@@ -2961,18 +2969,20 @@ ForeachAssignments(
Tcl_Obj *valuePtr, *varValuePtr;
for (i=0 ; i<statePtr->numLists ; i++) {
int isAbstractList =
TclObjTypeHasProc(statePtr->aCopyList[i],indexProc) != NULL;
TCL_UNUSEDVAR(int status);
int hasindexinterface = TclObjectHasInterface(
statePtr->aCopyList[i], list, index);
for (v=0 ; v<statePtr->varcList[i] ; v++) {
k = statePtr->index[i]++;
if (k < statePtr->argcList[i]) {
if (isAbstractList) {
if (TclObjTypeIndex(interp, statePtr->aCopyList[i], k, &valuePtr) != TCL_OK) {
if (hasindexinterface) {
TclObjectDispatchNoDefault(interp, status, statePtr->aCopyList[i], list,
index, interp, statePtr->aCopyList[i], k, &valuePtr);
if (valuePtr == NULL) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (setting %s loop variable \"%s\")",
(statePtr->resultList != NULL ? "lmap" : "foreach"),
TclGetString(statePtr->varvList[i][v])));
"\n (setting %s loop variable \"%s\")",
(statePtr->resultList != NULL ? "lmap" : "foreach"),
TclGetString(statePtr->varvList[i][v])));
return TCL_ERROR;
}
} else {
+407 -247
View File
File diff suppressed because it is too large Load Diff
+94 -56
View File
@@ -24,6 +24,7 @@
static inline Tcl_Obj * During(Tcl_Interp *interp, int resultCode,
Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
static Tcl_NRPostProc SwitchPostProc;
static Tcl_NRPostProc TryPostBody;
static Tcl_NRPostProc TryPostFinal;
@@ -1192,11 +1193,6 @@ Tcl_SplitObjCmd(
return TCL_ERROR;
}
if (splitCharLen == 0) {
Tcl_SetObjResult(interp, TclNewStringListObj(interp, objv[1]));
return TCL_OK;
}
stringPtr = Tcl_GetStringFromObj(objv[1], &stringLen);
end = stringPtr + stringLen;
TclNewObj(listPtr);
@@ -1205,6 +1201,40 @@ Tcl_SplitObjCmd(
/*
* Do nothing.
*/
} else if (splitCharLen == 0) {
Tcl_HashTable charReuseTable;
Tcl_HashEntry *hPtr;
int isNew;
/*
* Handle the special case of splitting on every character.
*
* Uses a hash table to ensure that each kind of character has only
* one Tcl_Obj instance (multiply-referenced) in the final list. This
* is a *major* win when splitting on a long string (especially in the
* megabyte range!) - DKF
*/
Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS);
for ( ; stringPtr < end; stringPtr += len) {
len = Tcl_UtfToUniChar(stringPtr, &ch);
hPtr = Tcl_CreateHashEntry(&charReuseTable, INT2PTR(ch), &isNew);
if (isNew) {
TclNewStringObj(objPtr, stringPtr, len);
/*
* Don't need to fiddle with refcount...
*/
Tcl_SetHashValue(hPtr, objPtr);
} else {
objPtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
}
Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
}
Tcl_DeleteHashTable(&charReuseTable);
} else if (splitCharLen == 1) {
const char *p;
@@ -1234,9 +1264,9 @@ Tcl_SplitObjCmd(
splitEnd = splitChars + splitCharLen;
for (element = stringPtr; stringPtr < end; stringPtr += len) {
len = TclUtfToUCS4(stringPtr, &ch);
len = Tcl_UtfToUniChar(stringPtr, &ch);
for (p = splitChars; p < splitEnd; p += splitLen) {
splitLen = TclUtfToUCS4(p, &splitChar);
splitLen = Tcl_UtfToUniChar(p, &splitChar);
if (ch == splitChar) {
TclNewStringObj(objPtr, element, stringPtr - element);
Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
@@ -1282,7 +1312,7 @@ StringFirstCmd(
if (objc < 3 || objc > 4) {
Tcl_WrongNumArgs(interp, 1, objv,
"needleString haystackString ?startIndex?");
"needleString haystackString ?startIndex?");
return TCL_ERROR;
}
@@ -1373,44 +1403,51 @@ StringIndexCmd(
return TCL_ERROR;
}
/*
* Get the char length to calculate what 'end' means.
*/
end = Tcl_GetCharLength(objv[1]) - 1;
if (TclGetIntForIndexM(interp, objv[2], end, &index) != TCL_OK) {
return TCL_ERROR;
}
if ((index >= 0) && (index <= end)) {
int ch = Tcl_GetUniChar(objv[1], index);
if (ch == -1) {
if (TclObjectHasInterface(objv[1], string, index)) {
int status;
Tcl_Obj *charPtr;
status = TclStringIndexInterface(interp, objv[1], objv[2], &charPtr) ;
if (status != TCL_OK) {
return status;
} else {
Tcl_SetObjResult(interp, charPtr);
return TCL_OK;
}
} else {
/*
* If we have a ByteArray object, we're careful to generate a new
* bytearray for a result.
* Get the char length to calculate what 'end' means.
*/
if (TclIsPureByteArray(objv[1])) {
unsigned char uch = UCHAR(ch);
Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
} else {
char buf[4] = "";
end = Tcl_UniCharToUtf(ch, buf);
#if TCL_UTF_MAX < 4
if ((ch >= 0xD800) && (end < 3)) {
end += Tcl_UniCharToUtf(-1, buf + end);
}
#endif
Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, end));
end = Tcl_GetCharLength(objv[1]) - 1;
if (TclGetIntForIndexM(interp, objv[2], end, &index) != TCL_OK) {
return TCL_ERROR;
}
if ((index >= 0) && (index <= end)) {
int ch = Tcl_GetUniChar(objv[1], index);
if (ch == -1) {
return TCL_OK;
}
/*
* If we have a ByteArray object, we're careful to generate a new
* bytearray for a result.
*/
if (TclIsPureByteArray(objv[1])) {
unsigned char uch = UCHAR(ch);
Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
} else {
char buf[4] = "";
end = Tcl_UniCharToUtf(ch, buf);
Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, end));
}
}
return TCL_OK;
}
return TCL_OK;
}
/*
@@ -1583,7 +1620,7 @@ StringIsCmd(
case STR_IS_BOOL:
case STR_IS_TRUE:
case STR_IS_FALSE:
if (!TclHasInternalRep(objPtr, &tclBooleanType)
if (!TclHasInternalRep(objPtr, tclBooleanType)
&& (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) {
if (strict) {
result = 0;
@@ -1652,9 +1689,9 @@ StringIsCmd(
chcomp = Tcl_UniCharIsDigit;
break;
case STR_IS_DOUBLE: {
if (TclHasInternalRep(objPtr, &tclDoubleType) ||
TclHasInternalRep(objPtr, &tclIntType) ||
TclHasInternalRep(objPtr, &tclBignumType)) {
if (TclHasInternalRep(objPtr, tclDoubleType) ||
TclHasInternalRep(objPtr, tclIntType) ||
TclHasInternalRep(objPtr, tclBignumType)) {
break;
}
string1 = Tcl_GetStringFromObj(objPtr, &length1);
@@ -1683,8 +1720,8 @@ StringIsCmd(
break;
case STR_IS_INT:
case STR_IS_ENTIER:
if (TclHasInternalRep(objPtr, &tclIntType) ||
TclHasInternalRep(objPtr, &tclBignumType)) {
if (TclHasInternalRep(objPtr, tclIntType) ||
TclHasInternalRep(objPtr, tclBignumType)) {
break;
}
string1 = Tcl_GetStringFromObj(objPtr, &length1);
@@ -1867,7 +1904,7 @@ StringIsCmd(
for (; string1 < end; string1 += length2, failat++) {
int ucs4;
length2 = TclUtfToUCS4(string1, &ucs4);
length2 = Tcl_UtfToUniChar(string1, &ucs4);
if (!chcomp(ucs4)) {
result = 0;
break;
@@ -2495,7 +2532,7 @@ StringStartCmd(
if (index > 0) {
p = &string[index];
(void)TclUniCharToUCS4(p, &ch);
ch = *p;
for (cur = index; cur != TCL_INDEX_NONE; cur--) {
int delta = 0;
const Tcl_UniChar *next;
@@ -2504,10 +2541,11 @@ StringStartCmd(
break;
}
next = TclUCS4Prev(p, string);
next = p > string ? p - 1 : p;
do {
next += delta;
delta = TclUniCharToUCS4(next, &ch);
delta = 1;
ch = *next;
} while (next + delta < p);
p = next;
}
@@ -2565,7 +2603,7 @@ StringEndCmd(
p = &string[index];
end = string+length;
for (cur = index; p < end; cur++) {
p += TclUniCharToUCS4(p, &ch);
ch = *p++;
if (!Tcl_UniCharIsWordChar(ch)) {
break;
}
@@ -3819,7 +3857,7 @@ TclNRSwitchObjCmd(
if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) {
int bline = ctxPtr->line[bidx];
ctxPtr->line = (Tcl_Size *)Tcl_Alloc(objc * sizeof(Tcl_Size));
ctxPtr->line = (int *)Tcl_Alloc(objc * sizeof(int));
ctxPtr->nline = objc;
TclListLines(blist, bline, objc, ctxPtr->line, objv);
} else {
@@ -3833,7 +3871,7 @@ TclNRSwitchObjCmd(
int k;
ctxPtr->line = (Tcl_Size *)Tcl_Alloc(objc * sizeof(Tcl_Size));
ctxPtr->line = (int *)Tcl_Alloc(objc * sizeof(int));
ctxPtr->nline = objc;
for (k=0; k < objc; k++) {
ctxPtr->line[k] = -1;
@@ -5273,17 +5311,17 @@ TclListLines(
* structure. Assumed to be valid. Assumed to
* contain n elements. */
Tcl_Size line, /* Line the list as a whole starts on. */
Tcl_Size n, /* #elements in lines */
Tcl_Size *lines, /* Array of line numbers, to fill. */
int n, /* #elements in lines */
int *lines, /* Array of line numbers, to fill. */
Tcl_Obj *const *elems) /* The list elems as Tcl_Obj*, in need of
* derived continuation data */
{
const char *listStr = TclGetString(listObj);
const char *listHead = listStr;
Tcl_Size i, length = strlen(listStr);
int i, length = strlen(listStr);
const char *element = NULL, *next = NULL;
ContLineLoc *clLocPtr = TclContinuationsGet(listObj);
Tcl_Size *clNext = (clLocPtr ? &clLocPtr->loc[0] : NULL);
int *clNext = (clLocPtr ? &clLocPtr->loc[0] : NULL);
for (i = 0; i < n; i++) {
TclFindElement(NULL, listStr, length, &element, &next, NULL, NULL);
+8 -1
View File
@@ -41,7 +41,7 @@ static int IndexTailVarIfKnown(Tcl_Interp *interp,
*
* Side effects:
* When TCL_OK is returned, the encoded index value is written
* to *index.
* to *indexPtr.
*
*----------------------------------------------------------------------
*/
@@ -1411,6 +1411,13 @@ TclCompileLreplaceCmd(
Tcl_Token *tokenPtr;
int i;
/*
* For now, disable compilation of lreplace. Figure out later if any
* compilation can be done given that any Tcl_ObjType may implement
* lreplace, and should return an object of the same type.
*/
return TCL_ERROR;
if (parsePtr->numWords < 4) {
return TCL_ERROR;
}
+16 -16
View File
@@ -41,12 +41,12 @@ static int CompileUnaryOpCmd(Tcl_Interp *interp,
CompileEnv *envPtr);
static void IssueSwitchChainedTests(Tcl_Interp *interp,
CompileEnv *envPtr, int mode, int noCase,
Tcl_Size numWords, Tcl_Token **bodyToken,
Tcl_Size *bodyLines, Tcl_Size **bodyNext);
int numWords, Tcl_Token **bodyToken,
int *bodyLines, int **bodyNext);
static void IssueSwitchJumpTable(Tcl_Interp *interp,
CompileEnv *envPtr, int numWords,
Tcl_Token **bodyToken, Tcl_Size *bodyLines,
Tcl_Size **bodyContLines);
Tcl_Token **bodyToken, int *bodyLines,
int **bodyContLines);
static int IssueTryClausesInstructions(Tcl_Interp *interp,
CompileEnv *envPtr, Tcl_Token *bodyToken,
int numHandlers, int *matchCodes,
@@ -1800,14 +1800,14 @@ TclCompileSwitchCmd(
Tcl_Token *bodyTokenArray; /* Array of real pattern list items. */
Tcl_Token **bodyToken; /* Array of pointers to pattern list items. */
Tcl_Size *bodyLines; /* Array of line numbers for body list
int *bodyLines; /* Array of line numbers for body list
* items. */
Tcl_Size **bodyContLines; /* Array of continuation line info. */
int **bodyContLines; /* Array of continuation line info. */
int noCase; /* Has the -nocase flag been given? */
int foundMode = 0; /* Have we seen a mode flag yet? */
int i, valueIndex;
int result = TCL_ERROR;
Tcl_Size *clNext = envPtr->clNext;
int *clNext = envPtr->clNext;
/*
* Only handle the following versions:
@@ -1964,8 +1964,8 @@ TclCompileSwitchCmd(
}
bodyTokenArray = (Tcl_Token *)Tcl_Alloc(sizeof(Tcl_Token) * maxLen);
bodyToken = (Tcl_Token **)Tcl_Alloc(sizeof(Tcl_Token *) * maxLen);
bodyLines = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size) * maxLen);
bodyContLines = (Tcl_Size **)Tcl_Alloc(sizeof(Tcl_Size*) * maxLen);
bodyLines = (int *)Tcl_Alloc(sizeof(int) * maxLen);
bodyContLines = (int **)Tcl_Alloc(sizeof(int*) * maxLen);
bline = mapPtr->loc[eclIndex].line[valueIndex+1];
numWords = 0;
@@ -2025,8 +2025,8 @@ TclCompileSwitchCmd(
*/
bodyToken = (Tcl_Token **)Tcl_Alloc(sizeof(Tcl_Token *) * numWords);
bodyLines = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size) * numWords);
bodyContLines = (Tcl_Size **)Tcl_Alloc(sizeof(Tcl_Size*) * numWords);
bodyLines = (int *)Tcl_Alloc(sizeof(int) * numWords);
bodyContLines = (int **)Tcl_Alloc(sizeof(int*) * numWords);
bodyTokenArray = NULL;
for (i=0 ; i<numWords ; i++) {
/*
@@ -2116,13 +2116,13 @@ IssueSwitchChainedTests(
CompileEnv *envPtr, /* Holds resulting instructions. */
int mode, /* Exact, Glob or Regexp */
int noCase, /* Case-insensitivity flag. */
Tcl_Size numBodyTokens, /* Number of tokens describing things the
int numBodyTokens, /* Number of tokens describing things the
* switch can match against and bodies to
* execute when the match succeeds. */
Tcl_Token **bodyToken, /* Array of pointers to pattern list items. */
Tcl_Size *bodyLines, /* Array of line numbers for body list
int *bodyLines, /* Array of line numbers for body list
* items. */
Tcl_Size **bodyContLines) /* Array of continuation line info. */
int **bodyContLines) /* Array of continuation line info. */
{
enum {Switch_Exact, Switch_Glob, Switch_Regexp};
int foundDefault; /* Flag to indicate whether a "default" clause
@@ -2368,9 +2368,9 @@ IssueSwitchJumpTable(
* switch can match against and bodies to
* execute when the match succeeds. */
Tcl_Token **bodyToken, /* Array of pointers to pattern list items. */
Tcl_Size *bodyLines, /* Array of line numbers for body list
int *bodyLines, /* Array of line numbers for body list
* items. */
Tcl_Size **bodyContLines) /* Array of continuation line info. */
int **bodyContLines) /* Array of continuation line info. */
{
JumptableInfo *jtPtr;
int infoIndex, isNew, *finalFixups, numRealBodies = 0, jumpLocation;
+3 -3
View File
@@ -2111,7 +2111,7 @@ ParseLexeme(
* Example: Inf + luence + () becomes a valid function call.
* [Bug 3401704]
*/
if (TclHasInternalRep(literal, &tclDoubleType)) {
if (TclHasInternalRep(literal, tclDoubleType)) {
const char *p = start;
while (p < end) {
@@ -2149,13 +2149,13 @@ ParseLexeme(
if (!TclIsBareword(*start) || *start == '_') {
Tcl_Size scanned;
if (Tcl_UtfCharComplete(start, numBytes)) {
scanned = TclUtfToUCS4(start, &ch);
scanned = Tcl_UtfToUniChar(start, &ch);
} else {
char utfBytes[8];
memcpy(utfBytes, start, numBytes);
utfBytes[numBytes] = '\0';
scanned = TclUtfToUCS4(utfBytes, &ch);
scanned = Tcl_UtfToUniChar(utfBytes, &ch);
}
*lexemePtr = INVALID;
Tcl_DecrRefCount(literal);
+22 -25
View File
@@ -701,8 +701,7 @@ static void StartExpanding(CompileEnv *envPtr);
*/
static void EnterCmdWordData(ExtCmdLoc *eclPtr, Tcl_Size srcOffset,
Tcl_Token *tokenPtr, const char *cmd,
Tcl_Size numWords, Tcl_Size line,
Tcl_Size *clNext, Tcl_Size **lines,
Tcl_Size numWords, Tcl_Size line, int *clNext, int **lines,
CompileEnv *envPtr);
static void ReleaseCmdWordData(ExtCmdLoc *eclPtr);
@@ -1954,8 +1953,7 @@ CompileCmdCompileProc(
CompileEnv *envPtr)
{
DefineLineInformation;
int unwind = 0;
Tcl_Size incrOffset = -1;
int unwind = 0, incrOffset = -1;
int depth = TclGetStackDepth(envPtr);
/*
@@ -2042,11 +2040,11 @@ CompileCommandTokens(
Command *cmdPtr = NULL;
int code = TCL_ERROR;
int cmdKnown, expand = -1;
Tcl_Size *wlines, wlineat;
Tcl_Size cmdLine = envPtr->line;
Tcl_Size *clNext = envPtr->clNext;
Tcl_Size cmdIdx = envPtr->numCommands;
Tcl_Size startCodeOffset = envPtr->codeNext - envPtr->codeStart;
int *wlines, wlineat;
int cmdLine = envPtr->line;
int *clNext = envPtr->clNext;
int cmdIdx = envPtr->numCommands;
int startCodeOffset = envPtr->codeNext - envPtr->codeStart;
int depth = TclGetStackDepth(envPtr);
assert ((int)parsePtr->numWords > 0);
@@ -2196,7 +2194,7 @@ TclCompileScript(
Tcl_SetObjResult(interp,
Tcl_ObjPrintf("Script length %" TCL_SIZE_MODIFIER
"d exceeds max permitted length %d.",
numBytes, INT_MAX-1));
numBytes, (int)INT_MAX-1));
Tcl_SetErrorCode(interp, "TCL", "LIMIT", "SCRIPTLENGTH", NULL);
TclCompileSyntaxError(interp, envPtr);
return;
@@ -2423,20 +2421,19 @@ TclCompileTokens(
Tcl_Interp *interp, /* Used for error and status reporting. */
Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to
* compile. */
size_t count1, /* Number of tokens to consider at tokenPtr.
size_t count1, /* Number of tokens to consider at tokenPtr.
* Must be at least 1. */
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
Tcl_DString textBuffer; /* Holds concatenated chars from adjacent
* TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */
char buffer[4] = "";
Tcl_Size i, numObjsToConcat, adjust;
int i, numObjsToConcat, adjust;
size_t length;
unsigned char *entryCodeNext = envPtr->codeNext;
#define NUM_STATIC_POS 20
int isLiteral;
Tcl_Size maxNumCL, numCL;
Tcl_Size *clPosition = NULL;
int isLiteral, maxNumCL, numCL;
int *clPosition = NULL;
int depth = TclGetStackDepth(envPtr);
int count = count1;
@@ -2466,7 +2463,7 @@ TclCompileTokens(
if (isLiteral) {
maxNumCL = NUM_STATIC_POS;
clPosition = (Tcl_Size *)Tcl_Alloc(maxNumCL * sizeof(Tcl_Size));
clPosition = (int *)Tcl_Alloc(maxNumCL * sizeof(int));
}
adjust = 0;
@@ -2506,8 +2503,8 @@ TclCompileTokens(
if (numCL >= maxNumCL) {
maxNumCL *= 2;
clPosition = (Tcl_Size *)Tcl_Realloc(clPosition,
maxNumCL * sizeof(Tcl_Size));
clPosition = (int *)Tcl_Realloc(clPosition,
maxNumCL * sizeof(int));
}
clPosition[numCL] = clPos;
numCL ++;
@@ -3333,14 +3330,14 @@ EnterCmdWordData(
const char *cmd,
Tcl_Size numWords,
Tcl_Size line,
Tcl_Size *clNext,
Tcl_Size **wlines,
int *clNext,
int **wlines,
CompileEnv *envPtr)
{
ECL *ePtr;
const char *last;
Tcl_Size wordIdx, wordLine;
Tcl_Size *wwlines, *wordNext;
int *wwlines, *wordNext;
if (eclPtr->nuloc >= eclPtr->nloc) {
/*
@@ -3359,10 +3356,10 @@ EnterCmdWordData(
ePtr = &eclPtr->loc[eclPtr->nuloc];
ePtr->srcOffset = srcOffset;
ePtr->line = (Tcl_Size *)Tcl_Alloc(numWords * sizeof(Tcl_Size));
ePtr->next = (Tcl_Size **)Tcl_Alloc(numWords * sizeof(Tcl_Size *));
ePtr->line = (int *)Tcl_Alloc(numWords * sizeof(int));
ePtr->next = (int **)Tcl_Alloc(numWords * sizeof(int *));
ePtr->nline = numWords;
wwlines = (Tcl_Size *)Tcl_Alloc(numWords * sizeof(Tcl_Size));
wwlines = (int *)Tcl_Alloc(numWords * sizeof(int));
last = cmd;
wordLine = line;
@@ -3375,7 +3372,7 @@ EnterCmdWordData(
/* See Ticket 4b61afd660 */
wwlines[wordIdx] =
((wordIdx == 0) || TclWordKnownAtCompileTime(tokenPtr, NULL))
? wordLine : -1;
? (int)wordLine : -1;
ePtr->line[wordIdx] = wordLine;
ePtr->next[wordIdx] = wordNext;
last = tokenPtr->start;
+4 -16
View File
@@ -183,16 +183,16 @@ typedef struct {
typedef struct {
Tcl_Size srcOffset; /* Command location to find the entry. */
Tcl_Size nline; /* Number of words in the command */
Tcl_Size *line; /* Line information for all words in the
int *line; /* Line information for all words in the
* command. */
Tcl_Size **next; /* Transient information used by the compiler
int **next; /* Transient information used by the compiler
* for tracking of hidden continuation
* lines. */
} ECL;
typedef struct {
int type; /* Context type. */
Tcl_Size start; /* Starting line for compiled script. Needed
int start; /* Starting line for compiled script. Needed
* for the extended recompile check in
* tclCompileObj. */
Tcl_Obj *path; /* Path of the sourced file the command is
@@ -316,10 +316,8 @@ typedef struct CompileEnv {
* array byte. */
int mallocedCodeArray; /* Set 1 if code array was expanded and
* codeStart points into the heap.*/
#if TCL_MAJOR_VERSION > 8
int mallocedExceptArray; /* 1 if ExceptionRange array was expanded and
* exceptArrayPtr points in heap, else 0. */
#endif
LiteralEntry *literalArrayPtr;
/* Points to start of LiteralEntry array. */
Tcl_Size literalArrayNext; /* Index of next free object array entry. */
@@ -335,9 +333,6 @@ typedef struct CompileEnv {
* current range's array entry. */
Tcl_Size exceptArrayEnd; /* Index after the last ExceptionRange array
* entry. */
#if TCL_MAJOR_VERSION < 9
int mallocedExceptArray;
#endif
ExceptionAux *exceptAuxArrayPtr;
/* Array of information used to restore the
* state when processing BREAK/CONTINUE
@@ -350,19 +345,14 @@ typedef struct CompileEnv {
Tcl_Size cmdMapEnd; /* Index after last CmdLocation entry. */
int mallocedCmdMap; /* 1 if command map array was expanded and
* cmdMapPtr points in the heap, else 0. */
#if TCL_MAJOR_VERSION > 8
int mallocedAuxDataArray; /* 1 if aux data array was expanded and
* auxDataArrayPtr points in heap else 0. */
#endif
AuxData *auxDataArrayPtr; /* Points to auxiliary data array start. */
Tcl_Size auxDataArrayNext; /* Next free compile aux data array index.
* auxDataArrayNext is the number of aux data
* items and (auxDataArrayNext-1) is index of
* current aux data array entry. */
Tcl_Size auxDataArrayEnd; /* Index after last aux data array entry. */
#if TCL_MAJOR_VERSION < 9
int mallocedAuxDataArray;
#endif
unsigned char staticCodeSpace[COMPILEENV_INIT_CODE_BYTES];
/* Initial storage for code. */
LiteralEntry staticLiteralSpace[COMPILEENV_INIT_NUM_OBJECTS];
@@ -392,7 +382,7 @@ typedef struct CompileEnv {
* encountered that have not yet been paired
* with a corresponding
* INST_INVOKE_EXPANDED. */
Tcl_Size *clNext; /* If not NULL, it refers to the next slot in
int *clNext; /* If not NULL, it refers to the next slot in
* clLoc to check for an invisible
* continuation line. */
} CompileEnv;
@@ -1064,7 +1054,6 @@ typedef struct {
*----------------------------------------------------------------
*/
#if TCL_MAJOR_VERSION > 8
MODULE_SCOPE Tcl_ObjCmdProc TclNRInterpCoroutine;
/*
@@ -1203,7 +1192,6 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
MODULE_SCOPE int TclPushProcCallFrame(void *clientData,
Tcl_Interp *interp, Tcl_Size objc,
Tcl_Obj *const objv[], int isLambda);
#endif /* TCL_MAJOR_VERSION > 8 */
/*
+13 -164
View File
@@ -27,10 +27,8 @@
#if !defined(BUILD_tcl)
# define TCL_DEPRECATED(msg) EXTERN TCL_DEPRECATED_API(msg)
#elif defined(TCL_NO_DEPRECATED)
# define TCL_DEPRECATED(msg) MODULE_SCOPE
#else
# define TCL_DEPRECATED(msg) EXTERN
# define TCL_DEPRECATED(msg) MODULE_SCOPE
#endif
@@ -4027,82 +4025,29 @@ extern const TclStubs *tclStubsPtr;
Tcl_GetStringFromObj(objPtr, (Tcl_Size *)NULL)
#define Tcl_GetUnicode(objPtr) \
Tcl_GetUnicodeFromObj(objPtr, (Tcl_Size *)NULL)
#if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED)
# undef Tcl_GetBytesFromObj
# undef Tcl_GetStringFromObj
# undef Tcl_GetUnicodeFromObj
#endif
#undef Tcl_GetIndexFromObjStruct
#undef Tcl_GetBooleanFromObj
#undef Tcl_GetBoolean
#undef TclGetByteArrayFromObj
#undef Tcl_GetByteArrayFromObj
#if defined(USE_TCL_STUBS)
# if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED)
# define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
(sizeof(*(sizePtr)) <= sizeof(int) ? \
tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (sizePtr)) : \
tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (Tcl_Size *)(void *)(sizePtr)))
# define Tcl_GetStringFromObj(objPtr, sizePtr) \
(sizeof(*(sizePtr)) <= sizeof(int) ? \
tclStubsPtr->tclGetStringFromObj(objPtr, (sizePtr)) : \
tclStubsPtr->tcl_GetStringFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr)))
# define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
(sizeof(*(sizePtr)) <= sizeof(int) ? \
tclStubsPtr->tclGetUnicodeFromObj(objPtr, (sizePtr)) : \
tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr)))
# endif
#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \
(tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), \
#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg,\
flags, indexPtr) \
(tclStubsPtr->tcl_GetIndexFromObjStruct(\
(interp), (objPtr), (tablePtr), (offset), (msg), \
(flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr)))
#define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \
((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \
Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
(Tcl_GetBoolFromObj(interp, objPtr,\
(TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
#define Tcl_GetBoolean(interp, src, boolPtr) \
((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \
Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
#if TCL_MAJOR_VERSION > 8
(Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof(\
(*(boolPtr))), (char *)(boolPtr)))
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
(sizeof(*(sizePtr)) <= sizeof(int) ? \
tclStubsPtr->tclGetBytesFromObj(NULL, objPtr, (sizePtr)) : \
tclStubsPtr->tcl_GetBytesFromObj(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr)))
(tclStubsPtr->tcl_GetBytesFromObj(\
NULL, objPtr, (Tcl_Size *)(void *)(sizePtr)))
#else
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
(sizeof(*(sizePtr)) <= sizeof(int) ? \
tclStubsPtr->tclGetByteArrayFromObj(objPtr, (sizePtr)) : \
tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr)))
#endif
#else
#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \
((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), \
(flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr)))
#define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \
((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \
Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
#define Tcl_GetBoolean(interp, src, boolPtr) \
((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \
Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
#if defined(TCL_NO_DEPRECATED)
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
(Tcl_GetBytesFromObj)(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr))
#else
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
(sizeof(*(sizePtr)) <= sizeof(int) ? \
TclGetBytesFromObj(NULL, objPtr, (sizePtr)) : \
(Tcl_GetBytesFromObj)(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr)))
#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
(sizeof(*(sizePtr)) <= sizeof(int) ? \
TclGetUnicodeFromObj(objPtr, (sizePtr)) : \
(Tcl_GetUnicodeFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr)))
#define Tcl_GetStringFromObj(objPtr, sizePtr) \
(sizeof(*(sizePtr)) <= sizeof(int) ? \
TclGetStringFromObj(objPtr, (sizePtr)) : \
(Tcl_GetStringFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr)))
#define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
(sizeof(*(sizePtr)) <= sizeof(int) ? \
TclGetBytesFromObj(interp, objPtr, (sizePtr)) : \
(Tcl_GetBytesFromObj)(interp, objPtr, (Tcl_Size *)(void *)(sizePtr)))
#endif
#endif
#ifdef TCL_MEM_DEBUG
@@ -4131,36 +4076,6 @@ extern const TclStubs *tclStubsPtr;
#define Tcl_BackgroundError(interp) Tcl_BackgroundException((interp), TCL_ERROR)
#define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0)
#if TCL_UTF_MAX < 4
# undef Tcl_UniCharToUtfDString
# define Tcl_UniCharToUtfDString Tcl_Char16ToUtfDString
# undef Tcl_UtfToUniCharDString
# define Tcl_UtfToUniCharDString Tcl_UtfToChar16DString
# undef Tcl_UtfToUniChar
# define Tcl_UtfToUniChar Tcl_UtfToChar16
# undef Tcl_UniCharLen
# define Tcl_UniCharLen Tcl_Char16Len
# undef Tcl_UniCharToUtf
# if defined(USE_TCL_STUBS)
# define Tcl_UniCharToUtf(c, p) \
(tclStubsPtr->tcl_UniCharToUtf((c)|TCL_COMBINE, (p)))
# else
# define Tcl_UniCharToUtf(c, p) \
((Tcl_UniCharToUtf)((c)|TCL_COMBINE, (p)))
# endif
#if !defined(BUILD_tcl)
# undef Tcl_NumUtfChars
# define Tcl_NumUtfChars TclNumUtfChars
# undef Tcl_GetCharLength
# define Tcl_GetCharLength TclGetCharLength
# undef Tcl_UtfAtIndex
# define Tcl_UtfAtIndex TclUtfAtIndex
# undef Tcl_GetRange
# define Tcl_GetRange TclGetRange
# undef Tcl_GetUniChar
# define Tcl_GetUniChar TclGetUniChar
#endif
#endif
#if defined(USE_TCL_STUBS)
# define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \
? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))tclStubsPtr->tcl_UniCharToUtfDString \
@@ -4174,36 +4089,6 @@ extern const TclStubs *tclStubsPtr;
# define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \
? (Tcl_Size (*)(wchar_t *))tclStubsPtr->tcl_UniCharLen \
: (Tcl_Size (*)(wchar_t *))Tcl_Char16Len)
#if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED)
# undef Tcl_ListObjGetElements
# define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \
? tclStubsPtr->tclListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr)) \
: tclStubsPtr->tcl_ListObjGetElements((interp), (listPtr), (Tcl_Size *)(void *)(objcPtr), (objvPtr)))
# undef Tcl_ListObjLength
# define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) == sizeof(int) \
? tclStubsPtr->tclListObjLength((interp), (listPtr), (lengthPtr)) \
: tclStubsPtr->tcl_ListObjLength((interp), (listPtr), (Tcl_Size *)(void *)(lengthPtr)))
# undef Tcl_DictObjSize
# define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) == sizeof(int) \
? tclStubsPtr->tclDictObjSize((interp), (dictPtr), (sizePtr)) \
: tclStubsPtr->tcl_DictObjSize((interp), (dictPtr), (Tcl_Size *)(void *)(sizePtr)))
# undef Tcl_SplitList
# define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
? tclStubsPtr->tclSplitList((interp), (listStr), (argcPtr), (argvPtr)) \
: tclStubsPtr->tcl_SplitList((interp), (listStr), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
# undef Tcl_SplitPath
# define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
? tclStubsPtr->tclSplitPath((path), (argcPtr), (argvPtr)) \
: tclStubsPtr->tcl_SplitPath((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
# undef Tcl_FSSplitPath
# define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) == sizeof(int) \
? tclStubsPtr->tclFSSplitPath((pathPtr), (lenPtr)) \
: tclStubsPtr->tcl_FSSplitPath((pathPtr), (Tcl_Size *)(void *)(lenPtr)))
# undef Tcl_ParseArgsObjv
# define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) == sizeof(int) \
? tclStubsPtr->tclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) \
: tclStubsPtr->tcl_ParseArgsObjv((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv)))
#endif /* TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED) */
#else
# define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \
? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_UniCharToUtfDString \
@@ -4217,29 +4102,6 @@ extern const TclStubs *tclStubsPtr;
# define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \
? (Tcl_Size (*)(wchar_t *))Tcl_UniCharLen \
: (Tcl_Size (*)(wchar_t *))Tcl_Char16Len)
#if !defined(BUILD_tcl) && !defined(TCL_NO_DEPRECATED)
# define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \
? TclListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr)) \
: (Tcl_ListObjGetElements)((interp), (listPtr), (Tcl_Size *)(void *)(objcPtr), (objvPtr)))
# define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) == sizeof(int) \
? TclListObjLength((interp), (listPtr), (lengthPtr)) \
: (Tcl_ListObjLength)((interp), (listPtr), (Tcl_Size *)(void *)(lengthPtr)))
# define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) == sizeof(int) \
? TclDictObjSize((interp), (dictPtr), (sizePtr)) \
: (Tcl_DictObjSize)((interp), (dictPtr), (Tcl_Size *)(void *)(sizePtr)))
# define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
? TclSplitList((interp), (listStr), (argcPtr), (argvPtr)) \
: (Tcl_SplitList)((interp), (listStr), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
# define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
? TclSplitPath((path), (argcPtr), (argvPtr)) \
: (Tcl_SplitPath)((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
# define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) == sizeof(int) \
? TclFSSplitPath((pathPtr), (lenPtr)) \
: (Tcl_FSSplitPath)((pathPtr), (Tcl_Size *)(void *)(lenPtr)))
# define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) == sizeof(int) \
? TclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) \
: (Tcl_ParseArgsObjv)((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv)))
#endif /* !defined(BUILD_tcl) */
#endif
/*
@@ -4251,24 +4113,11 @@ extern const TclStubs *tclStubsPtr;
#define Tcl_GlobalEvalObj(interp, objPtr) \
Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)
#if TCL_MAJOR_VERSION > 8
# undef Tcl_Close
# define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)
#endif
# undef Tcl_Close
# define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)
#undef TclUtfCharComplete
#undef TclUtfNext
#undef TclUtfPrev
#ifndef TCL_NO_DEPRECATED
# define Tcl_CreateSlave Tcl_CreateChild
# define Tcl_GetSlave Tcl_GetChild
# define Tcl_GetMaster Tcl_GetParent
#endif
/* TIP #660 for 8.7 */
#if TCL_MAJOR_VERSION < 9
# undef Tcl_GetSizeIntFromObj
# define Tcl_GetSizeIntFromObj Tcl_GetIntFromObj
#endif
#endif /* _TCLDECLS */
+34 -200
View File
@@ -61,8 +61,6 @@ static Tcl_ObjCmdProc DictForNRCmd;
static Tcl_ObjCmdProc DictMapNRCmd;
static Tcl_NRPostProc DictForLoopCallback;
static Tcl_NRPostProc DictMapLoopCallback;
static Tcl_ObjTypeLengthProc DictAsListLength;
/* static Tcl_ObjTypeIndexProc DictAsListIndex; Needs rewrite */
/*
* Table of dict subcommand names and implementations.
@@ -145,25 +143,14 @@ typedef struct Dict {
const Tcl_ObjType tclDictType = {
"dict",
FreeDictInternalRep, /* freeIntRepProc */
DupDictInternalRep, /* dupIntRepProc */
UpdateStringOfDict, /* updateStringProc */
SetDictFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V2( /* Extended type for AbstractLists */
DictAsListLength, /* return "list" length of dict value w/o
* shimmering */
NULL, /* return key or value at "list" index
* location. (keysare at even indicies,
* values at odd indicies) */
NULL,
NULL,
NULL,
NULL,
NULL,
NULL)
FreeDictInternalRep, /* freeIntRepProc */
DupDictInternalRep, /* dupIntRepProc */
UpdateStringOfDict, /* updateStringProc */
SetDictFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V0
};
#define DictSetInternalRep(objPtr, dictRepPtr) \
#define DictSetIntRep(objPtr, dictRepPtr) \
do { \
Tcl_ObjInternalRep ir; \
ir.twoPtrValue.ptr1 = (dictRepPtr); \
@@ -409,7 +396,7 @@ DupDictInternalRep(
* Store in the object.
*/
DictSetInternalRep(copyPtr, newDict);
DictSetIntRep(copyPtr, newDict);
}
/*
@@ -616,7 +603,7 @@ SetDictFromAny(
* the conversion from lists to dictionaries.
*/
if (TclHasInternalRep(objPtr, &tclListType)) {
if (TclHasInternalRep(objPtr, tclListType)) {
Tcl_Size objc, i;
Tcl_Obj **objv;
@@ -724,7 +711,7 @@ SetDictFromAny(
dict->epoch = 1;
dict->chain = NULL;
dict->refCount = 1;
DictSetInternalRep(objPtr, dict);
DictSetIntRep(objPtr, dict);
return TCL_OK;
missingValue:
@@ -903,7 +890,7 @@ InvalidateDictChain(
dict->refCount++;
TclInvalidateStringRep(dictObj);
TclFreeInternalRep(dictObj);
DictSetInternalRep(dictObj, dict);
DictSetIntRep(dictObj, dict);
dict->epoch++;
dictObj = dict->chain;
@@ -958,7 +945,7 @@ Tcl_DictObjPut(
hPtr = CreateChainEntry(dict, keyPtr, &isNew);
dict->refCount++;
TclFreeInternalRep(dictPtr)
DictSetInternalRep(dictPtr, dict);
DictSetIntRep(dictPtr, dict);
Tcl_IncrRefCount(valuePtr);
if (!isNew) {
Tcl_Obj *oldValuePtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
@@ -1439,7 +1426,7 @@ Tcl_NewDictObj(void)
dict->epoch = 1;
dict->chain = NULL;
dict->refCount = 1;
DictSetInternalRep(dictPtr, dict);
DictSetIntRep(dictPtr, dict);
return dictPtr;
#endif
}
@@ -1487,7 +1474,7 @@ Tcl_DbNewDictObj(
dict->epoch = 1;
dict->chain = NULL;
dict->refCount = 1;
DictSetInternalRep(dictPtr, dict);
DictSetIntRep(dictPtr, dict);
return dictPtr;
}
#else /* !TCL_MEM_DEBUG */
@@ -1522,7 +1509,7 @@ Tcl_DbNewDictObj(
static int
DictCreateCmd(
TCL_UNUSED(void *),
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -1572,7 +1559,7 @@ DictCreateCmd(
static int
DictGetCmd(
TCL_UNUSED(void *),
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -1665,7 +1652,7 @@ DictGetCmd(
static int
DictGetDefCmd(
TCL_UNUSED(void *),
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -1730,7 +1717,7 @@ DictGetDefCmd(
static int
DictReplaceCmd(
TCL_UNUSED(void *),
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -1778,7 +1765,7 @@ DictReplaceCmd(
static int
DictRemoveCmd(
TCL_UNUSED(void *),
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -1826,7 +1813,7 @@ DictRemoveCmd(
static int
DictMergeCmd(
TCL_UNUSED(void *),
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -1913,7 +1900,7 @@ DictMergeCmd(
static int
DictKeysCmd(
TCL_UNUSED(void *),
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -1992,7 +1979,7 @@ DictKeysCmd(
static int
DictValuesCmd(
TCL_UNUSED(void *),
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -2052,7 +2039,7 @@ DictValuesCmd(
static int
DictSizeCmd(
TCL_UNUSED(void *),
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -2091,7 +2078,7 @@ DictSizeCmd(
static int
DictExistsCmd(
TCL_UNUSED(void *),
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -2133,7 +2120,7 @@ DictExistsCmd(
static int
DictInfoCmd(
TCL_UNUSED(void *),
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -2177,7 +2164,7 @@ DictInfoCmd(
static int
DictIncrCmd(
TCL_UNUSED(void *),
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -2298,7 +2285,7 @@ DictIncrCmd(
static int
DictLappendCmd(
TCL_UNUSED(void *),
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -2385,7 +2372,7 @@ DictLappendCmd(
static int
DictAppendCmd(
TCL_UNUSED(void *),
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -2487,7 +2474,7 @@ DictAppendCmd(
static int
DictForNRCmd(
TCL_UNUSED(void *),
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -2683,7 +2670,7 @@ DictForLoopCallback(
static int
DictMapNRCmd(
TCL_UNUSED(void *),
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -2896,7 +2883,7 @@ DictMapLoopCallback(
static int
DictSetCmd(
TCL_UNUSED(void *),
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -2956,7 +2943,7 @@ DictSetCmd(
static int
DictUnsetCmd(
TCL_UNUSED(void *),
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -3015,7 +3002,7 @@ DictUnsetCmd(
static int
DictFilterCmd(
TCL_UNUSED(void *),
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -3301,7 +3288,7 @@ DictFilterCmd(
static int
DictUpdateCmd(
TCL_UNUSED(void *),
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -3460,7 +3447,7 @@ FinalizeDictUpdate(
static int
DictWithCmd(
TCL_UNUSED(void *),
TCL_UNUSED(ClientData),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -3801,159 +3788,6 @@ TclInitDictCmd(
return TclMakeEnsemble(interp, "dict", implementationMap);
}
/*
*----------------------------------------------------------------------
*
* DictAsListLength --
*
* Compute the length of a list as if the dict value were converted to a
* list.
*
* Note: the list length may not match the dict size * 2. This occurs when
* there are duplicate keys in the original string representation.
*
* Side Effects --
*
* The intent is to have no side effects.
*/
static Tcl_Size
DictAsListLength(
Tcl_Obj *objPtr)
{
Tcl_Size estCount, length, llen;
const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);
Tcl_Obj *elemPtr;
/*
* Allocate enough space to hold a (Tcl_Obj *) for each
* (possible) list element.
*/
estCount = TclMaxListLength(nextElem, length, &limit);
estCount += (estCount == 0); /* Smallest list struct holds 1
* element. */
elemPtr = Tcl_NewObj();
llen = 0;
while (nextElem < limit) {
const char *elemStart;
char *check;
Tcl_Size elemSize;
int literal;
if (TCL_OK != TclFindElement(NULL, nextElem, limit - nextElem,
&elemStart, &nextElem, &elemSize, &literal)) {
Tcl_DecrRefCount(elemPtr);
return 0;
}
if (elemStart == limit) {
break;
}
TclInvalidateStringRep(elemPtr);
check = Tcl_InitStringRep(elemPtr, literal ? elemStart : NULL,
elemSize);
if (elemSize && check == NULL) {
Tcl_DecrRefCount(elemPtr);
return 0;
}
if (!literal) {
Tcl_InitStringRep(elemPtr, NULL,
TclCopyAndCollapse(elemSize, elemStart, check));
}
llen++;
}
Tcl_DecrRefCount(elemPtr);
return llen;
}
/*
*----------------------------------------------------------------------
*
* DictAsListIndex --
*
* Return the key or value at the given "list" index, i.e., as if the string
* value where treated as a list. The intent is to support this list
* operation w/o causing the Obj value to shimmer into a List.
*
* Side Effects --
*
* The intent is to have no side effects.
*
*/
#if 0 /* Needs rewrite */
static int
DictAsListIndex(
Tcl_Interp *interp,
struct Tcl_Obj *objPtr,
Tcl_Size index,
Tcl_Obj** elemObjPtr)
{
Tcl_Size /*estCount,*/ length, llen;
const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);
Tcl_Obj *elemPtr;
/*
* Compute limit of the list string
*/
TclMaxListLength(nextElem, length, &limit);
elemPtr = Tcl_NewObj();
llen = 0;
/*
* parse out each element until reaching the "index"th element.
* Sure this is slow, but shimmering is slower.
*/
while (nextElem < limit) {
const char *elemStart;
char *check;
Tcl_Size elemSize;
int literal;
if (TCL_OK != TclFindElement(NULL, nextElem, limit - nextElem,
&elemStart, &nextElem, &elemSize, &literal)) {
Tcl_DecrRefCount(elemPtr);
return 0;
}
if (elemStart == limit) {
break;
}
TclInvalidateStringRep(elemPtr);
check = Tcl_InitStringRep(elemPtr, literal ? elemStart : NULL,
elemSize);
if (elemSize && check == NULL) {
Tcl_DecrRefCount(elemPtr);
if (interp) {
// Need error message here
}
return TCL_ERROR;
}
if (!literal) {
Tcl_InitStringRep(elemPtr, NULL,
TclCopyAndCollapse(elemSize, elemStart, check));
}
if (llen == index) {
*elemObjPtr = elemPtr;
return TCL_OK;
}
llen++;
}
/*
* Index is beyond end of list - return empty
*/
Tcl_InitStringRep(elemPtr, NULL, 0);
*elemObjPtr = elemPtr;
return TCL_OK;
}
#endif
/*
* Local Variables:
* mode: c
+23 -24
View File
@@ -256,8 +256,7 @@ DisassembleByteCodeObj(
unsigned char *codeStart, *codeLimit, *pc;
unsigned char *codeDeltaNext, *codeLengthNext;
unsigned char *srcDeltaNext, *srcLengthNext;
int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, line;
Tcl_Size i;
int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line;
Interp *iPtr;
Tcl_Obj *bufferObj, *fileObj;
@@ -279,7 +278,7 @@ DisassembleByteCodeObj(
*/
Tcl_AppendPrintfToObj(bufferObj,
"ByteCode %p, refCt %" TCL_SIZE_MODIFIER "u, epoch %" TCL_SIZE_MODIFIER "u, interp %p (epoch %" TCL_SIZE_MODIFIER "u)\n",
"ByteCode %p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp %p (epoch %" TCL_Z_MODIFIER "u)\n",
codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch);
Tcl_AppendToObj(bufferObj, " Source ", -1);
PrintSourceToObj(bufferObj, codePtr->source,
@@ -290,7 +289,7 @@ DisassembleByteCodeObj(
TclGetString(fileObj), line);
}
Tcl_AppendPrintfToObj(bufferObj,
"\n Cmds %d, src %" TCL_SIZE_MODIFIER "u, inst %" TCL_SIZE_MODIFIER "u, litObjs %" TCL_SIZE_MODIFIER "u, aux %" TCL_SIZE_MODIFIER "u, stkDepth %" TCL_SIZE_MODIFIER "u, code/src %.2f\n",
"\n Cmds %d, src %" TCL_Z_MODIFIER "u, inst %" TCL_Z_MODIFIER "u, litObjs %" TCL_Z_MODIFIER "u, aux %" TCL_Z_MODIFIER "u, stkDepth %" TCL_Z_MODIFIER "u, code/src %.2f\n",
numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
codePtr->numLitObjects, codePtr->numAuxDataItems,
codePtr->maxStackDepth,
@@ -302,8 +301,8 @@ DisassembleByteCodeObj(
#ifdef TCL_COMPILE_STATS
Tcl_AppendPrintfToObj(bufferObj,
" Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_SIZE_MODIFIER "u+litObj %"
TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_SIZE_MODIFIER "u\n",
" Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_Z_MODIFIER "u+litObj %"
TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_Z_MODIFIER "u\n",
codePtr->structureSize,
offsetof(ByteCode, localCachePtr),
codePtr->numCodeBytes,
@@ -321,10 +320,10 @@ DisassembleByteCodeObj(
if (codePtr->procPtr != NULL) {
Proc *procPtr = codePtr->procPtr;
Tcl_Size numCompiledLocals = procPtr->numCompiledLocals;
int numCompiledLocals = procPtr->numCompiledLocals;
Tcl_AppendPrintfToObj(bufferObj,
" Proc %p, refCt %" TCL_SIZE_MODIFIER "u, args %" TCL_SIZE_MODIFIER "u, compiled locals %" TCL_SIZE_MODIFIER "u\n",
" Proc %p, refCt %" TCL_Z_MODIFIER "u, args %" TCL_Z_MODIFIER "u, compiled locals %d\n",
procPtr, procPtr->refCount, procPtr->numArgs,
numCompiledLocals);
if (numCompiledLocals > 0) {
@@ -332,7 +331,7 @@ DisassembleByteCodeObj(
for (i = 0; i < numCompiledLocals; i++) {
Tcl_AppendPrintfToObj(bufferObj,
" slot %" TCL_SIZE_MODIFIER "u%s%s%s%s%s%s", i,
" slot %d%s%s%s%s%s%s", i,
(localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar",
(localPtr->flags & VAR_ARRAY) ? ", array" : "",
(localPtr->flags & VAR_LINK) ? ", link" : "",
@@ -355,24 +354,24 @@ DisassembleByteCodeObj(
*/
if ((int)codePtr->numExceptRanges > 0) {
Tcl_AppendPrintfToObj(bufferObj, " Exception ranges %" TCL_SIZE_MODIFIER "u, depth %" TCL_SIZE_MODIFIER "u:\n",
Tcl_AppendPrintfToObj(bufferObj, " Exception ranges %" TCL_Z_MODIFIER "u, depth %" TCL_Z_MODIFIER "u:\n",
codePtr->numExceptRanges, codePtr->maxExceptDepth);
for (i = 0; i < (int)codePtr->numExceptRanges; i++) {
ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];
Tcl_AppendPrintfToObj(bufferObj,
" %" TCL_SIZE_MODIFIER "u: level %" TCL_SIZE_MODIFIER "u, %s, pc %" TCL_SIZE_MODIFIER "u-%" TCL_SIZE_MODIFIER "u, ",
" %d: level %" TCL_Z_MODIFIER "u, %s, pc %" TCL_Z_MODIFIER "u-%" TCL_Z_MODIFIER "u, ",
i, rangePtr->nestingLevel,
(rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"),
rangePtr->codeOffset,
(rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
switch (rangePtr->type) {
case LOOP_EXCEPTION_RANGE:
Tcl_AppendPrintfToObj(bufferObj, "continue %" TCL_SIZE_MODIFIER "u, break %" TCL_SIZE_MODIFIER "u\n",
Tcl_AppendPrintfToObj(bufferObj, "continue %" TCL_Z_MODIFIER "u, break %" TCL_Z_MODIFIER "u\n",
rangePtr->continueOffset, rangePtr->breakOffset);
break;
case CATCH_EXCEPTION_RANGE:
Tcl_AppendPrintfToObj(bufferObj, "catch %" TCL_SIZE_MODIFIER "u\n",
Tcl_AppendPrintfToObj(bufferObj, "catch %" TCL_Z_MODIFIER "u\n",
rangePtr->catchOffset);
break;
default:
@@ -446,7 +445,7 @@ DisassembleByteCodeObj(
srcLengthNext++;
}
Tcl_AppendPrintfToObj(bufferObj, "%s%4" TCL_SIZE_MODIFIER "u: pc %d-%d, src %d-%d",
Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d",
((i % 2)? " " : "\n "),
(i+1), codeOffset, (codeOffset + codeLen - 1),
srcOffset, (srcOffset + srcLen - 1));
@@ -505,7 +504,7 @@ DisassembleByteCodeObj(
pc += FormatInstruction(codePtr, pc, bufferObj);
}
Tcl_AppendPrintfToObj(bufferObj, " Command %" TCL_SIZE_MODIFIER "u: ", i+1);
Tcl_AppendPrintfToObj(bufferObj, " Command %d: ", i+1);
PrintSourceToObj(bufferObj, (codePtr->source + srcOffset),
TclMin(srcLen, 55));
Tcl_AppendToObj(bufferObj, "\n", -1);
@@ -545,7 +544,7 @@ FormatInstruction(
unsigned char *codeStart = codePtr->codeStart;
unsigned pcOffset = pc - codeStart;
int opnd = 0, i, j, numBytes = 1;
Tcl_Size localCt = procPtr ? procPtr->numCompiledLocals : 0;
int localCt = procPtr ? (int)procPtr->numCompiledLocals : 0;
CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL;
char suffixBuffer[128]; /* Additional info to print after main opcode
* and immediates. */
@@ -626,7 +625,7 @@ FormatInstruction(
printLVTindex:
if (localPtr != NULL) {
if (opnd >= localCt) {
Tcl_Panic("FormatInstruction: bad local var index %u (%" TCL_SIZE_MODIFIER "u locals)",
Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)",
opnd, localCt);
}
for (j = 0; j < opnd; j++) {
@@ -876,7 +875,7 @@ PrintSourceToObj(
for (; (*p != '\0') && (i < maxChars); p+=len) {
int ucs4;
len = TclUtfToUCS4(p, &ucs4);
len = Tcl_UtfToUniChar(p, &ucs4);
switch (ucs4) {
case '"':
Tcl_AppendToObj(appendObj, "\\\"", -1);
@@ -944,8 +943,8 @@ DisassembleByteCodeAsDicts(
Tcl_Obj *description, *literals, *variables, *instructions, *inst;
Tcl_Obj *aux, *exn, *commands, *file;
unsigned char *pc, *opnd, *codeOffPtr, *codeLenPtr, *srcOffPtr, *srcLenPtr;
int codeOffset, codeLength, sourceOffset, sourceLength, val, line;
Tcl_Size i;
int codeOffset, codeLength, sourceOffset, sourceLength;
int i, val, line;
ByteCodeGetInternalRep(objPtr, &tclByteCodeType, codePtr);
@@ -954,7 +953,7 @@ DisassembleByteCodeAsDicts(
*/
TclNewObj(literals);
for (i=0 ; i<codePtr->numLitObjects ; i++) {
for (i=0 ; i<(int)codePtr->numLitObjects ; i++) {
Tcl_ListObjAppendElement(NULL, literals, codePtr->objArrayPtr[i]);
}
@@ -964,7 +963,7 @@ DisassembleByteCodeAsDicts(
TclNewObj(variables);
if (codePtr->procPtr) {
Tcl_Size localCount = codePtr->procPtr->numCompiledLocals;
int localCount = codePtr->procPtr->numCompiledLocals;
CompiledLocal *localPtr = codePtr->procPtr->firstLocalPtr;
for (i=0 ; i<localCount ; i++,localPtr=localPtr->nextPtr) {
@@ -1147,14 +1146,14 @@ DisassembleByteCodeAsDicts(
switch (rangePtr->type) {
case LOOP_EXCEPTION_RANGE:
Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
"type %s level %" TCL_SIZE_MODIFIER "u from %" TCL_SIZE_MODIFIER "u to %" TCL_SIZE_MODIFIER "u break %" TCL_SIZE_MODIFIER "u continue %" TCL_SIZE_MODIFIER "u",
"type %s level %" TCL_Z_MODIFIER "u from %" TCL_Z_MODIFIER "u to %" TCL_Z_MODIFIER "u break %" TCL_Z_MODIFIER "u continue %" TCL_Z_MODIFIER "u",
"loop", rangePtr->nestingLevel, rangePtr->codeOffset,
rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
rangePtr->breakOffset, rangePtr->continueOffset));
break;
case CATCH_EXCEPTION_RANGE:
Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
"type %s level %" TCL_SIZE_MODIFIER "u from %" TCL_SIZE_MODIFIER "u to %" TCL_SIZE_MODIFIER "u catch %" TCL_SIZE_MODIFIER "u",
"type %s level %" TCL_Z_MODIFIER "u from %" TCL_Z_MODIFIER "u to %" TCL_Z_MODIFIER "u catch %" TCL_Z_MODIFIER "u",
"catch", rangePtr->nestingLevel, rangePtr->codeOffset,
rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
rangePtr->catchOffset));
+38 -207
View File
@@ -10,7 +10,6 @@
*/
#include "tclInt.h"
#include <assert.h>
typedef size_t (LengthProc)(const char *src);
@@ -186,7 +185,6 @@ TCL_DECLARE_MUTEX(encodingMutex)
static Tcl_Encoding defaultEncoding = NULL;
static Tcl_Encoding systemEncoding = NULL;
Tcl_Encoding tclIdentityEncoding = NULL;
Tcl_Encoding tclUtf8Encoding = NULL;
/*
* Names of encoding profiles and corresponding integer values.
@@ -573,8 +571,8 @@ TclInitEncodingSubsystem(void)
unsigned size;
unsigned short i;
union {
char c;
short s;
char c;
short s;
} isLe;
int leFlags;
@@ -610,7 +608,7 @@ TclInitEncodingSubsystem(void)
type.freeProc = NULL;
type.nullSize = 1;
type.clientData = INT2PTR(ENCODING_UTF);
tclUtf8Encoding = Tcl_CreateEncoding(&type);
Tcl_CreateEncoding(&type);
type.clientData = NULL;
type.encodingName = "cesu-8";
Tcl_CreateEncoding(&type);
@@ -657,11 +655,6 @@ TclInitEncodingSubsystem(void)
type.clientData = INT2PTR(leFlags);
Tcl_CreateEncoding(&type);
#ifndef TCL_NO_DEPRECATED
type.encodingName = "unicode";
Tcl_CreateEncoding(&type);
#endif
/*
* Need the iso8859-1 encoding in order to process binary data, so force
* it to always be embedded. Note that this encoding *must* be a proper
@@ -732,8 +725,6 @@ TclFinalizeEncodingSubsystem(void)
defaultEncoding = NULL;
FreeEncoding(tclIdentityEncoding);
tclIdentityEncoding = NULL;
FreeEncoding(tclUtf8Encoding);
tclUtf8Encoding = NULL;
hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
while (hPtr != NULL) {
@@ -1158,7 +1149,7 @@ Tcl_ExternalToUtfDString(
* converted string is stored. */
{
Tcl_ExternalToUtfDStringEx(
NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_TCL8, dstPtr, NULL);
NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_STRICT, dstPtr, NULL);
return Tcl_DStringValue(dstPtr);
}
@@ -1238,7 +1229,6 @@ Tcl_ExternalToUtfDStringEx(
"Parameter error: TCL_ENCODING_{START,STOP} bits set in flags.",
TCL_INDEX_NONE));
Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALFLAGS", NULL);
errno = EINVAL;
return TCL_ERROR;
}
@@ -1303,20 +1293,17 @@ Tcl_ExternalToUtfDStringEx(
/* Caller wants error message on failure */
if (result != TCL_OK && interp != NULL) {
char buf[TCL_INTEGER_SPACE];
snprintf(buf, sizeof(buf), "%" TCL_SIZE_MODIFIER "u", nBytesProcessed);
snprintf(buf, sizeof(buf), "%" TCL_Z_MODIFIER "u", nBytesProcessed);
Tcl_SetObjResult(
interp,
Tcl_ObjPrintf("unexpected byte sequence starting at index %"
TCL_SIZE_MODIFIER "u: '\\x%02X'",
TCL_Z_MODIFIER "u: '\\x%02X'",
nBytesProcessed,
UCHAR(srcStart[nBytesProcessed])));
Tcl_SetErrorCode(
interp, "TCL", "ENCODING", "ILLEGALSEQUENCE", buf, NULL);
}
}
if (result != TCL_OK) {
errno = (result == TCL_CONVERT_NOSPACE) ? ENOMEM : EILSEQ;
}
return result;
}
@@ -1507,7 +1494,7 @@ Tcl_UtfToExternalDString(
* The parameter flags controls the behavior, if any of the bytes in
* the source buffer are invalid or cannot be represented in the
* target encoding. It should be composed by OR-ing the following:
* - *At most one* of TCL_ENCODING_PROFILE_*
* - *At most one* of TCL_ENCODING_PROFILE{DEFAULT,TCL8,STRICT}
* - TCL_ENCODING_STOPONERROR: Backward compatibility. Sets the profile
* to TCL_ENCODING_PROFILE_STRICT overriding any specified profile flags
*
@@ -1570,7 +1557,6 @@ Tcl_UtfToExternalDStringEx(
"Parameter error: TCL_ENCODING_{START,STOP} bits set in flags.",
TCL_INDEX_NONE));
Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALFLAGS", NULL);
errno = EINVAL;
return TCL_ERROR;
}
@@ -1637,12 +1623,12 @@ Tcl_UtfToExternalDStringEx(
Tcl_Size pos = Tcl_NumUtfChars(srcStart, nBytesProcessed);
int ucs4;
char buf[TCL_INTEGER_SPACE];
TclUtfToUCS4(&srcStart[nBytesProcessed], &ucs4);
snprintf(buf, sizeof(buf), "%" TCL_SIZE_MODIFIER "u", nBytesProcessed);
Tcl_UtfToUniChar(&srcStart[nBytesProcessed], &ucs4);
snprintf(buf, sizeof(buf), "%" TCL_Z_MODIFIER "u", nBytesProcessed);
Tcl_SetObjResult(
interp,
Tcl_ObjPrintf(
"unexpected character at index %" TCL_SIZE_MODIFIER
"unexpected character at index %" TCL_Z_MODIFIER
"u: 'U+%06X'",
pos,
ucs4));
@@ -1650,9 +1636,6 @@ Tcl_UtfToExternalDStringEx(
buf, NULL);
}
}
if (result != TCL_OK) {
errno = (result == TCL_CONVERT_NOSPACE) ? ENOMEM : EILSEQ;
}
return result;
}
@@ -2543,16 +2526,6 @@ UtfToUtfProc(
flags |= PTR2INT(clientData);
dstEnd = dst + dstLen - ((flags & ENCODING_UTF) ? TCL_UTF_MAX : 6);
#if TCL_UTF_MAX < 4
/* Initialize the buffer so that some random data doesn't trick
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
* prior non-stateful nature, this call to memset can also be removed.
*/
memset(dst, 0xff, dstLen);
#endif
profile = ENCODING_PROFILE_GET(flags);
for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
@@ -2600,10 +2573,10 @@ UtfToUtfProc(
} else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
/*
* Incomplete byte sequence.
* Always check before using TclUtfToUCS4. Not doing so can cause it
* run beyond the end of the buffer! If we happen on such an incomplete
* char its bytes are made to represent themselves unless the user has
* explicitly asked to be told.
* Always check before using Tcl_UtfToUniChar. Not doing can so cause
* it to run beyond the end of the buffer! If we happen such an
* incomplete char its bytes are made to represent themselves
* unless the user has explicitly asked to be told.
*/
if (flags & ENCODING_INPUT) {
@@ -2622,12 +2595,12 @@ UtfToUtfProc(
/* TCL_ENCODING_PROFILE_TCL8 */
char chbuf[2];
chbuf[0] = UCHAR(*src++); chbuf[1] = 0;
TclUtfToUCS4(chbuf, &ch);
Tcl_UtfToUniChar(chbuf, &ch);
}
dst += Tcl_UniCharToUtf(ch, dst);
} else {
int isInvalid = 0;
size_t len = TclUtfToUCS4(src, &ch);
size_t len = Tcl_UtfToUniChar(src, &ch);
if (flags & ENCODING_INPUT) {
if ((len < 2) && (ch != 0)) {
isInvalid = 1;
@@ -2655,44 +2628,10 @@ UtfToUtfProc(
*dst++ = (char) (((ch >> 10) & 0x3F) | 0x80);
ch = (ch & 0x0CFF) | 0xDC00;
}
#if TCL_UTF_MAX < 4
cesu8:
#endif
*dst++ = (char) (((ch >> 12) | 0xE0) & 0xEF);
*dst++ = (char) (((ch >> 6) | 0x80) & 0xBF);
*dst++ = (char) ((ch | 0x80) & 0xBF);
continue;
#if TCL_UTF_MAX < 4
} else if (SURROGATE(ch)) {
/*
* A surrogate character is detected, handle especially.
*/
if (PROFILE_STRICT(profile) && (flags & ENCODING_UTF)) {
result = TCL_CONVERT_UNKNOWN;
src = saveSrc;
break;
}
if (PROFILE_REPLACE(profile)) {
/* TODO - is this right for cesu8 or should we fall through below? */
ch = UNICODE_REPLACE_CHAR;
} else {
int low = ch;
len = (src <= srcEnd - 3) ? TclUtfToUCS4(src, &low) : 0;
if ((!LOW_SURROGATE(low)) || (ch & 0x400)) {
if (PROFILE_STRICT(profile)) {
result = TCL_CONVERT_UNKNOWN;
src = saveSrc;
break;
}
goto cesu8;
}
src += len;
dst += Tcl_UniCharToUtf(ch, dst);
ch = low;
}
#endif
} else if (PROFILE_STRICT(profile) &&
(!(flags & ENCODING_INPUT)) &&
SURROGATE(ch)) {
@@ -2767,15 +2706,6 @@ Utf32ToUtfProc(
}
result = TCL_OK;
#if TCL_UTF_MAX < 4
/* Initialize the buffer so that some random data doesn't trick
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
* prior non-stateful nature, this call to memset can also be removed.
*/
memset(dst, 0xff, dstLen);
#endif
/*
* Check alignment with utf-32 (4 == sizeof(UTF-32))
*/
@@ -2785,21 +2715,6 @@ Utf32ToUtfProc(
srcLen -= bytesLeft;
}
#if TCL_UTF_MAX < 4
/*
* If last code point is a high surrogate, we cannot handle that yet,
* unless we are at the end.
*/
if (!(flags & TCL_ENCODING_END) && (srcLen >= 4) &&
((src[srcLen - ((flags & TCL_ENCODING_LE)?3:2)] & 0xFC) == 0xD8) &&
((src[srcLen - ((flags & TCL_ENCODING_LE)?2:3)]) == 0) &&
((src[srcLen - ((flags & TCL_ENCODING_LE)?1:4)]) == 0)) {
result = TCL_CONVERT_MULTIBYTE;
srcLen-= 4;
}
#endif
srcStart = src;
srcEnd = src + srcLen;
@@ -2812,20 +2727,11 @@ Utf32ToUtfProc(
break;
}
#if TCL_UTF_MAX < 4
int prev = ch;
#endif
if (flags & TCL_ENCODING_LE) {
ch = (unsigned int)(src[3] & 0xFF) << 24 | (src[2] & 0xFF) << 16 | (src[1] & 0xFF) << 8 | (src[0] & 0xFF);
} else {
ch = (unsigned int)(src[0] & 0xFF) << 24 | (src[1] & 0xFF) << 16 | (src[2] & 0xFF) << 8 | (src[3] & 0xFF);
}
#if TCL_UTF_MAX < 4
if (HIGH_SURROGATE(prev) && !LOW_SURROGATE(ch)) {
/* Bug [10c2c17c32]. If Hi surrogate not followed by Lo surrogate, finish 3-byte UTF-8 */
dst += Tcl_UniCharToUtf(-1, dst);
}
#endif
if ((unsigned)ch > 0x10FFFF) {
ch = UNICODE_REPLACE_CHAR;
@@ -2835,9 +2741,6 @@ Utf32ToUtfProc(
}
} else if (PROFILE_STRICT(flags) && SURROGATE(ch)) {
result = TCL_CONVERT_SYNTAX;
#if TCL_UTF_MAX < 4
ch = 0;
#endif
break;
} else if (PROFILE_REPLACE(flags) && SURROGATE(ch)) {
ch = UNICODE_REPLACE_CHAR;
@@ -2851,11 +2754,6 @@ Utf32ToUtfProc(
if ((unsigned)ch - 1 < 0x7F) {
*dst++ = (ch & 0xFF);
} else {
#if TCL_UTF_MAX < 4
if (!HIGH_SURROGATE(prev) && LOW_SURROGATE(ch)) {
*dst = 0; /* In case of lower surrogate, don't try to combine */
}
#endif
dst += Tcl_UniCharToUtf(ch, dst);
}
src += 4;
@@ -2865,13 +2763,6 @@ Utf32ToUtfProc(
* If we had a truncated code unit at the end AND this is the last
* fragment AND profile is not "strict", stick FFFD in its place.
*/
#if TCL_UTF_MAX < 4
if (HIGH_SURROGATE(ch)) {
/* Bug [10c2c17c32]. If Hi surrogate, finish 3-byte UTF-8 */
dst += Tcl_UniCharToUtf(-1, dst);
}
#endif
if ((flags & TCL_ENCODING_END) && (result == TCL_CONVERT_MULTIBYTE)) {
if (dst > dstEnd) {
result = TCL_CONVERT_NOSPACE;
@@ -2964,7 +2855,7 @@ UtfToUtf32Proc(
result = TCL_CONVERT_NOSPACE;
break;
}
len = TclUtfToUCS4(src, &ch);
len = Tcl_UtfToUniChar(src, &ch);
if (SURROGATE(ch)) {
if (PROFILE_STRICT(flags)) {
result = TCL_CONVERT_UNKNOWN;
@@ -3045,15 +2936,6 @@ Utf16ToUtfProc(
}
result = TCL_OK;
#if TCL_UTF_MAX < 4
/* Initialize the buffer so that some random data doesn't trick
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
* prior non-stateful nature, this call to memset can also be removed.
*/
memset(dst, 0xff, dstLen);
#endif
/*
* Check alignment with utf-16 (2 == sizeof(UTF-16))
*/
@@ -3234,7 +3116,7 @@ UtfToUtf16Proc(
}
dstStart = dst;
dstEnd = dst + dstLen - 2; /* 2 -> sizeof a UTF-16 code unit */
dstEnd = dst + dstLen - sizeof(Tcl_UniChar);
flags |= PTR2INT(clientData);
result = TCL_OK;
@@ -3252,7 +3134,7 @@ UtfToUtf16Proc(
result = TCL_CONVERT_NOSPACE;
break;
}
len = TclUtfToUCS4(src, &ch);
len = Tcl_UtfToUniChar(src, &ch);
if (SURROGATE(ch)) {
if (PROFILE_STRICT(flags)) {
result = TCL_CONVERT_UNKNOWN;
@@ -3344,7 +3226,7 @@ UtfToUcs2Proc(
}
dstStart = dst;
dstEnd = dst + dstLen - 2; /* 2 - size of UCS code unit */
dstEnd = dst + dstLen - sizeof(Tcl_UniChar);
result = TCL_OK;
for (numChars = 0; src < srcEnd; numChars++) {
@@ -3361,18 +3243,7 @@ UtfToUcs2Proc(
result = TCL_CONVERT_NOSPACE;
break;
}
#if TCL_UTF_MAX < 4
len = TclUtfToUniChar(src, &ch);
if ((ch >= 0xD800) && (len < 3)) {
if (PROFILE_STRICT(flags)) {
result = TCL_CONVERT_UNKNOWN;
break;
}
src += len;
src += TclUtfToUniChar(src, &ch);
ch = UNICODE_REPLACE_CHAR;
}
#else
len = TclUtfToUniChar(src, &ch);
if (ch > 0xFFFF) {
if (PROFILE_STRICT(flags)) {
@@ -3381,7 +3252,6 @@ UtfToUcs2Proc(
}
ch = UNICODE_REPLACE_CHAR;
}
#endif
if (PROFILE_STRICT(flags) && SURROGATE(ch)) {
result = TCL_CONVERT_SYNTAX;
break;
@@ -3467,15 +3337,6 @@ TableToUtfProc(
dstStart = dst;
dstEnd = dst + dstLen - TCL_UTF_MAX;
#if TCL_UTF_MAX < 4
/* Initialize the buffer so that some random data doesn't trick
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
* prior non-stateful nature, this call to memset can also be removed.
*/
memset(dst, 0xff, dstLen);
#endif
toUnicode = (const unsigned short *const *) dataPtr->toUnicode;
prefixBytes = dataPtr->prefixBytes;
pageZero = toUnicode[0];
@@ -3488,28 +3349,30 @@ TableToUtfProc(
}
byte = *((unsigned char *) src);
if (prefixBytes[byte]) {
if (src >= srcEnd-1) {
/* Prefix byte but nothing after it */
src++;
if (src >= srcEnd) {
if (!(flags & TCL_ENCODING_END)) {
/* More data to come */
src--;
result = TCL_CONVERT_MULTIBYTE;
break;
} else if (PROFILE_STRICT(flags)) {
src--;
result = TCL_CONVERT_SYNTAX;
break;
} else if (PROFILE_REPLACE(flags)) {
ch = UNICODE_REPLACE_CHAR;
} else {
ch = (Tcl_UniChar)byte;
src--; /* See bug [bdcb5126c0] */
result = TCL_CONVERT_MULTIBYTE;
break;
}
} else {
ch = toUnicode[byte][*((unsigned char *)++src)];
ch = toUnicode[byte][*((unsigned char *)src)];
}
} else {
ch = pageZero[byte];
}
if ((ch == 0) && (byte != 0)) {
/* Prefix+suffix pair is invalid */
if (PROFILE_STRICT(flags)) {
result = TCL_CONVERT_SYNTAX;
break;
@@ -3536,7 +3399,6 @@ TableToUtfProc(
src++;
}
assert(src <= srcEnd);
*srcReadPtr = src - srcStart;
*dstWrotePtr = dst - dstStart;
*dstCharsPtr = numChars;
@@ -3619,17 +3481,12 @@ TableFromUtfProc(
}
len = TclUtfToUniChar(src, &ch);
#if TCL_UTF_MAX > 3
/* Unicode chars > +U0FFFF cannot be represented in any table encoding */
if (ch & 0xFFFF0000) {
word = 0;
} else
#else
if (!len) {
word = 0;
} else
#endif
} else {
word = fromUnicode[(ch >> 8)][ch & 0xFF];
}
if ((word == 0) && (ch != 0)) {
if (PROFILE_STRICT(flags)) {
@@ -3716,15 +3573,6 @@ Iso88591ToUtfProc(
dstStart = dst;
dstEnd = dst + dstLen - TCL_UTF_MAX;
#if TCL_UTF_MAX < 4
/* Initialize the buffer so that some random data doesn't trick
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
* prior non-stateful nature, this call to memset can also be removed.
*/
memset(dst, 0xff, dstLen);
#endif
result = TCL_OK;
for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
Tcl_UniChar ch = 0;
@@ -3826,24 +3674,14 @@ Iso88591FromUtfProc(
* Check for illegal characters.
*/
if (ch > 0xFF
#if TCL_UTF_MAX < 4
|| ((ch >= 0xD800) && (len < 3))
#endif
) {
if (ch > 0xFF) {
if (PROFILE_STRICT(flags)) {
result = TCL_CONVERT_UNKNOWN;
break;
}
#if TCL_UTF_MAX < 4
if ((ch >= 0xD800) && (len < 3)) {
len = 4;
}
#endif
/*
* Plunge on, using '?' as a fallback character.
*/
ch = (Tcl_UniChar) '?'; /* Profiles TCL8 and REPLACE */
}
@@ -3964,15 +3802,6 @@ EscapeToUtfProc(
dstStart = dst;
dstEnd = dst + dstLen - TCL_UTF_MAX;
#if TCL_UTF_MAX < 4
/* Initialize the buffer so that some random data doesn't trick
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
* prior non-stateful nature, this call to memset can also be removed.
*/
memset(dst, 0xff, dstLen);
#endif
state = PTR2INT(*statePtr);
if (flags & TCL_ENCODING_START) {
state = 0;
@@ -4069,10 +3898,12 @@ EscapeToUtfProc(
if ((checked == dataPtr->numSubTables + 2)
|| (flags & TCL_ENCODING_END)) {
if (!PROFILE_STRICT(flags)) {
unsigned skip = longest > left ? left : longest;
/* Unknown escape sequence */
dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst);
src += skip;
/*
* Skip the unknown escape sequence. TODO - bug?
* May be replace with UNICODE_REPLACE_CHAR?
*/
src += longest;
continue;
}
result = TCL_CONVERT_SYNTAX;
+39 -10
View File
@@ -312,7 +312,17 @@ TclNamespaceEnsembleCmd(
Tcl_AppendObjToObj(newCmd, listv[0]);
Tcl_ListObjReplace(NULL, newList, 0, 1, 1, &newCmd);
if (patchedDict == NULL) {
patchedDict = Tcl_DuplicateObj(objv[1]);
patchedDict = TclDuplicatePureObj(
interp, objv[1], &tclDictType);
if (!patchedDict) {
if (allocatedMapFlag) {
Tcl_DecrRefCount(mapObj);
}
Tcl_DecrRefCount(newList);
Tcl_DecrRefCount(newCmd);
Tcl_DecrRefCount(patchedDict);
return TCL_ERROR;
}
}
Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
newList);
@@ -596,7 +606,14 @@ TclNamespaceEnsembleCmd(
}
cmd = TclGetString(listv[0]);
if (!(cmd[0] == ':' && cmd[1] == ':')) {
Tcl_Obj *newList = Tcl_DuplicateObj(listObj);
Tcl_Obj *newList = TclDuplicatePureObj(
interp, listObj, tclListType);
if (!newList) {
if (patchedDict) {
Tcl_DecrRefCount(patchedDict);
}
goto freeMapAndError;
}
Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace*)nsPtr);
if (nsPtr->parentPtr) {
@@ -606,7 +623,11 @@ TclNamespaceEnsembleCmd(
Tcl_ListObjReplace(NULL, newList, 0, 1, 1,
&newCmd);
if (patchedDict == NULL) {
patchedDict = Tcl_DuplicateObj(objv[1]);
patchedDict = TclDuplicatePureObj(
interp, objv[1], tclListType);
if (!patchedDict) {
goto freeMapAndError;
}
}
Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
newList);
@@ -1904,7 +1925,11 @@ NsEnsembleImplementationCmdNR(
TclListObjLengthM(NULL, prefixObj, &prefixObjc);
if (objc == 2) {
copyPtr = TclListObjCopy(NULL, prefixObj);
copyPtr = TclDuplicatePureObj(
interp, prefixObj, tclListType);
if (!copyPtr) {
return TCL_ERROR;
}
} else {
copyPtr = Tcl_NewListObj(objc - 2 + prefixObjc, NULL);
Tcl_ListObjAppendList(NULL, copyPtr, prefixObj);
@@ -2304,7 +2329,11 @@ EnsembleUnknownCallback(
* Create the "unknown" command callback to determine what to do.
*/
unknownCmd = Tcl_DuplicateObj(ensemblePtr->unknownHandler);
unknownCmd = TclDuplicatePureObj(
interp, ensemblePtr->unknownHandler, tclListType);
if (!unknownCmd) {
return TCL_ERROR;
}
TclNewObj(ensObj);
Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj);
Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj);
@@ -3264,7 +3293,7 @@ TclAttemptCompileProc(
Tcl_Size i;
Tcl_Token *saveTokenPtr = parsePtr->tokenPtr;
Tcl_Size savedStackDepth = envPtr->currStackDepth;
Tcl_Size savedCodeNext = envPtr->codeNext - envPtr->codeStart;
unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart;
Tcl_Size savedAuxDataArrayNext = envPtr->auxDataArrayNext;
Tcl_Size savedExceptArrayNext = envPtr->exceptArrayNext;
#ifdef TCL_COMPILE_DEBUG
@@ -3327,13 +3356,13 @@ TclAttemptCompileProc(
ExceptionAux *auxPtr = envPtr->exceptAuxArrayPtr;
for (i = 0; i < savedExceptArrayNext; i++) {
while (auxPtr->numBreakTargets > 0
&& (Tcl_Size) auxPtr->breakTargets[auxPtr->numBreakTargets - 1]
while ((int)auxPtr->numBreakTargets > 0
&& auxPtr->breakTargets[auxPtr->numBreakTargets - 1]
>= savedCodeNext) {
auxPtr->numBreakTargets--;
}
while (auxPtr->numContinueTargets > 0
&& (Tcl_Size) auxPtr->continueTargets[auxPtr->numContinueTargets - 1]
while ((int)auxPtr->numContinueTargets > 0
&& auxPtr->continueTargets[auxPtr->numContinueTargets - 1]
>= savedCodeNext) {
auxPtr->numContinueTargets--;
}
+27 -43
View File
@@ -19,20 +19,20 @@ TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */
#if defined(_WIN32)
# define tenviron _wenviron
# define tenviron2utfdstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \
(char *)Tcl_Char16ToUtfDString((const unsigned short *)(str), -1, (dsPtr)))
# define utf2tenvirondstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \
(const WCHAR *)Tcl_UtfToChar16DString((str), -1, (dsPtr)))
# define tenviron2utfdstr(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \
(char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr)))
# define utf2tenvirondstr(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \
(const WCHAR *)Tcl_UtfToChar16DString((string), (len), (dsPtr)))
# define techar WCHAR
# ifdef USE_PUTENV
# define putenv(env) _wputenv((const wchar_t *)env)
# endif
#else
# define tenviron environ
# define tenviron2utfdstr(str, dsPtr) \
Tcl_ExternalToUtfDString(NULL, str, -1, dsPtr)
# define utf2tenvirondstr(str, dsPtr) \
Tcl_UtfToExternalDString(NULL, str, -1, dsPtr)
# define tenviron2utfdstr(tenvstr, len, dstr) \
Tcl_ExternalToUtfDString(NULL, tenvstr, len, dstr)
# define utf2tenvirondstr(str, len, dstr) \
Tcl_UtfToExternalDString(NULL, str, len, dstr)
# define techar char
#endif
@@ -42,7 +42,7 @@ size_t TclEnvEpoch = 0; /* Epoch of the tcl environment
* (if changed with tcl-env). */
static struct {
Tcl_Size cacheSize; /* Number of env strings in cache. */
size_t cacheSize; /* Number of env strings in cache. */
char **cache; /* Array containing all of the environment
* strings that Tcl has allocated. */
#ifndef USE_PUTENV
@@ -159,11 +159,7 @@ TclSetupEnv(
const char *p1;
char *p2;
p1 = tenviron2utfdstr(tenviron[i], &envString);
if (p1 == NULL) {
/* Ignore what cannot be decoded (should not happen) */
continue;
}
p1 = tenviron2utfdstr(tenviron[i], -1, &envString);
p2 = (char *)strchr(p1, '=');
if (p2 == NULL) {
/*
@@ -305,9 +301,9 @@ TclSetEnv(
* interpreters.
*/
oldEnv = tenviron2utfdstr(tenviron[index], &envString);
if (oldEnv == NULL || strcmp(value, oldEnv + (length + 1)) == 0) {
Tcl_DStringFree(&envString); /* OK even if oldEnv is NULL */
oldEnv = tenviron2utfdstr(tenviron[index], -1, &envString);
if (strcmp(value, oldEnv + (length + 1)) == 0) {
Tcl_DStringFree(&envString);
Tcl_MutexUnlock(&envMutex);
return;
}
@@ -328,13 +324,7 @@ TclSetEnv(
memcpy(p, name, nameLength);
p[nameLength] = '=';
memcpy(p+nameLength+1, value, valueLength+1);
p2 = utf2tenvirondstr(p, &envString);
if (p2 == NULL) {
/* No way to signal error from here :-( but should not happen */
Tcl_Free(p);
Tcl_MutexUnlock(&envMutex);
return;
}
p2 = utf2tenvirondstr(p, -1, &envString);
/*
* Copy the native string to heap memory.
@@ -512,11 +502,7 @@ TclUnsetEnv(
string[length] = '\0';
#endif /* _WIN32 */
if (utf2tenvirondstr(string, &envString) == NULL) {
/* Should not happen except memory alloc fail. */
Tcl_MutexUnlock(&envMutex);
return;
}
utf2tenvirondstr(string, -1, &envString);
string = (char *)Tcl_Realloc(string, Tcl_DStringLength(&envString) + tNTL);
memcpy(string, Tcl_DStringValue(&envString),
Tcl_DStringLength(&envString) + tNTL);
@@ -591,19 +577,17 @@ TclGetEnv(
if (index != -1) {
Tcl_DString envStr;
result = tenviron2utfdstr(tenviron[index], &envStr);
if (result) {
result += length;
if (*result == '=') {
result++;
Tcl_DStringInit(valuePtr);
Tcl_DStringAppend(valuePtr, result, -1);
result = Tcl_DStringValue(valuePtr);
} else {
result = NULL;
}
Tcl_DStringFree(&envStr);
result = tenviron2utfdstr(tenviron[index], -1, &envStr);
result += length;
if (*result == '=') {
result++;
Tcl_DStringInit(valuePtr);
Tcl_DStringAppend(valuePtr, result, -1);
result = Tcl_DStringValue(valuePtr);
} else {
result = NULL;
}
Tcl_DStringFree(&envStr);
}
Tcl_MutexUnlock(&envMutex);
return result;
@@ -719,7 +703,7 @@ ReplaceString(
const char *oldStr, /* Old environment string. */
char *newStr) /* New environment string. */
{
Tcl_Size i;
size_t i;
/*
* Check to see if the old value was allocated by Tcl. If so, it needs to
@@ -798,7 +782,7 @@ TclFinalizeEnvironment(void)
if (env.cache) {
#ifdef PURIFY
Tcl_Size i;
size_t i;
for (i = 0; i < env.cacheSize; i++) {
Tcl_Free(env.cache[i]);
}
+5 -7
View File
@@ -232,7 +232,11 @@ HandleBgErrors(
* support one handler setting another handler.
*/
Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix);
Tcl_Obj *copyObj = TclDuplicatePureObj(
interp, assocPtr->cmdPrefix, tclListType);
if (!copyObj) {
return;
}
errPtr = assocPtr->firstBgPtr;
@@ -1084,9 +1088,6 @@ static const struct {
#ifdef USE_NMAKE
".nmake"
#endif
#ifdef TCL_NO_DEPRECATED
".no-deprecate"
#endif
#if !TCL_THREADS
".no-thread"
#endif
@@ -1108,9 +1109,6 @@ static const struct {
#ifdef STATIC_BUILD
".static"
#endif
#if TCL_UTF_MAX < 4
".utf-16"
#endif
}};
const char *
+351 -283
View File
@@ -10,6 +10,7 @@
* Copyright © 2005-2007 Donal K. Fellows.
* Copyright © 2007 Daniel A. Steffen <das@users.sourceforge.net>
* Copyright © 2006-2008 Joe Mistachkin. All rights reserved.
* Copyright © 2021 Nathan Coulter. All rights reserved.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -450,11 +451,11 @@ VarHashCreateVar(
*/
#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
((TclHasInternalRep((objPtr), &tclIntType)) \
((TclHasInternalRep((objPtr), tclIntType)) \
? (*(tPtr) = TCL_NUMBER_INT, \
*(ptrPtr) = (void *) \
(&((objPtr)->internalRep.wideValue)), TCL_OK) : \
TclHasInternalRep((objPtr), &tclDoubleType) \
TclHasInternalRep((objPtr), tclDoubleType) \
? (((isnan((objPtr)->internalRep.doubleValue)) \
? (*(tPtr) = TCL_NUMBER_NAN) \
: (*(tPtr) = TCL_NUMBER_DOUBLE)), \
@@ -634,7 +635,7 @@ static ExceptionRange * GetExceptRangeForPc(const unsigned char *pc,
int searchMode, ByteCode *codePtr);
static const char * GetSrcInfoForPc(const unsigned char *pc,
ByteCode *codePtr, Tcl_Size *lengthPtr,
const unsigned char **pcBeg, Tcl_Size *cmdIdxPtr);
const unsigned char **pcBeg, int *cmdIdxPtr);
static Tcl_Obj ** GrowEvaluationStack(ExecEnv *eePtr, TCL_HASH_TYPE growth,
int move);
static void IllegalExprOperandType(Tcl_Interp *interp,
@@ -673,8 +674,7 @@ static const Tcl_ObjType exprCodeType = {
static const Tcl_ObjType dictIteratorType = {
"dictIterator",
ReleaseDictIterator,
NULL, NULL, NULL,
TCL_OBJTYPE_V0
NULL, NULL, NULL, TCL_OBJTYPE_V0
};
/*
@@ -1481,7 +1481,7 @@ CompileExprObj(
* DupExprCodeInternalRep --
*
* Part of the Tcl object type implementation for Tcl expression
* bytecode. We do not copy the bytecode internalrep. Instead, we return
* bytecode. We do not copy the bytecode intrep. Instead, we return
* without setting copyPtr->typePtr, so the copy is a plain string copy
* of the expression value, and if it is to be used as a compiled
* expression, it will just need a recompile.
@@ -1490,7 +1490,7 @@ CompileExprObj(
* usual (only?) time Tcl_DuplicateObj() will be called is when the copy
* is about to be modified, which would invalidate any copied bytecode
* anyway. The only reason it might make sense to copy the bytecode is if
* we had some modifying routines that operated directly on the internalrep,
* we had some modifying routines that operated directly on the intrep,
* like we do for lists and dicts.
*
* Results:
@@ -1850,7 +1850,7 @@ ArgumentBCEnter(
int objc,
Tcl_Obj **objv)
{
Tcl_Size cmd;
int cmd;
if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
TclArgumentBCEnter(interp, objv, objc, codePtr, &tdPtr->cmdFrame, cmd,
@@ -2598,16 +2598,13 @@ TEBCresume(
case INST_STR_CONCAT1:
opnd = TclGetUInt1AtPtr(pc+1);
DECACHE_STACK_INFO();
objResultPtr = TclStringCat(interp, opnd, &OBJ_AT_DEPTH(opnd-1),
TCL_STRING_IN_PLACE);
if (objResultPtr == NULL) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
CACHE_STACK_INFO();
TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
NEXT_INST_V(2, opnd, 1);
break;
@@ -3377,7 +3374,12 @@ TEBCresume(
goto gotError;
}
if (Tcl_IsShared(objResultPtr)) {
Tcl_Obj *newValue = Tcl_DuplicateObj(objResultPtr);
Tcl_Obj *newValue = TclDuplicatePureObj(
interp, objResultPtr, tclListType);
if (!newValue) {
TRACE_ERROR(interp);
goto gotError;
}
TclDecrRefCount(objResultPtr);
varPtr->value.objPtr = objResultPtr = newValue;
@@ -3436,7 +3438,11 @@ TEBCresume(
goto gotError;
} else {
if (Tcl_IsShared(objResultPtr)) {
valueToAssign = Tcl_DuplicateObj(objResultPtr);
valueToAssign = TclDuplicatePureObj(
interp, objResultPtr, tclListType);
if (!valueToAssign) {
goto errorInLappendListPtr;
}
createdNewObj = 1;
} else {
valueToAssign = objResultPtr;
@@ -4632,7 +4638,8 @@ TEBCresume(
*/
{
int numIndices, nocase, match, cflags;
int dstatus, numIndices, nocase, match, cflags,
toIdxAnchor, fromIdxAnchor;
Tcl_Size slength, length2, fromIdx, toIdx, index, s1len, s2len;
const char *s1, *s2;
@@ -4661,70 +4668,79 @@ TEBCresume(
value2Ptr = OBJ_AT_TOS;
valuePtr = OBJ_UNDER_TOS;
TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
if (
TclHasInternalRep(value2Ptr, tclListType)
||
TclObjectHasInterface(value2Ptr, list, length)
) {
Tcl_Size value2Length;
if (Tcl_ListObjLength(interp,value2Ptr,&value2Length),
value2Length == 1) {
if (TclHasInternalRep(value2Ptr, tclListType)) {
value2Ptr = TclListObjGetElement(value2Ptr, 0);
} else {
Tcl_ListObjIndex(interp, value2Ptr, 0, &value2Ptr);
}
} else {
goto TclLindexList;
}
}
/* special case for AbstractList */
if (TclObjTypeHasProc(valuePtr,indexProc)) {
if (TclObjectHasInterface(valuePtr, list, length)
|| TclHasInternalRep(valuePtr, tclListType)) {
int code, haveElements = 0, status;
if (TclHasInternalRep(valuePtr, tclListType)) {
/* since the type is tclListtype, this can't fail */
TclListObjGetElementsM(interp, valuePtr, &objc, &objv);
haveElements = 1;
} else {
TclObjectDispatchNoDefault(interp, status, valuePtr, list,
length, interp, valuePtr, &objc);
if (status != TCL_OK) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
if (objc < 0) {
objc = TCL_SIZE_MAX;
}
}
Tcl_IncrRefCount(value2Ptr);
DECACHE_STACK_INFO();
length = TclObjTypeLength(valuePtr);
if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
if (TclObjTypeIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
code = TclGetIntForIndexM(interp, value2Ptr, objc-1, &index);
CACHE_STACK_INFO();
if (code != TCL_OK) {
goto TclLindexList;
}
Tcl_DecrRefCount(value2Ptr);
if (haveElements && code == TCL_OK) {
tosPtr--;
pcAdjustment = 1;
goto lindexFastPath;
}
Tcl_ResetResult(interp);
TclObjectDispatchNoDefault(interp, status, valuePtr, list,
index, interp, valuePtr, index, &objResultPtr);
if (status != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
if (objResultPtr == NULL) {
/* Index is out of range, return empty result. */
TclNewObj(objResultPtr);
}
Tcl_IncrRefCount(objResultPtr); // reference held here
goto lindexDone;
}
}
TclLindexList:
/*
* Extract the desired list element.
*/
{
Tcl_Size value2Length;
Tcl_Obj *indexListPtr = value2Ptr;
if ((TclListObjGetElementsM(interp, valuePtr, &objc, &objv) == TCL_OK)
&& (
!TclHasInternalRep(value2Ptr, &tclListType)
||
((Tcl_ListObjLength(interp,value2Ptr,&value2Length),
value2Length == 1
? (indexListPtr = TclListObjGetElement(value2Ptr, 0), 1)
: 0
))
)
) {
int code;
/* increment the refCount of value2Ptr because TclListObjGetElement may
* have just extracted it from a list in the condition for this block.
*/
Tcl_IncrRefCount(indexListPtr);
DECACHE_STACK_INFO();
code = TclGetIntForIndexM(interp, indexListPtr, objc-1, &index);
TclDecrRefCount(indexListPtr);
CACHE_STACK_INFO();
if (code == TCL_OK) {
Tcl_DecrRefCount(value2Ptr);
tosPtr--;
pcAdjustment = 1;
goto lindexFastPath;
}
Tcl_ResetResult(interp);
}
}
DECACHE_STACK_INFO();
objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
CACHE_STACK_INFO();
@@ -4752,45 +4768,82 @@ TEBCresume(
opnd = TclGetInt4AtPtr(pc+1);
TRACE(("\"%.30s\" %d => ", O2S(valuePtr), opnd));
if (TclObjectHasInterface(valuePtr, list, length)) {
TCL_UNUSEDVAR(int status);
TclObjectDispatchNoDefault(interp, status, valuePtr, list,
length, interp, valuePtr, &length);
/* Decode end-offset index values. */
index = TclIndexDecode(opnd, length-1);
/* Compute value @ index */
if (index >= 0 && index < length) {
TclObjectDispatchNoDefault(interp, status, valuePtr, list,
index, interp, valuePtr, index, &objResultPtr);
if (objResultPtr == NULL) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
} else {
TclNewObj(objResultPtr);
}
pcAdjustment = 5;
goto lindexFastPath2;
}
/*
* Get the contents of the list, making sure that it really is a list
* in the process.
*/
/* special case for AbstractList */
if (TclObjTypeHasProc(valuePtr,indexProc)) {
length = TclObjTypeLength(valuePtr);
if (!TclHasInternalRep(valuePtr, tclListType)
&& TclObjectHasInterface(valuePtr, list, index)) {
if (Tcl_ListObjLength(interp, valuePtr, &objc) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
/* Decode end-offset index values. */
index = TclIndexDecode(opnd, length-1);
if (index >= 0 && index < length) {
/* Compute value @ index */
DECACHE_STACK_INFO();
if (TclObjTypeIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) {
CACHE_STACK_INFO();
if (TclIndexIsFromEnd(opnd) && !Tcl_LengthIsFinite(objc)) {
/* end-relative index, and list end is indeterminate */
if (TclObjectDispatchNoDefault(interp, dstatus, valuePtr, list, indexEnd,
interp, valuePtr, index, &objResultPtr) != TCL_OK
|| dstatus != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
CACHE_STACK_INFO();
} else {
index = TclIndexDecode(opnd, TclIndexLast(objc));
if (Tcl_ListObjIndex(interp, valuePtr, index, &objResultPtr)
!= TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
}
if (objResultPtr == NULL) {
TclNewObj(objResultPtr);
}
Tcl_IncrRefCount(objResultPtr);
/*
* Stash the list element on the stack.
*/
TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
/* Already has the correct refCount */
NEXT_INST_F(5, 1, -1);
} else {
if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
/* Decode end-offset index values. */
index = TclIndexDecode(opnd, TclIndexLast(objc));
pcAdjustment = 5;
goto lindexFastPath2;
}
/* List case */
if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
/* Decode end-offset index values. */
index = TclIndexDecode(opnd, objc - 1);
pcAdjustment = 5;
lindexFastPath:
if (index >= 0 && index < objc) {
@@ -4854,17 +4907,9 @@ TEBCresume(
* Compute the new variable value.
*/
DECACHE_STACK_INFO();
if (TclObjTypeHasProc(valuePtr, setElementProc)) {
objResultPtr = TclObjTypeSetElement(interp,
valuePtr, numIndices,
&OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
} else {
objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
&OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
}
if (!objResultPtr) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
@@ -4872,7 +4917,7 @@ TEBCresume(
/*
* Set result.
*/
CACHE_STACK_INFO();
TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_V(5, numIndices+1, -1);
@@ -4965,40 +5010,44 @@ TEBCresume(
TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
NEXT_INST_F(9, 1, 1);
}
toIdx = TclIndexDecode(toIdx, objc - 1);
if (toIdx == TCL_INDEX_NONE) {
goto emptyList;
} else if (toIdx >= objc) {
toIdx = objc - 1;
}
assert (toIdx >= 0 && toIdx < objc);
/*
assert ( fromIdx != TCL_INDEX_NONE );
*
* Extra safety for legacy bytecodes:
*/
if (fromIdx == TCL_INDEX_NONE) {
fromIdx = TCL_INDEX_START;
}
toIdxAnchor = TclIndexIsFromEnd(toIdx);
fromIdxAnchor = TclIndexIsFromEnd(fromIdx);
fromIdx = TclIndexDecode(fromIdx, objc - 1);
if (!Tcl_LengthIsFinite(objc)
&& (toIdxAnchor == 1 || fromIdxAnchor == 1)) {
DECACHE_STACK_INFO();
if (TclObjTypeHasProc(valuePtr, sliceProc)) {
if (TclObjTypeSlice(interp, valuePtr, fromIdx, toIdx, &objResultPtr) != TCL_OK) {
objResultPtr = NULL;
toIdx = TclIndexDecode(toIdx, SIZE_MAX);
fromIdx = TclIndexDecode(fromIdx, SIZE_MAX);
dstatus = TclObjectDispatchNoDefault(interp, objResultPtr,
valuePtr, list, rangeEnd, interp, valuePtr, toIdxAnchor,
toIdx, fromIdxAnchor, fromIdx);
if (dstatus != TCL_OK || objResultPtr == NULL) {
goto gotError;
}
} else {
toIdx = TclIndexDecode(toIdx, TclIndexLast(objc));
if (toIdx == TCL_INDEX_NONE) {
goto emptyList;
} else if (Tcl_LengthIsFinite(objc) && toIdx + 1 >= objc + 1) {
toIdx = TclIndexLast(objc);
}
assert (toIdx < objc);
/*
assert ( fromIdx != TCL_INDEX_NONE );
*
* Extra safety for legacy bytecodes:
*/
if (fromIdx == TCL_INDEX_NONE) {
fromIdx = TCL_INDEX_START;
}
fromIdx = TclIndexDecode(fromIdx, objc - 1);
objResultPtr = TclListObjRange(interp, valuePtr, fromIdx, toIdx);
}
if (objResultPtr == NULL) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
CACHE_STACK_INFO();
TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
NEXT_INST_F(9, 1, 1);
@@ -5007,60 +5056,45 @@ TEBCresume(
value2Ptr = OBJ_AT_TOS;
valuePtr = OBJ_UNDER_TOS;
s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
if (TclListObjLengthM(interp, value2Ptr, &length) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
match = 0;
if (length > 0) {
Tcl_Size i = 0;
Tcl_Obj *o;
/*
* An empty list doesn't match anything.
*/
if (TclObjTypeHasProc(value2Ptr,inOperProc) != NULL) {
int status = TclObjTypeInOperator(interp, valuePtr, value2Ptr, &match);
if (status != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
} else {
if (TclListObjLengthM(interp, value2Ptr, &length) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
match = 0;
if (length > 0) {
Tcl_Size i = 0;
Tcl_Obj *o;
int isAbstractList = TclObjTypeHasProc(value2Ptr,indexProc) != NULL;
/*
* An empty list doesn't match anything.
*/
do {
if (isAbstractList) {
DECACHE_STACK_INFO();
if (TclObjTypeIndex(interp, value2Ptr, i, &o) != TCL_OK) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
CACHE_STACK_INFO();
} else {
Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
}
if (o != NULL) {
s2 = Tcl_GetStringFromObj(o, &s2len);
} else {
s2 = "";
s2len = 0;
}
if (s1len == s2len) {
match = (memcmp(s1, s2, s1len) == 0);
}
/* Could be an ephemeral abstract obj */
Tcl_BounceRefCount(o);
i++;
} while (i < length && match == 0);
}
}
do {
if (TclObjectHasInterface(valuePtr, list, index)) {
TCL_UNUSEDVAR(int status);
TclObjectDispatchNoDefault(interp, status, value2Ptr, list,
index, interp, value2Ptr, i, &o);
if (!o) {
TRACE_ERROR(interp);
goto gotError;
}
} else {
Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
}
if (o != NULL) {
s2 = Tcl_GetStringFromObj(o, &s2len);
} else {
s2 = "";
s2len = 0;
}
if (s1len == s2len) {
match = (memcmp(s1, s2, s1len) == 0);
}
TclBounceRefCount(o);
i++;
} while (i < length && match == 0);
}
if (*pc == INST_LIST_NOT_IN) {
match = !match;
@@ -5324,44 +5358,46 @@ TEBCresume(
*/
slength = Tcl_GetCharLength(valuePtr);
DECACHE_STACK_INFO();
if (TclGetIntForIndexM(interp, value2Ptr, slength-1, &index)!=TCL_OK) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
CACHE_STACK_INFO();
if (index < 0 || index >= slength) {
TclNewObj(objResultPtr);
} else if (TclIsPureByteArray(valuePtr)) {
objResultPtr = Tcl_NewByteArrayObj(
Tcl_GetByteArrayFromObj(valuePtr, (Tcl_Size *)NULL)+index, 1);
} else if (valuePtr->bytes && slength == valuePtr->length) {
objResultPtr = Tcl_NewStringObj((const char *)
valuePtr->bytes+index, 1);
if (TclObjectHasInterface(valuePtr, string, index)) {
int status;
status = TclStringIndexInterface(interp, valuePtr, value2Ptr, &objResultPtr);
if (status != TCL_OK) {
goto gotError;
}
} else {
char buf[4] = "";
int ch = Tcl_GetUniChar(valuePtr, index);
DECACHE_STACK_INFO();
if (TclGetIntForIndexM(interp, value2Ptr, slength-1, &index)!=TCL_OK) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
CACHE_STACK_INFO();
/*
* This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1)
* but creating the object as a string seems to be faster in
* practical use.
*/
if (ch == -1) {
if (index < 0 || index >= slength) {
TclNewObj(objResultPtr);
} else if (TclIsPureByteArray(valuePtr)) {
objResultPtr = Tcl_NewByteArrayObj(
Tcl_GetByteArrayFromObj(valuePtr, NULL)+index, 1);
} else if (valuePtr->bytes && slength == valuePtr->length) {
objResultPtr = Tcl_NewStringObj((const char *)
valuePtr->bytes+index, 1);
} else {
slength = Tcl_UniCharToUtf(ch, buf);
#if TCL_UTF_MAX < 4
if ((ch >= 0xD800) && (slength < 3)) {
slength += Tcl_UniCharToUtf(-1, buf + slength);
char buf[4] = "";
int ch = Tcl_GetUniChar(valuePtr, index);
/*
* This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1)
* but creating the object as a string seems to be faster in
* practical use.
*/
if (ch == -1) {
TclNewObj(objResultPtr);
} else {
slength = Tcl_UniCharToUtf(ch, buf);
objResultPtr = Tcl_NewStringObj(buf, slength);
}
#endif
objResultPtr = Tcl_NewStringObj(buf, slength);
}
}
TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
@@ -5406,14 +5442,73 @@ TEBCresume(
NEXT_INST_F(9, 0, 0);
}
/* Decode index operands. */
if (TclObjectHasInterface(valuePtr, list, index)) {
if ((TclIndexIsFromEnd(toIdx) || TclIndexIsFromEnd(fromIdx))
&& !Tcl_LengthIsFinite(slength)) {
toIdx = TclIndexDecode(toIdx, slength - 1);
fromIdx = TclIndexDecode(fromIdx, slength - 1);
if (toIdx == TCL_INDEX_NONE) {
TclNewObj(objResultPtr);
fromIdx = TclIndexDecode(fromIdx, TclIndexLast(slength));
toIdx = TclIndexDecode(toIdx, TclIndexLast(slength));
if (TclObjectDispatchNoDefault(interp, objResultPtr, valuePtr,
string, rangeEnd, valuePtr, fromIdx, toIdx) != TCL_OK
|| objResultPtr == NULL) {
TRACE_ERROR(interp);
goto gotError;
}
} else {
fromIdx = TclIndexDecode(fromIdx, TclIndexLast(slength));
toIdx = TclIndexDecode(toIdx, TclIndexLast(slength));
if (TclObjectDispatchNoDefault(interp, objResultPtr, valuePtr,
string, range, valuePtr, fromIdx, toIdx) != TCL_OK
|| objResultPtr == NULL) {
TRACE_ERROR(interp);
goto gotError;
}
}
} else {
objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
/* Decode index operands. */
/*
assert ( toIdx != TCL_INDEX_NONE );
*
* Extra safety for legacy bytecodes:
*/
if (toIdx == TCL_INDEX_NONE) {
goto emptyRange;
}
toIdx = TclIndexDecode(toIdx, slength - 1);
if (toIdx == TCL_INDEX_NONE) {
goto emptyRange;
} else if (toIdx >= slength) {
toIdx = slength - 1;
}
assert ( toIdx != TCL_INDEX_NONE && toIdx < slength );
/*
assert ( fromIdx != TCL_INDEX_NONE );
*
* Extra safety for legacy bytecodes:
*/
if (fromIdx == TCL_INDEX_NONE) {
fromIdx = TCL_INDEX_START;
}
fromIdx = TclIndexDecode(fromIdx, slength - 1);
if (fromIdx == TCL_INDEX_NONE) {
fromIdx = TCL_INDEX_START;
}
if (fromIdx + 1 <= toIdx + 1) {
objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
if (objResultPtr == NULL) {
goto gotError;
}
} else {
emptyRange:
TclNewObj(objResultPtr);
}
}
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
NEXT_INST_F(9, 1, 1);
@@ -5569,7 +5664,7 @@ TEBCresume(
int ch;
end = ustring1 + slength;
for (p=ustring1 ; p<end ; ) {
p += TclUniCharToUCS4(p, &ch);
ch = *p++;
if (!tclStringClassTable[opnd].comparator(ch)) {
match = 0;
break;
@@ -5923,7 +6018,7 @@ TEBCresume(
* Quickly force large right shifts to 0 or -1.
*/
if (w2 >= (Tcl_WideInt)(CHAR_BIT*sizeof(w1))) {
if (w2 >= (Tcl_WideInt)(CHAR_BIT*sizeof(long))) {
/*
* We assume that INT_MAX is much larger than the
* number of bits in a long. This is a pretty safe
@@ -5991,9 +6086,9 @@ TEBCresume(
* Handle shifts within the native long range.
*/
if (((size_t)shift < CHAR_BIT*sizeof(w1))
if (((size_t)shift < CHAR_BIT*sizeof(long))
&& !((w1>0 ? w1 : ~w1) &
-(1UL<<(CHAR_BIT*sizeof(w1) - 1 - shift)))) {
-(1UL<<(CHAR_BIT*sizeof(long) - 1 - shift)))) {
wResult = (Tcl_WideUInt)w1 << shift;
goto wideResultOfArithmetic;
}
@@ -6374,7 +6469,7 @@ TEBCresume(
if (Tcl_IsShared(valuePtr)) {
/*
* Here we do some surgery within the Tcl_Obj internals. We want
* to copy the internalrep, but not the string, so we temporarily hide
* to copy the intrep, but not the string, so we temporarily hide
* the string so we do not copy it.
*/
@@ -6399,7 +6494,7 @@ TEBCresume(
case INST_TRY_CVT_TO_BOOLEAN:
valuePtr = OBJ_AT_TOS;
if (TclHasInternalRep(valuePtr, &tclBooleanType)) {
if (TclHasInternalRep(valuePtr, tclBooleanType)) {
objResultPtr = TCONST(1);
} else {
int res = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
@@ -6460,15 +6555,17 @@ TEBCresume(
varListPtr = infoPtr->varLists[i];
numVars = varListPtr->numVars;
listPtr = OBJ_AT_DEPTH(listTmpDepth);
DECACHE_STACK_INFO();
if (TclListObjLengthM(interp, listPtr, &listLen) != TCL_OK) {
CACHE_STACK_INFO();
TRACE_APPEND(("ERROR converting list %" TCL_Z_MODIFIER "d, \"%s\": %s",
i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
goto gotError;
}
if (Tcl_IsShared(listPtr)) {
objPtr = TclListObjCopy(NULL, listPtr);
objPtr = TclDuplicatePureObj(
interp, listPtr, tclListType);
if (!objPtr) {
goto gotError;
}
Tcl_IncrRefCount(objPtr);
Tcl_DecrRefCount(listPtr);
OBJ_AT_DEPTH(listTmpDepth) = objPtr;
@@ -6509,7 +6606,7 @@ TEBCresume(
pc += 5 - infoPtr->loopCtTemp;
case INST_FOREACH_STEP: /* TODO: address abstract list indexing here! */
case INST_FOREACH_STEP:
/*
* "Step" a foreach loop (i.e., begin its next iteration) by assigning
* the next value list element to each loop var.
@@ -6542,47 +6639,20 @@ TEBCresume(
for (i = 0; i < numLists; i++) {
varListPtr = infoPtr->varLists[i];
numVars = varListPtr->numVars;
int hasAbstractList;
listPtr = OBJ_AT_DEPTH(listTmpDepth);
hasAbstractList = TclObjTypeHasProc(listPtr, indexProc) != 0;
DECACHE_STACK_INFO();
if (hasAbstractList) {
status = Tcl_ListObjLength(interp, listPtr, &listLen);
elements = NULL;
} else {
status = TclListObjGetElementsM(
interp, listPtr, &listLen, &elements);
}
status = TclListObjGetElementsM(
interp, listPtr, &listLen, &elements);
if (status != TCL_OK) {
CACHE_STACK_INFO();
goto gotError;
}
CACHE_STACK_INFO();
valIndex = (iterNum * numVars);
for (j = 0; j < numVars; j++) {
if (valIndex >= listLen) {
TclNewObj(valuePtr);
} else {
DECACHE_STACK_INFO();
if (elements) {
valuePtr = elements[valIndex];
} else {
status = Tcl_ListObjIndex(
interp, listPtr, valIndex, &valuePtr);
if (status != TCL_OK) {
/* Could happen for abstract lists */
CACHE_STACK_INFO();
goto gotError;
}
if (valuePtr == NULL) {
/* Permitted for Tcl_LOI to return NULL */
TclNewObj(valuePtr);
}
}
CACHE_STACK_INFO();
valuePtr = elements[valIndex];
}
varIndex = varListPtr->varIndexes[j];
@@ -7105,7 +7175,7 @@ TEBCresume(
/*
* dictPtr is no longer on the stack, and we're not
* moving it into the internalrep of an iterator. We need
* moving it into the intrep of an iterator. We need
* to drop the refcount [Tcl Bug 9b352768e6].
*/
@@ -8453,7 +8523,7 @@ ExecuteExtendedBinaryMathOp(
overflowExpon:
if ((TclGetWideIntFromObj(NULL, value2Ptr, &w2) != TCL_OK)
|| (value2Ptr->typePtr != &tclIntType)
|| (value2Ptr->typePtr != tclIntType)
|| (Tcl_WideUInt)w2 >= (1<<28)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"exponent too large", -1));
@@ -9013,7 +9083,7 @@ ValidatePcAndStackTop(
}
if (checkStack &&
(stackTop > stackUpperBound)) {
Tcl_Size numChars;
size_t numChars;
const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL);
fprintf(stderr, "\nBad stack top %" TCL_Z_MODIFIER "u at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode (min 0, max %" TCL_Z_MODIFIER "u)",
@@ -9163,7 +9233,7 @@ TclGetSrcInfoForPc(
ExtCmdLoc *eclPtr;
ECL *locPtr = NULL;
Tcl_Size srcOffset;
Tcl_Size i;
int i;
Interp *iPtr = (Interp *) *codePtr->interpHandle;
Tcl_HashEntry *hePtr =
Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);
@@ -9175,7 +9245,7 @@ TclGetSrcInfoForPc(
srcOffset = cfPtr->cmd - codePtr->source;
eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hePtr);
for (i=0; i < eclPtr->nuloc; i++) {
for (i=0; i < (int)eclPtr->nuloc; i++) {
if (eclPtr->loc[i].srcOffset == srcOffset) {
locPtr = eclPtr->loc+i;
break;
@@ -9215,7 +9285,7 @@ GetSrcInfoForPc(
const unsigned char **pcBeg,/* If non-NULL, the bytecode location
* where the current instruction starts.
* If NULL; no pointer is stored. */
Tcl_Size *cmdIdxPtr) /* If non-NULL, the location where the index
int *cmdIdxPtr) /* If non-NULL, the location where the index
* of the command containing the pc should
* be stored. */
{
@@ -9224,10 +9294,10 @@ GetSrcInfoForPc(
unsigned char *codeDeltaNext, *codeLengthNext;
unsigned char *srcDeltaNext, *srcLengthNext;
Tcl_Size codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i;
Tcl_Size bestDist = TCL_SIZE_MAX; /* Distance of pc to best cmd's start pc. */
Tcl_Size bestSrcOffset = -1; /* Initialized to avoid compiler warning. */
Tcl_Size bestSrcLength = -1; /* Initialized to avoid compiler warning. */
Tcl_Size bestCmdIdx = -1;
int bestDist = INT_MAX; /* Distance of pc to best cmd's start pc. */
int bestSrcOffset = -1; /* Initialized to avoid compiler warning. */
int bestSrcLength = -1; /* Initialized to avoid compiler warning. */
int bestCmdIdx = -1;
/* The pc must point within the bytecode */
assert ((pcOffset >= 0) && (pcOffset < codePtr->numCodeBytes));
@@ -9306,7 +9376,7 @@ GetSrcInfoForPc(
* instructions. Stop when crossing pc; keep previous.
*/
curr = ((bestDist == TCL_SIZE_MAX) ? codePtr->codeStart : pc - bestDist);
curr = ((bestDist == INT_MAX) ? codePtr->codeStart : pc - bestDist);
prev = curr;
while (curr <= pc) {
prev = curr;
@@ -9315,7 +9385,7 @@ GetSrcInfoForPc(
*pcBeg = prev;
}
if (bestDist == TCL_SIZE_MAX) {
if (bestDist == INT_MAX) {
return NULL;
}
@@ -9553,9 +9623,7 @@ EvalStatsCmd(
double numInstructions, currentHeaderBytes;
size_t numCurrentByteCodes, numByteCodeLits;
size_t refCountSum, literalMgmtBytes, sum, decadeHigh, length;
size_t numSharedMultX, numSharedOnce, minSizeDecade, maxSizeDecade;
Tcl_Size i;
size_t ui;
size_t numSharedMultX, numSharedOnce, minSizeDecade, maxSizeDecade, i;
char *litTableStats;
LiteralEntry *entryPtr;
Tcl_Obj *objPtr;
@@ -9691,7 +9759,7 @@ EvalStatsCmd(
strBytesIfUnshared = 0.0;
strBytesSharedMultX = 0.0;
strBytesSharedOnce = 0.0;
for (ui = 0; ui < globalTablePtr->numBuckets; ui++) {
for (i = 0; i < globalTablePtr->numBuckets; i++) {
for (entryPtr = globalTablePtr->buckets[i]; entryPtr != NULL;
entryPtr = entryPtr->nextPtr) {
if (TclHasInternalRep(entryPtr->objPtr, &tclByteCodeType)) {
@@ -9809,9 +9877,9 @@ EvalStatsCmd(
}
}
sum = 0;
for (ui = 0; ui <= maxSizeDecade; ui++) {
decadeHigh = (1 << (ui+1)) - 1;
sum += statsPtr->literalCount[ui];
for (i = 0; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->literalCount[i];
Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_SIZE_MODIFIER "d\t\t%8.0f%%\n",
decadeHigh, Percent(sum, statsPtr->numLiteralsCreated));
}
@@ -9842,9 +9910,9 @@ EvalStatsCmd(
}
maxSizeDecade = i;
sum = 0;
for (ui = minSizeDecade; ui <= maxSizeDecade; ui++) {
decadeHigh = (1 << (ui+1)) - 1;
sum += statsPtr->srcCount[ui];
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->srcCount[i];
Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_SIZE_MODIFIER "d\t\t%8.0f%%\n",
decadeHigh, Percent(sum, statsPtr->numCompilations));
}
@@ -9866,9 +9934,9 @@ EvalStatsCmd(
}
maxSizeDecade = i;
sum = 0;
for (ui = minSizeDecade; ui <= maxSizeDecade; i++) {
decadeHigh = (1 << (ui+1)) - 1;
sum += statsPtr->byteCodeCount[ui];
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->byteCodeCount[i];
Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_SIZE_MODIFIER "d\t\t%8.0f%%\n",
decadeHigh, Percent(sum, statsPtr->numCompilations));
}
@@ -9890,9 +9958,9 @@ EvalStatsCmd(
}
maxSizeDecade = i;
sum = 0;
for (ui = minSizeDecade; ui <= maxSizeDecade; ui++) {
decadeHigh = (1 << (ui+1)) - 1;
sum += statsPtr->lifetimeCount[ui];
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->lifetimeCount[i];
Tcl_AppendPrintfToObj(objPtr, "\t%12.3f\t\t%8.0f%%\n",
decadeHigh/1000.0, Percent(sum, statsPtr->numByteCodesFreed));
}
+2 -2
View File
@@ -2339,8 +2339,8 @@ Tcl_AllocStatBuf(void)
* Access functions for Tcl_StatBuf --
*
* These functions provide portable read-only access to the portable
* fields of the Tcl_StatBuf structure (really a 'struct stat'
* or something else related). [TIP #316]
* fields of the Tcl_StatBuf structure (really a 'struct stat', 'struct
* stat64' or something else related). [TIP #316]
*
* Results:
* The value from the field being retrieved.
+9 -2
View File
@@ -1664,6 +1664,10 @@ Tcl_CreateChannel(
}
statePtr->channelName = tmp;
statePtr->flags = mask;
/* uncomment this to make default encoding error handling strict */
/*
statePtr->flags |= CHANNEL_ENCODING_STRICT;
*/
statePtr->maxPerms = mask; /* Save max privileges for close callback */
/*
@@ -5931,6 +5935,7 @@ DoReadChars(
ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR);
/* TODO: UpdateInterest not needed here? */
UpdateInterest(chanPtr);
Tcl_SetErrno(EILSEQ);
return -1;
}
@@ -6031,6 +6036,7 @@ DoReadChars(
if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)
&& !GotFlag(statePtr, CHANNEL_STICKY_EOF)
&& (!GotFlag(statePtr, CHANNEL_NONBLOCKING))) {
copied = -1;
goto finish;
}
}
@@ -6110,6 +6116,9 @@ finish:
copied = -1;
}
TclChannelRelease((Tcl_Channel)chanPtr);
if (copied == TCL_INDEX_NONE) {
ResetFlag(statePtr, CHANNEL_ENCODING_ERROR|CHANNEL_EOF);
}
return copied;
}
@@ -8205,9 +8214,7 @@ Tcl_SetChannelOption(
return TCL_OK;
} else if (HaveOpt(2, "-eofchar")) {
if (!newValue[0] || (!(newValue[0] & 0x80) && (!newValue[1]
#ifndef TCL_NO_DEPRECATED
|| !strcmp(newValue+1, " {}")
#endif
))) {
if (GotFlag(statePtr, TCL_READABLE)) {
statePtr->inEofChar = newValue[0];
-4
View File
@@ -158,10 +158,6 @@ typedef struct ChannelState {
* of line sequences in output? */
int inEofChar; /* If nonzero, use this as a signal of EOF on
* input. */
#if TCL_MAJOR_VERSION < 9
int outEofChar; /* If nonzero, append this to the channel when
* it is closed if it is open for writing. For Tcl 8.x only */
#endif
int unreportedError; /* Non-zero if an error report was deferred
* because it happened in the background. The
* value is the POSIX error code. */
+16 -4
View File
@@ -283,7 +283,7 @@ Tcl_GetsObjCmd(
Tcl_Channel chan; /* The channel to read from. */
Tcl_Size lineLen; /* Length of line just read. */
int mode; /* Mode in which channel is opened. */
Tcl_Obj *linePtr, *chanObjPtr;
Tcl_Obj *linePtr, *chanObjPtr, *resultDictPtr, *returnOptsPtr;
int code = TCL_OK;
if ((objc != 2) && (objc != 3)) {
@@ -306,7 +306,6 @@ Tcl_GetsObjCmd(
lineLen = Tcl_GetsObj(chan, linePtr);
if (lineLen == TCL_IO_FAILURE) {
if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
Tcl_DecrRefCount(linePtr);
/*
* TIP #219.
@@ -320,7 +319,14 @@ Tcl_GetsObjCmd(
"error reading \"%s\": %s",
TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
resultDictPtr = Tcl_NewDictObj();
Tcl_DictObjPut(NULL, resultDictPtr, Tcl_NewStringObj("read", -1)
, linePtr);
returnOptsPtr = Tcl_NewDictObj();
Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-result", -1)
, resultDictPtr);
code = TCL_ERROR;
Tcl_SetReturnOptions(interp, returnOptsPtr);
goto done;
}
lineLen = TCL_IO_FAILURE;
@@ -371,7 +377,7 @@ Tcl_ReadObjCmd(
Tcl_WideInt toRead; /* How many bytes to read? */
Tcl_Size charactersRead; /* How many characters were read? */
int mode; /* Mode in which channel is opened. */
Tcl_Obj *resultPtr, *chanObjPtr;
Tcl_Obj *resultPtr, *resultDictPtr, *returnOptsPtr, *chanObjPtr;
if ((objc != 2) && (objc != 3)) {
Interp *iPtr;
@@ -433,7 +439,6 @@ Tcl_ReadObjCmd(
TclChannelPreserve(chan);
charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
if (charactersRead == TCL_IO_FAILURE) {
Tcl_DecrRefCount(resultPtr);
/*
* TIP #219.
* Capture error messages put by the driver into the bypass area and
@@ -446,7 +451,14 @@ Tcl_ReadObjCmd(
"error reading \"%s\": %s",
TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
resultDictPtr = Tcl_NewDictObj();
Tcl_DictObjPut(NULL, resultDictPtr, Tcl_NewStringObj("read", -1)
, resultPtr);
returnOptsPtr = Tcl_NewDictObj();
Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-result", -1)
, resultDictPtr);
TclChannelRelease(chan);
Tcl_SetReturnOptions(interp, returnOptsPtr);
return TCL_ERROR;
}
+5 -1
View File
@@ -379,7 +379,11 @@ ExecuteCallback(
unsigned char *resBuf;
Tcl_InterpState state = NULL;
int res = TCL_OK;
Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command);
Tcl_Obj *command = TclDuplicatePureObj(
interp, dataPtr->command, tclListType);
if (!command) {
return TCL_ERROR;
}
Tcl_Interp *eval = dataPtr->interp;
Tcl_Preserve(eval);
+8 -2
View File
@@ -2261,7 +2261,10 @@ NewReflectedChannel(
rcPtr->mode = mode;
rcPtr->interest = 0; /* Initially no interest registered */
rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
rcPtr->cmd = TclDuplicatePureObj(interp, cmdpfxObj, tclListType);
if (!rcPtr->cmd) {
return NULL;
}
Tcl_IncrRefCount(rcPtr->cmd);
rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL);
while (mn <= (int)METH_WRITE) {
@@ -2398,7 +2401,10 @@ InvokeTclMethod(
* before the channel id.
*/
cmd = TclListObjCopy(NULL, rcPtr->cmd);
cmd = TclDuplicatePureObj(NULL, rcPtr->cmd, tclListType);
if (!cmd) {
return TCL_ERROR;
}
Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj);
Tcl_ListObjAppendElement(NULL, cmd, methObj);
Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name);
+10 -5
View File
@@ -1687,7 +1687,7 @@ Tcl_FSEvalFileEx(
use the utf-8 encoding. */
{
Tcl_Size length;
int result = TCL_ERROR;
int result = TCL_ERROR;
Tcl_StatBuf statBuf;
Tcl_Obj *oldScriptFile;
Interp *iPtr;
@@ -1734,6 +1734,11 @@ Tcl_FSEvalFileEx(
Tcl_CloseEx(interp,chan,0);
return result;
}
if (Tcl_SetChannelOption(interp, chan, "-profile", "strict")
!= TCL_OK) {
Tcl_CloseEx(interp,chan,0);
return result;
}
TclNewObj(objPtr);
Tcl_IncrRefCount(objPtr);
@@ -1802,7 +1807,7 @@ Tcl_FSEvalFileEx(
const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
unsigned limit = 150;
int overflow = ((unsigned)length > limit);
int overflow = (length > limit);
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (file \"%.*s%s\" line %d)",
@@ -1954,12 +1959,12 @@ EvalFileCallback(
Tcl_Size length;
const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
const unsigned limit = 150;
int overflow = ((unsigned)length > limit);
const unsigned int limit = 150;
int overflow = (length > limit);
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (file \"%.*s%s\" line %d)",
(overflow ? limit : (unsigned)length), pathString,
(overflow ? limit : (unsigned int)length), pathString,
(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
+11 -11
View File
@@ -37,7 +37,7 @@ static void PrintUsage(Tcl_Interp *interp,
* that can be invoked by generic object code.
*/
const Tcl_ObjType tclIndexType = {
static const Tcl_ObjType indexType = {
"index", /* name */
FreeIndex, /* freeIntRepProc */
DupIndex, /* dupIntRepProc */
@@ -213,7 +213,7 @@ Tcl_GetIndexFromObjStruct(
*/
if (objPtr && !(flags & TCL_INDEX_TEMP_TABLE)) {
irPtr = TclFetchInternalRep(objPtr, &tclIndexType);
irPtr = TclFetchInternalRep(objPtr, &indexType);
if (irPtr) {
indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
if ((indexRep->tablePtr == tablePtr)
@@ -282,7 +282,7 @@ Tcl_GetIndexFromObjStruct(
*/
if (objPtr && (index != TCL_INDEX_NONE) && !(flags & TCL_INDEX_TEMP_TABLE)) {
irPtr = TclFetchInternalRep(objPtr, &tclIndexType);
irPtr = TclFetchInternalRep(objPtr, &indexType);
if (irPtr) {
indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
} else {
@@ -290,7 +290,7 @@ Tcl_GetIndexFromObjStruct(
indexRep = (IndexRep*)Tcl_Alloc(sizeof(IndexRep));
ir.twoPtrValue.ptr1 = indexRep;
Tcl_StoreInternalRep(objPtr, &tclIndexType, &ir);
Tcl_StoreInternalRep(objPtr, &indexType, &ir);
}
indexRep->tablePtr = (void *) tablePtr;
indexRep->offset = offset;
@@ -385,7 +385,7 @@ static void
UpdateStringOfIndex(
Tcl_Obj *objPtr)
{
IndexRep *indexRep = (IndexRep *)TclFetchInternalRep(objPtr, &tclIndexType)->twoPtrValue.ptr1;
IndexRep *indexRep = (IndexRep *)TclFetchInternalRep(objPtr, &indexType)->twoPtrValue.ptr1;
const char *indexStr = EXPAND_OF(indexRep);
Tcl_InitStringRep(objPtr, indexStr, strlen(indexStr));
@@ -417,11 +417,11 @@ DupIndex(
Tcl_ObjInternalRep ir;
IndexRep *dupIndexRep = (IndexRep *)Tcl_Alloc(sizeof(IndexRep));
memcpy(dupIndexRep, TclFetchInternalRep(srcPtr, &tclIndexType)->twoPtrValue.ptr1,
memcpy(dupIndexRep, TclFetchInternalRep(srcPtr, &indexType)->twoPtrValue.ptr1,
sizeof(IndexRep));
ir.twoPtrValue.ptr1 = dupIndexRep;
Tcl_StoreInternalRep(dupPtr, &tclIndexType, &ir);
Tcl_StoreInternalRep(dupPtr, &indexType, &ir);
}
/*
@@ -445,7 +445,7 @@ static void
FreeIndex(
Tcl_Obj *objPtr)
{
Tcl_Free(TclFetchInternalRep(objPtr, &tclIndexType)->twoPtrValue.ptr1);
Tcl_Free(TclFetchInternalRep(objPtr, &indexType)->twoPtrValue.ptr1);
objPtr->typePtr = NULL;
}
@@ -865,7 +865,7 @@ Tcl_WrongNumArgs(
*/
const Tcl_ObjInternalRep *irPtr;
if ((irPtr = TclFetchInternalRep(origObjv[i], &tclIndexType))) {
if ((irPtr = TclFetchInternalRep(origObjv[i], &indexType))) {
IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
elementStr = EXPAND_OF(indexRep);
@@ -912,7 +912,7 @@ Tcl_WrongNumArgs(
*/
const Tcl_ObjInternalRep *irPtr;
if ((irPtr = TclFetchInternalRep(objv[i], &tclIndexType))) {
if ((irPtr = TclFetchInternalRep(objv[i], &indexType))) {
IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
@@ -1361,7 +1361,7 @@ TclGetCompletionCodeFromObj(
"ok", "error", "return", "break", "continue", NULL
};
if (!TclHasInternalRep(value, &tclIndexType)
if (!TclHasInternalRep(value, &indexType)
&& TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) {
return TCL_OK;
}
+292 -221
View File
@@ -11,6 +11,7 @@
* Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
* Copyright (c) 2006-2008 by Joe Mistachkin. All rights reserved.
* Copyright (c) 2008 by Miguel Sofer. All rights reserved.
* Copyright (c) 2021 by Nathan Coulter. All rights reserved.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -46,10 +47,13 @@
#if defined(__cplusplus)
# define TCL_UNUSED(T) T
# define TCL_UNUSEDVAR(T) T
#elif defined(__GNUC__) && (__GNUC__ > 2)
# define TCL_UNUSED(T) T JOIN(dummy, __LINE__) __attribute__((unused))
# define TCL_UNUSEDVAR(T) T __attribute__((unused))
#else
# define TCL_UNUSED(T) T JOIN(dummy, __LINE__)
# define TCL_UNUSEDVAR(T) T
#endif
/*
@@ -66,8 +70,11 @@
#include <ctype.h>
#include <stdarg.h>
#include <stdlib.h>
#include <stdint.h>
#ifdef NO_STDLIB_H
# include "../compat/stdlib.h"
#else
# include <stdlib.h>
#endif
#ifdef NO_STRING_H
#include "../compat/string.h"
#else
@@ -203,6 +210,223 @@ typedef struct Tcl_ResolverInfo {
#define TCL_AVOID_RESOLVERS 0x40000
/*
*----------------------------------------------------------------
* Object type
*----------------------------------------------------------------
*/
/* version is a pointer so that it can be overridden if ever needed */
typedef struct TclObjectTypeType {
int *version;
} TclObjectTypeType;
/* keep this structure in sync with Tcl_ObjType */
typedef struct ObjectType {
const char *name; /* Name of the type, e.g. "int". */
Tcl_FreeInternalRepProc *freeIntRepProc;
/* Called to free any storage for the type's
* internal rep. NULL if the internal rep does
* not need freeing. */
Tcl_DupInternalRepProc *dupIntRepProc;
/* Called to create a new object as a copy of
* an existing object. */
Tcl_UpdateStringProc *updateStringProc;
/* Called to update the string rep from the
* type's internal representation. */
Tcl_SetFromAnyProc *setFromAnyProc;
/* Called to convert the object's internal rep
* to this type. Frees the internal rep of the
* old type. Returns TCL_ERROR on failure. */
int version;
Tcl_ObjInterface *interface;
} ObjectType;
#define TclObjectInterfaceCall(objPtr, iface, proc, ...) \
((ObjInterface *)((ObjectType *)(objPtr)->typePtr)->interface) \
->iface.proc(__VA_ARGS__)
#define TclObjectDispatch(objPtr, default, iface, proc, ...) \
TclObjectHasInterface((objPtr), iface, proc) \
? TclObjectInterfaceCall(objPtr, iface, proc, __VA_ARGS__) \
: default(__VA_ARGS__)
#define TclObjectDispatchNoDefault(interp, res, objPtr, iface, proc, ...) \
(TclObjectHasInterface((objPtr), iface, proc) \
? (res = TclObjectInterfaceCall((objPtr), iface, proc, __VA_ARGS__), \
TCL_OK) \
: (Tcl_SetObjResult((interp), \
Tcl_ObjPrintf("interface not provided interface %s proc %s" \
, #iface, #proc )), TCL_ERROR))
#define TclObjectHasInterface(objPtr, iface, proc) \
((objPtr)->typePtr != NULL \
&& (objPtr)->typePtr->version == 2 \
&& ((ObjInterface *)((ObjectType *)(objPtr)->typePtr)->interface) \
->iface.proc != NULL)
/*
*----------------------------------------------------------------
* Object interface data structures and macros
*----------------------------------------------------------------
*/
#define tclObjTypeInterfaceArgsListAll \
Tcl_Interp *interp, /* Used to report errors if not NULL. */ \
Tcl_Obj *listPtr, /* List object for which an element array \
* is to be returned. */ \
Tcl_Size *objcPtr, /* Where to store the count of objects \
* referenced by objv. */ \
Tcl_Obj ***objvPtr /* Where to store the pointer to an \
* array of */
#define tclObjTypeInterfaceArgsListAppend \
Tcl_Interp *interp, /* Used to report errors if not NULL. */ \
Tcl_Obj *listPtr, /* List object to append objPtr to. */ \
Tcl_Obj *objPtr /* Object to append to listPtr's list. */
#define tclObjTypeInterfaceArgsListAppendList \
Tcl_Interp *interp, /* Used to report errors if not NULL. */ \
Tcl_Obj *listPtr, /* List object to append elements to. */ \
Tcl_Obj *elemListPtr /* List obj with elements to append. */
#define tclObjTypeInterfaceArgsListIndex \
Tcl_Interp *interp, /* Used to report errors if not NULL. */ \
Tcl_Obj *listPtr, /* List object to index into. */ \
Tcl_Size index, /* Index of element to return. */ \
Tcl_Obj **objPtrPtr /* The resulting Tcl_Obj* is stored here. */
#define tclObjTypeInterfaceArgsListIndexEnd \
Tcl_Interp *interp, /* Used to report errors if not NULL. */ \
Tcl_Obj *listPtr, /* List object to index into. */ \
Tcl_Size index, /* Index of element to return. */ \
Tcl_Obj **objPtrPtr /* The resulting Tcl_Obj* is stored here. */
#define tclObjTypeInterfaceArgsListIsSorted \
Tcl_Interp * interp, /* Used to report errors */ \
Tcl_Obj *listPtr, /* The list in question */ \
size_t flags /* flags */
#define tclObjTypeInterfaceArgsListLength \
Tcl_Interp *interp, /* Used to report errors if not NULL. */ \
Tcl_Obj *listPtr, /* List object whose #elements to return. */ \
Tcl_Size *lenPtr /* The resulting length is stored here. */
#define tclObjTypeInterfaceArgsListRange \
Tcl_Interp * interp, /* Used to report errors */ \
Tcl_Obj *listObj, /* List object to take a range from. */ \
Tcl_Size rangeStart, /* Index of first element to */ \
/* include. */ \
Tcl_Size rangeEnd /* Index of last element to include. */
#define tclObjTypeInterfaceArgsListRangeEnd \
Tcl_Interp * interp, /* Used to report errors */ \
Tcl_Obj *listPtr, /* List object to take a range from. */ \
Tcl_Size fromAnchor,/* 0 for start and 1 for end */ \
Tcl_Size fromIdx, /* Index of first element to include. */ \
Tcl_Size toAnchor, /* 0 for start and 1 for end */ \
Tcl_Size toIdx /* Index of last element to include. */
#define tclObjTypeInterfaceArgsListReplace \
Tcl_Interp *interp, /* Used for error reporting if not NULL. */ \
Tcl_Obj *listObj, /* List object whose elements to replace. */ \
Tcl_Size first, /* Index of first element to replace. */ \
Tcl_Size numToDelete, /* Number of elements to replace. */ \
Tcl_Size numToInsert, /* Number of objects to insert. */ \
/* An array of objc pointers to Tcl \
* objects to insert. */ \
Tcl_Obj *const insertObjs[]
#define tclObjTypeInterfaceArgsListReplaceList \
Tcl_Interp *interp, /* Used for error reporting if not NULL. */ \
Tcl_Obj *listPtr, /* List object whose elements to replace. */ \
Tcl_Size first, /* Index of first element to replace. */ \
Tcl_Size count, /* Number of elements to replace. */ \
Tcl_Obj *newItemsPtr /* a list of new items to insert */
#define tclObjTypeInterfaceArgsListReverse \
Tcl_Interp *interp, /* Used for error reporting if not NULL. */ \
Tcl_Obj *listPtr /* List object whose elements to replace. */ \
#define tclObjTypeInterfaceArgsListSet \
Tcl_Interp *interp, /* Tcl interpreter; used for error reporting \
* if not NULL. */ \
Tcl_Obj *listObj, /* List object in which element should be \
* stored. */ \
Tcl_Size index, /* Index of element to store. */ \
Tcl_Obj *valueObj /* Tcl object to store in the designated list \
* element. */
#define tclObjTypeInterfaceArgsListSetList \
Tcl_Interp *interp, /* Tcl interpreter. */ \
Tcl_Obj *listObj, /* Pointer to the list being modified. */ \
Tcl_Size indexCount, /* Number of index args. */ \
Tcl_Obj *const indexArray[], /* Index args. */ \
Tcl_Obj *valueObj /* Value arg to 'lset' or NULL to 'lpop'. */
#define tclObjTypeInterfaceArgsStringIndex \
Tcl_Interp *interp, \
Tcl_Obj *objPtr, \
Tcl_Size index, \
Tcl_Obj **objPtrPtr /* The resulting Tcl_Obj* is stored here. */
#define tclObjTypeInterfaceArgsStringIndexEnd \
Tcl_Interp *interp, \
Tcl_Obj *objPtr, \
Tcl_Size index, \
Tcl_Obj **objPtrPtr /* The resulting Tcl_Obj* is stored here. */
#define tclObjTypeInterfaceArgsStringLength \
Tcl_Obj *objPtr
#define tclObjTypeInterfaceArgsStringRange \
Tcl_Obj *objPtr, /* The Tcl object to find the range of. */ \
Tcl_Size first, /* First index of the range. */ \
Tcl_Size last /* Last index of the range. */
#define tclObjTypeInterfaceArgsStringRangeEnd \
Tcl_Obj *objPtr, /* The Tcl object to find the range of. */ \
Tcl_Size first, /* First index of the range. */ \
Tcl_Size last /* Last index of the range. */
typedef struct ObjInterface {
int version;
struct string {
int (*index)(tclObjTypeInterfaceArgsStringIndex);
int (*indexEnd)(tclObjTypeInterfaceArgsStringIndexEnd);
Tcl_Size (*length)(tclObjTypeInterfaceArgsStringLength);
Tcl_Obj* (*range)(tclObjTypeInterfaceArgsStringRange);
Tcl_Obj* (*rangeEnd)(tclObjTypeInterfaceArgsStringRangeEnd);
} string;
struct list {
int (*all)(tclObjTypeInterfaceArgsListAll);
int (*append)(tclObjTypeInterfaceArgsListAppend);
int (*appendlist)(tclObjTypeInterfaceArgsListAppendList);
int (*index)(tclObjTypeInterfaceArgsListIndex);
int (*indexEnd)(tclObjTypeInterfaceArgsListIndexEnd);
int (*isSorted)(tclObjTypeInterfaceArgsListIsSorted);
int (*length)(tclObjTypeInterfaceArgsListLength);
Tcl_Obj* (*range)(tclObjTypeInterfaceArgsListRange);
Tcl_Obj* (*rangeEnd)(tclObjTypeInterfaceArgsListRangeEnd);
int (*replace)(tclObjTypeInterfaceArgsListReplace);
int (*replaceList)(tclObjTypeInterfaceArgsListReplaceList);
Tcl_Obj* (*reverse)(tclObjTypeInterfaceArgsListReverse);
int (*set)(tclObjTypeInterfaceArgsListSet);
Tcl_Obj * (*setlist)(tclObjTypeInterfaceArgsListSetList);
} list;
} ObjInterface;
/*
*----------------------------------------------------------------
* Data structures related to namespaces.
@@ -222,9 +446,7 @@ typedef struct NamespacePathEntry NamespacePathEntry;
typedef struct TclVarHashTable {
Tcl_HashTable table;
struct Namespace *nsPtr;
#if TCL_MAJOR_VERSION > 8
struct Var *arrayPtr;
#endif /* TCL_MAJOR_VERSION > 8 */
} TclVarHashTable;
/*
@@ -274,11 +496,7 @@ typedef struct Namespace {
* strings; values have type (Namespace *). If
* NULL, there are no children. */
#endif
#if TCL_MAJOR_VERSION > 8
size_t nsId; /* Unique id for the namespace. */
#else
unsigned long nsId;
#endif
Tcl_Interp *interp; /* The interpreter containing this
* namespace. */
int flags; /* OR-ed combination of the namespace status
@@ -959,9 +1177,6 @@ typedef struct CompiledLocal {
* Among others used to speed up var lookups. */
Tcl_Size frameIndex; /* Index in the array of compiler-assigned
* variables in the procedure call frame. */
#if TCL_MAJOR_VERSION < 9
int flags;
#endif
Tcl_Obj *defValuePtr; /* Pointer to the default value of an
* argument, if any. NULL if not an argument
* or, if an argument, no default value. */
@@ -972,12 +1187,10 @@ typedef struct CompiledLocal {
* is marked by a unique tag during
* compilation, and that same tag is used to
* find the variable at runtime. */
#if TCL_MAJOR_VERSION > 8
int flags; /* Flag bits for the local variable. Same as
* the flags for the Var structure above,
* although only VAR_ARGUMENT, VAR_TEMPORARY,
* and VAR_RESOLVED make sense. */
#endif
char name[TCLFLEXARRAY]; /* Name of the local variable starts here. If
* the name is NULL, this will just be '\0'.
* The actual size of this field will be large
@@ -1035,11 +1248,7 @@ typedef void (ProcErrorProc)(Tcl_Interp *interp, Tcl_Obj *procNameObj);
typedef struct Trace {
Tcl_Size level; /* Only trace commands at nesting level less
* than or equal to this. */
#if TCL_MAJOR_VERSION > 8
Tcl_CmdObjTraceProc2 *proc; /* Procedure to call to trace command. */
#else
Tcl_CmdObjTraceProc *proc; /* Procedure to call to trace command. */
#endif
void *clientData; /* Arbitrary value to pass to proc. */
struct Trace *nextPtr; /* Next in list of traces for this interp. */
int flags; /* Flags governing the trace - see
@@ -1083,102 +1292,6 @@ typedef struct ActiveInterpTrace {
#define TCL_TRACE_ENTER_EXEC 1
#define TCL_TRACE_LEAVE_EXEC 2
#if TCL_MAJOR_VERSION > 8
#define TclObjTypeHasProc(objPtr, proc) (((objPtr)->typePtr \
&& ((offsetof(Tcl_ObjType, proc) < offsetof(Tcl_ObjType, version)) \
|| (offsetof(Tcl_ObjType, proc) < (objPtr)->typePtr->version))) ? \
((objPtr)->typePtr)->proc : NULL)
MODULE_SCOPE Tcl_Size TclLengthOne(Tcl_Obj *);
/*
* Abstract List
*
* This structure provides the functions used in List operations to emulate a
* List for AbstractList types.
*/
static inline Tcl_Size
TclObjTypeLength(Tcl_Obj *objPtr)
{
Tcl_ObjTypeLengthProc *proc = TclObjTypeHasProc(objPtr, lengthProc);
return proc(objPtr);
}
static inline int
TclObjTypeIndex(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
Tcl_Size index,
Tcl_Obj **elemObjPtr)
{
Tcl_ObjTypeIndexProc *proc = TclObjTypeHasProc(objPtr, indexProc);
return proc(interp, objPtr, index, elemObjPtr);
}
static inline int
TclObjTypeSlice(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
Tcl_Size fromIdx,
Tcl_Size toIdx,
Tcl_Obj **newObjPtr)
{
Tcl_ObjTypeSliceProc *proc = TclObjTypeHasProc(objPtr, sliceProc);
return proc(interp, objPtr, fromIdx, toIdx, newObjPtr);
}
static inline int
TclObjTypeReverse(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
Tcl_Obj **newObjPtr)
{
Tcl_ObjTypeReverseProc *proc = TclObjTypeHasProc(objPtr, reverseProc);
return proc(interp, objPtr, newObjPtr);
}
static inline int
TclObjTypeGetElements(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
Tcl_Size *objCPtr,
Tcl_Obj ***objVPtr)
{
Tcl_ObjTypeGetElements *proc = TclObjTypeHasProc(objPtr, getElementsProc);
return proc(interp, objPtr, objCPtr, objVPtr);
}
static inline Tcl_Obj*
TclObjTypeSetElement(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
Tcl_Size indexCount,
Tcl_Obj *const indexArray[],
Tcl_Obj *valueObj)
{
Tcl_ObjTypeSetElement *proc = TclObjTypeHasProc(objPtr, setElementProc);
return proc(interp, objPtr, indexCount, indexArray, valueObj);
}
static inline int
TclObjTypeReplace(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
Tcl_Size first,
Tcl_Size numToDelete,
Tcl_Size numToInsert,
Tcl_Obj *const insertObjs[])
{
Tcl_ObjTypeReplaceProc *proc = TclObjTypeHasProc(objPtr, replaceProc);
return proc(interp, objPtr, first, numToDelete, numToInsert, insertObjs);
}
static inline int
TclObjTypeInOperator(Tcl_Interp *interp, struct Tcl_Obj *valueObj,
struct Tcl_Obj *listObj, int *boolResult)
{
Tcl_ObjTypeInOperatorProc *proc = TclObjTypeHasProc(listObj, inOperProc);
return proc(interp, valueObj, listObj, boolResult);
}
#endif /* TCL_MAJOR_VERSION > 8 */
/*
* The structure below defines an entry in the assocData hash table which is
* associated with an interpreter. The entry contains a pointer to a function
@@ -1321,7 +1434,7 @@ typedef struct CmdFrame {
int type; /* Values see below. */
int level; /* Number of frames in stack, prevent O(n)
* scan of list. */
Tcl_Size *line; /* Lines the words of the command start on. */
int *line; /* Lines the words of the command start on. */
Tcl_Size nline;
CallFrame *framePtr; /* Procedure activation record, may be
* NULL. */
@@ -1416,7 +1529,7 @@ typedef struct CFWordBC {
typedef struct ContLineLoc {
Tcl_Size num; /* Number of entries in loc, not counting the
* final -1 marker entry. */
Tcl_Size loc[TCLFLEXARRAY];/* Table of locations, as character offsets.
int loc[TCLFLEXARRAY];/* Table of locations, as character offsets.
* The table is allocated as part of the
* structure, extending behind the nominal end
* of the structure. An entry containing the
@@ -1960,18 +2073,7 @@ typedef struct Interp {
void *interpInfo; /* Information used by tclInterp.c to keep
* track of parent/child interps on a
* per-interp basis. */
#if TCL_MAJOR_VERSION > 8
void (*optimizer)(void *envPtr);
#else
union {
void (*optimizer)(void *envPtr);
Tcl_HashTable unused2; /* No longer used (was mathFuncTable). The
* unused space in interp was repurposed for
* pluggable bytecode optimizers. The core
* contains one optimizer, which can be
* selectively overridden by extensions. */
} extra;
#endif
/*
* Information related to procedures and variables. See tclProc.c and
* tclVar.c for usage.
@@ -2000,12 +2102,6 @@ typedef struct Interp {
Namespace *lookupNsPtr; /* Namespace to use ONLY on the next
* TCL_EVAL_INVOKE call to Tcl_EvalObjv. */
#if TCL_MAJOR_VERSION < 9
char *appendResultDontUse;
int appendAvlDontUse;
int appendUsedDontUse;
#endif
/*
* Information about packages. Used only in tclPkg.c.
*/
@@ -2028,9 +2124,6 @@ typedef struct Interp {
* Normally zero, but may be set before
* calling Tcl_Eval. See below for valid
* values. */
#if TCL_MAJOR_VERSION < 9
int unused1; /* No longer used (was termOffset) */
#endif
LiteralTable literalTable; /* Contains LiteralEntry's describing all Tcl
* objects holding literals of scripts
* compiled by the interpreter. Indexed by the
@@ -2068,9 +2161,6 @@ typedef struct Interp {
* string. Returned by Tcl_ObjSetVar2 when
* variable traces change a variable in a
* gross way. */
#if TCL_MAJOR_VERSION < 9
char resultSpaceDontUse[TCL_DSTRING_STATIC_SIZE+1];
#endif
Tcl_Obj *objResultPtr; /* If the last command returned an object
* result, this points to it. Should not be
* accessed directly; see comment above. */
@@ -2524,6 +2614,7 @@ typedef enum TclEolTranslation {
#define TCL_INVOKE_NO_UNKNOWN (1<<1)
#define TCL_INVOKE_NO_TRACEBACK (1<<2)
/*
* ListStore --
*
@@ -2673,8 +2764,8 @@ typedef struct ListRep {
* (1) No string representation exists which means it will obviously have
* to be generated from the list representation when needed
* (2) The ListStore flags is marked canonical. This is done at the time
* the string representation is generated from the list under certain
* conditions (see comments in UpdateStringOfList).
* the string representation is generated from the list IF the list
* representation does not have a span (see comments in UpdateStringOfList).
* (3) The list representation does not have a span component. This is
* because list Tcl_Obj's with spans are always created from existing lists
* and never from strings (see SetListFromAny) and thus their string
@@ -2692,10 +2783,10 @@ typedef struct ListRep {
* converted to a list.
*/
#define TclListObjGetElementsM(interp_, listObj_, objcPtr_, objvPtr_) \
(((listObj_)->typePtr == &tclListType) \
? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \
TCL_OK) \
: Tcl_ListObjGetElements( \
(((listObj_)->typePtr == tclListType) \
? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \
TCL_OK) \
: Tcl_ListObjGetElements( \
(interp_), (listObj_), (objcPtr_), (objvPtr_)))
/*
@@ -2703,13 +2794,14 @@ typedef struct ListRep {
* count in lenPtr_. Returns TCL_OK on success or TCL_ERROR if the
* Tcl_Obj cannot be converted to a list.
*/
#define TclListObjLengthM(interp_, listObj_, lenPtr_) \
(((listObj_)->typePtr == &tclListType) \
? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \
#define TclListObjLengthM(interp_, listObj_, lenPtr_) \
(((listObj_)->typePtr == tclListType) \
? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \
: Tcl_ListObjLength((interp_), (listObj_), (lenPtr_)))
#define TclListObjIsCanonical(listObj_) \
(((listObj_)->typePtr == &tclListType) ? ListObjIsCanonical((listObj_)) : 0)
#define TclListObjIsCanonical(listObj_) \
(((listObj_)->typePtr == tclListType) \
? ListObjIsCanonical((listObj_)) : 0)
/*
* Modes for collecting (or not) in the implementations of TclNRForeachCmd,
@@ -2727,29 +2819,20 @@ typedef struct ListRep {
* WARNING: these macros eval their args more than once.
*/
#if TCL_MAJOR_VERSION > 8
#define TclGetBooleanFromObj(interp, objPtr, intPtr) \
(((objPtr)->typePtr == &tclIntType \
|| (objPtr)->typePtr == &tclBooleanType) \
(((objPtr)->typePtr == tclIntType \
|| (objPtr)->typePtr == tclBooleanType) \
? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \
: Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr)))
#else
#define TclGetBooleanFromObj(interp, objPtr, intPtr) \
(((objPtr)->typePtr == &tclIntType) \
? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \
: ((objPtr)->typePtr == &tclBooleanType) \
? (*(intPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \
: Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr)))
#endif
#ifdef TCL_WIDE_INT_IS_LONG
#define TclGetLongFromObj(interp, objPtr, longPtr) \
(((objPtr)->typePtr == &tclIntType) \
(((objPtr)->typePtr == tclIntType) \
? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
: Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
#else
#define TclGetLongFromObj(interp, objPtr, longPtr) \
(((objPtr)->typePtr == &tclIntType \
(((objPtr)->typePtr == tclIntType \
&& (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \
&& (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(LONG_MAX)) \
? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \
@@ -2757,13 +2840,13 @@ typedef struct ListRep {
#endif
#define TclGetIntFromObj(interp, objPtr, intPtr) \
(((objPtr)->typePtr == &tclIntType \
(((objPtr)->typePtr == tclIntType \
&& (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \
&& (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \
? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
: Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
((((objPtr)->typePtr == &tclIntType) && ((objPtr)->internalRep.wideValue >= 0) \
((((objPtr)->typePtr == tclIntType) && ((objPtr)->internalRep.wideValue >= 0) \
&& ((objPtr)->internalRep.wideValue <= endValue)) \
? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
: Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
@@ -2777,7 +2860,7 @@ typedef struct ListRep {
*/
#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
(((objPtr)->typePtr == &tclIntType) \
(((objPtr)->typePtr == tclIntType) \
? (*(wideIntPtr) = \
((objPtr)->internalRep.wideValue), TCL_OK) : \
Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
@@ -3030,7 +3113,6 @@ MODULE_SCOPE TclPlatformType tclPlatform;
*/
MODULE_SCOPE Tcl_Encoding tclIdentityEncoding;
MODULE_SCOPE Tcl_Encoding tclUtf8Encoding;
MODULE_SCOPE int
TclEncodingProfileNameToId(Tcl_Interp *interp,
const char *profileName,
@@ -3053,13 +3135,13 @@ MODULE_SCOPE void *tclTimeClientData;
* Variables denoting the Tcl object types defined in the core.
*/
MODULE_SCOPE const Tcl_ObjType tclBignumType;
MODULE_SCOPE const Tcl_ObjType tclBooleanType;
MODULE_SCOPE const Tcl_ObjType *tclBignumType;
MODULE_SCOPE const Tcl_ObjType *tclBooleanType;
MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
MODULE_SCOPE const Tcl_ObjType tclDoubleType;
MODULE_SCOPE const Tcl_ObjType tclIntType;
MODULE_SCOPE const Tcl_ObjType tclIndexType;
MODULE_SCOPE const Tcl_ObjType tclListType;
MODULE_SCOPE const Tcl_ObjType *tclDoubleType;
MODULE_SCOPE const Tcl_ObjType *tclIntType;
MODULE_SCOPE const Tcl_ObjType *tclListType;
MODULE_SCOPE const Tcl_ObjType *tclArithSeriesType;
MODULE_SCOPE const Tcl_ObjType tclDictType;
MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
MODULE_SCOPE const Tcl_ObjType tclStringType;
@@ -3202,12 +3284,11 @@ struct Tcl_LoadHandle_ {
*----------------------------------------------------------------
*/
#if TCL_MAJOR_VERSION > 8
MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr,
const unsigned char *bytes, Tcl_Size len);
MODULE_SCOPE int TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr,
int flags);
MODULE_SCOPE void TclAdvanceContinuations(Tcl_Size *line, Tcl_Size **next,
MODULE_SCOPE void TclAdvanceContinuations(Tcl_Size *line, int **next,
int loc);
MODULE_SCOPE void TclAdvanceLines(Tcl_Size *line, const char *start,
const char *end);
@@ -3217,7 +3298,7 @@ MODULE_SCOPE void TclArgumentRelease(Tcl_Interp *interp,
Tcl_Obj *objv[], int objc);
MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp,
Tcl_Obj *objv[], int objc,
void *codePtr, CmdFrame *cfPtr, Tcl_Size cmd, Tcl_Size pc);
void *codePtr, CmdFrame *cfPtr, int cmd, Tcl_Size pc);
MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp,
CmdFrame *cfPtr);
MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
@@ -3226,6 +3307,7 @@ MODULE_SCOPE int TclAsyncNotifier(int sigNumber, Tcl_ThreadId threadId,
void *clientData, int *flagPtr, int value);
MODULE_SCOPE void TclAsyncMarkFromNotifier(void);
MODULE_SCOPE double TclBignumToDouble(const void *bignum);
MODULE_SCOPE void TclBounceRefCount(Tcl_Obj *objPtr);
MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string,
Tcl_Size strLen, const unsigned char *pattern,
Tcl_Size ptnLen, int flags);
@@ -3242,9 +3324,9 @@ MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble;
MODULE_SCOPE int TclCompareTwoNumbers(Tcl_Obj *valuePtr,
Tcl_Obj *value2Ptr);
MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, Tcl_Size num,
Tcl_Size *loc);
int *loc);
MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr,
Tcl_Size start, Tcl_Size *clNext);
int start, int *clNext);
MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr);
MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr,
Tcl_Obj *originObjPtr);
@@ -3259,7 +3341,8 @@ MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp,
Tcl_Namespace *ensembleNamespacePtr, int flags);
MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr);
MODULE_SCOPE void TclDeleteNamespaceChildren(Namespace *nsPtr);
MODULE_SCOPE Tcl_Size TclDictGetSize(Tcl_Obj *dictPtr);
MODULE_SCOPE Tcl_Obj* TclDuplicatePureObj(Tcl_Interp *interp,
Tcl_Obj * objPtr, const Tcl_ObjType *typPtr);
MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp,
const char *dict, Tcl_Size dictLength,
const char **elementPtr, const char **nextPtr,
@@ -3267,7 +3350,7 @@ MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp,
/* TIP #280 - Modified token based evaluation, with line information. */
MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script,
Tcl_Size numBytes, int flags, Tcl_Size line,
Tcl_Size *clNextOuter, const char *outerScript);
int *clNextOuter, const char *outerScript);
MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd;
@@ -3348,6 +3431,8 @@ MODULE_SCOPE int TclGetLoadedLibraries(Tcl_Interp *interp,
const char *packageName);
MODULE_SCOPE int TclGetWideBitsFromObj(Tcl_Interp *, Tcl_Obj *,
Tcl_WideInt *);
MODULE_SCOPE int TclIndexIsFromEnd(Tcl_Size encoded);
MODULE_SCOPE Tcl_Size TclIndexLast (Tcl_Size N);
MODULE_SCOPE int TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr,
Tcl_Obj *incrPtr);
MODULE_SCOPE Tcl_Obj * TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
@@ -3387,10 +3472,12 @@ MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp,
MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
Tcl_Size indexCount, Tcl_Obj *const indexArray[]);
MODULE_SCOPE Tcl_Obj * TclListObjGetElement(Tcl_Obj *listObj, Tcl_Size index);
MODULE_SCOPE int Tcl_LengthIsFinite(Tcl_Size length);
/* TIP #280 */
MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, Tcl_Size line, Tcl_Size n,
Tcl_Size *lines, Tcl_Obj *const *elems);
MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, Tcl_Size line, int n,
int *lines, Tcl_Obj *const *elems);
MODULE_SCOPE int (*TclObjInterfaceGetListIndex (Tcl_Obj *objPtr))
(tclObjTypeInterfaceArgsListIndex);
MODULE_SCOPE int TclListObjAppendElements(Tcl_Interp *interp,
Tcl_Obj *toObj, Tcl_Size elemCount,
Tcl_Obj *const elemObjv[]);
@@ -3398,9 +3485,9 @@ MODULE_SCOPE Tcl_Obj * TclListObjRange(Tcl_Interp *interp, Tcl_Obj *listPtr,
Tcl_Size fromIdx, Tcl_Size toIdx);
MODULE_SCOPE Tcl_Obj * TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
Tcl_Size indexCount, Tcl_Obj *const indexArray[],
Tcl_Obj *valuePtr);
MODULE_SCOPE Tcl_Obj * TclLsetFlat(tclObjTypeInterfaceArgsListSetList);
MODULE_SCOPE Tcl_Obj * TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name,
const EnsembleImplMap map[]);
MODULE_SCOPE int TclMakeSafe(Tcl_Interp *interp);
@@ -3413,6 +3500,9 @@ MODULE_SCOPE Tcl_Obj * TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options);
MODULE_SCOPE int TclNokia770Doubles(void);
MODULE_SCOPE void TclNsDecrRefCount(Namespace *nsPtr);
MODULE_SCOPE int TclNamespaceDeleted(Namespace *nsPtr);
MODULE_SCOPE Tcl_Obj * TclObjGetScalar(Tcl_Obj *objPtr);
MODULE_SCOPE const char * TclObjTypeName(const Tcl_ObjType *typePtr);
MODULE_SCOPE int TclObjTypeVersion (const Tcl_ObjType *typePtr);
MODULE_SCOPE void TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, const char *operation,
const char *reason, int index);
@@ -3438,11 +3528,6 @@ MODULE_SCOPE int TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
MODULE_SCOPE Tcl_Obj * TclpTempFileName(void);
MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp,
Tcl_Obj* pathPtr);
MODULE_SCOPE int TclNewArithSeriesObj(Tcl_Interp *interp, Tcl_Obj **arithSeriesPtr,
int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj,
Tcl_Obj *stepObj, Tcl_Obj *lenObj);
MODULE_SCOPE Tcl_Obj * TclNewStringListObj(Tcl_Interp *interp,
Tcl_Obj *srcStringObj);
MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep,
Tcl_Size len);
MODULE_SCOPE void TclpAlertNotifier(void *clientData);
@@ -3499,6 +3584,7 @@ MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep;
MODULE_SCOPE Tcl_Obj * TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
int linkType);
MODULE_SCOPE int TclpObjChdir(Tcl_Obj *pathPtr);
MODULE_SCOPE void Tcl_ObjTypeVersion(Tcl_Obj *objPtr, int *version);
MODULE_SCOPE Tcl_Channel TclpOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
Tcl_Obj *resultingNameObj);
@@ -3546,6 +3632,8 @@ MODULE_SCOPE int TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
MODULE_SCOPE int TclStringCmpOpts(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[], int *nocase,
Tcl_Size *reqlength);
MODULE_SCOPE int TclStringIndexInterface(Tcl_Interp *interp, Tcl_Obj *objPtr,
Tcl_Obj *indexPtr, Tcl_Obj **charPtr);
MODULE_SCOPE int TclStringMatch(const char *str, Tcl_Size strLen,
const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj,
@@ -3560,7 +3648,7 @@ MODULE_SCOPE void TclSubstParse(Tcl_Interp *interp, const char *bytes,
Tcl_InterpState *statePtr);
MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
Tcl_Size count, int *tokensLeftPtr, Tcl_Size line,
Tcl_Size *clNextOuter, const char *outerScript);
int *clNextOuter, const char *outerScript);
MODULE_SCOPE Tcl_Size TclTrim(const char *bytes, Tcl_Size numBytes,
const char *trim, Tcl_Size numTrim, Tcl_Size *trimRight);
MODULE_SCOPE Tcl_Size TclTrimLeft(const char *bytes, Tcl_Size numBytes,
@@ -3571,18 +3659,10 @@ MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command);
MODULE_SCOPE void TclRegisterCommandTypeName(
Tcl_ObjCmdProc *implementationProc,
const char *nameStr);
MODULE_SCOPE void TclUndoRefCount(Tcl_Obj *objPtr);
MODULE_SCOPE int TclUtfCmp(const char *cs, const char *ct);
MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct);
MODULE_SCOPE int TclUtfCount(int ch);
#if TCL_UTF_MAX > 3
# define TclUtfToUCS4 Tcl_UtfToUniChar
# define TclUniCharToUCS4(src, ptr) (*ptr = *(src),1)
# define TclUCS4Prev(src, ptr) (((src) > (ptr)) ? ((src) - 1) : (src))
#else
MODULE_SCOPE int TclUtfToUCS4(const char *, int *);
MODULE_SCOPE int TclUniCharToUCS4(const Tcl_UniChar *, int *);
MODULE_SCOPE const Tcl_UniChar *TclUCS4Prev(const Tcl_UniChar *, const Tcl_UniChar *);
#endif
MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(void *clientData);
MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr);
MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
@@ -4315,7 +4395,6 @@ MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options,
int *codePtr, Tcl_Obj **msgObjPtr,
Tcl_Obj **errorObjPtr);
MODULE_SCOPE int TclClose(Tcl_Interp *, Tcl_Channel chan);
/*
* TIP #508: [array default]
*/
@@ -4339,7 +4418,6 @@ MODULE_SCOPE int TclIndexInvalidError(Tcl_Interp *interp,
*/
MODULE_SCOPE int TclCommandWordLimitError(Tcl_Interp *interp, Tcl_Size count);
#endif /* TCL_MAJOR_VERSION > 8 */
/* Constants used in index value encoding routines. */
#define TCL_INDEX_END ((Tcl_Size)-2)
@@ -4852,17 +4930,10 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[];
*----------------------------------------------------------------
*/
#if TCL_UTF_MAX > 3
#define TclUtfToUniChar(str, chPtr) \
(((UCHAR(*(str))) < 0x80) ? \
((*(chPtr) = UCHAR(*(str))), 1) \
: Tcl_UtfToUniChar(str, chPtr))
#else
#define TclUtfToUniChar(str, chPtr) \
(((UCHAR(*(str))) < 0x80) ? \
((*(chPtr) = UCHAR(*(str))), 1) \
: Tcl_UtfToChar16(str, chPtr))
#endif
/*
*----------------------------------------------------------------
@@ -4925,7 +4996,7 @@ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr);
*----------------------------------------------------------------
*/
#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
#if defined(WORDS_BIGENDIAN)
# define TclUniCharNcmp(cs,ct,n) memcmp((cs),(ct),(n)*sizeof(Tcl_UniChar))
#endif /* WORDS_BIGENDIAN */
@@ -4971,8 +5042,8 @@ MODULE_SCOPE Tcl_LibraryInitProc TclObjTest_Init;
MODULE_SCOPE Tcl_LibraryInitProc TclThread_Init;
MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_Init;
MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;
MODULE_SCOPE Tcl_LibraryInitProc TcltestObjectInterfaceInit;
MODULE_SCOPE Tcl_LibraryInitProc TcltestObjectInterfaceListIntegerInit;
/*
*----------------------------------------------------------------
@@ -5003,7 +5074,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;
Tcl_ObjInternalRep ir; \
ir.wideValue = (Tcl_WideInt) i; \
TclInvalidateStringRep(objPtr); \
Tcl_StoreInternalRep(objPtr, &tclIntType, &ir); \
Tcl_StoreInternalRep(objPtr, tclIntType, &ir); \
} while (0)
#define TclSetDoubleObj(objPtr, d) \
@@ -5011,7 +5082,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;
Tcl_ObjInternalRep ir; \
ir.doubleValue = (double) d; \
TclInvalidateStringRep(objPtr); \
Tcl_StoreInternalRep(objPtr, &tclDoubleType, &ir); \
Tcl_StoreInternalRep(objPtr, tclDoubleType, &ir); \
} while (0)
/*
@@ -5022,7 +5093,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;
*
* MODULE_SCOPE void TclNewIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
* MODULE_SCOPE void TclNewDoubleObj(Tcl_Obj *objPtr, double d);
* MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, const char *s, Tcl_Size len);
* MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, const char *s, size_t len);
* MODULE_SCOPE void TclNewLiteralStringObj(Tcl_Obj*objPtr, const char *sLiteral);
*
*----------------------------------------------------------------
@@ -5036,7 +5107,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;
(objPtr)->refCount = 0; \
(objPtr)->bytes = NULL; \
(objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \
(objPtr)->typePtr = &tclIntType; \
(objPtr)->typePtr = tclIntType; \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
@@ -5055,13 +5126,13 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;
TclSetBignumInternalRep((objPtr), &bignumValue_); \
} else { \
(objPtr)->internalRep.wideValue = (Tcl_WideInt)(uw_); \
(objPtr)->typePtr = &tclIntType; \
(objPtr)->typePtr = tclIntType; \
} \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
#define TclNewIndexObj(objPtr, w) \
TclNewIntObj(objPtr, w)
#define TclNewIndexObj(objPtr, uw) \
TclNewIntObj(objPtr, uw)
#define TclNewDoubleObj(objPtr, d) \
do { \
@@ -5070,7 +5141,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;
(objPtr)->refCount = 0; \
(objPtr)->bytes = NULL; \
(objPtr)->internalRep.doubleValue = (double)(d); \
(objPtr)->typePtr = &tclDoubleType; \
(objPtr)->typePtr = tclDoubleType; \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
@@ -5331,7 +5402,7 @@ typedef struct NRE_callback {
#define TCLNR_FREE(interp, ptr) TclSmallFreeEx((interp), (ptr))
#else
#define TCLNR_ALLOC(interp, ptr) \
((ptr) = Tcl_Alloc(sizeof(NRE_callback)))
(ptr = (Tcl_Alloc(sizeof(NRE_callback))))
#define TCLNR_FREE(interp, ptr) Tcl_Free(ptr)
#endif
-9
View File
@@ -1281,15 +1281,6 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclStaticLibrary)
#endif /* defined(USE_TCL_STUBS) */
#if (TCL_MAJOR_VERSION < 9) && defined(USE_TCL_STUBS)
#undef TclpGetClicks
#define TclpGetClicks() \
((unsigned long)tclIntStubsPtr->tclpGetClicks())
#undef TclpGetSeconds
#define TclpGetSeconds() \
((unsigned long)tclIntStubsPtr->tclpGetSeconds())
#endif
#undef TclObjInterpProc
#define TclObjInterpProc TclGetObjInterpProc()
#define TclObjInterpProc2 TclGetObjInterpProc2()
+1 -544
View File
@@ -30,535 +30,6 @@
* in the generic/tclInt.decls script.
*/
#if TCL_MAJOR_VERSION < 9
#ifdef __cplusplus
extern "C" {
#endif
/*
* Exported function declarations:
*/
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
/* 0 */
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
Tcl_Channel chan);
/* 1 */
EXTERN int TclpCloseFile(TclFile file);
/* 2 */
EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
TclFile writeFile, TclFile errorFile,
int numPids, Tcl_Pid *pidPtr);
/* 3 */
EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 4 */
EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc,
const char **argv, TclFile inputFile,
TclFile outputFile, TclFile errorFile,
Tcl_Pid *pidPtr);
/* 5 */
EXTERN int TclUnixWaitForFile_(int fd, int mask, int timeout);
/* 6 */
EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction);
/* 7 */
EXTERN TclFile TclpOpenFile(const char *fname, int mode);
/* 8 */
EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile TclpCreateTempFile(const char *contents);
/* 10 */
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
/* 11 */
EXTERN struct tm * TclpLocaltime_unix(const time_t *clock);
/* 12 */
EXTERN struct tm * TclpGmtime_unix(const time_t *clock);
/* 13 */
EXTERN char * TclpInetNtoa(struct in_addr addr);
/* 14 */
EXTERN int TclUnixCopyFile(const char *src, const char *dst,
const Tcl_StatBuf *statBufPtr,
int dontCopyAtts);
/* 15 */
EXTERN int TclMacOSXGetFileAttribute(Tcl_Interp *interp,
int objIndex, Tcl_Obj *fileName,
Tcl_Obj **attributePtrPtr);
/* 16 */
EXTERN int TclMacOSXSetFileAttribute(Tcl_Interp *interp,
int objIndex, Tcl_Obj *fileName,
Tcl_Obj *attributePtr);
/* 17 */
EXTERN int TclMacOSXCopyFileAttributes(const char *src,
const char *dst,
const Tcl_StatBuf *statBufPtr);
/* 18 */
EXTERN int TclMacOSXMatchType(Tcl_Interp *interp,
const char *pathName, const char *fileName,
Tcl_StatBuf *statBufPtr,
Tcl_GlobTypeData *types);
/* 19 */
EXTERN void TclMacOSXNotifierAddRunLoopMode(
const void *runLoopMode);
/* Slot 20 is reserved */
/* Slot 21 is reserved */
/* 22 */
EXTERN TclFile TclpCreateTempFile_(const char *contents);
/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* Slot 28 is reserved */
/* 29 */
EXTERN int TclWinCPUID(int index, int *regs);
/* 30 */
EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
Tcl_Obj *resultingNameObj);
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
EXTERN void TclWinConvertError(DWORD errCode);
/* 1 */
EXTERN void TclWinConvertWSAError(DWORD errCode);
/* 2 */
EXTERN struct servent * TclWinGetServByName(const char *nm,
const char *proto);
/* 3 */
EXTERN int TclWinGetSockOpt(SOCKET s, int level, int optname,
char *optval, int *optlen);
/* 4 */
EXTERN HINSTANCE TclWinGetTclInstance(void);
/* 5 */
EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
/* 6 */
EXTERN unsigned short TclWinNToHS(unsigned short ns);
/* 7 */
EXTERN int TclWinSetSockOpt(SOCKET s, int level, int optname,
const char *optval, int optlen);
/* 8 */
EXTERN int TclpGetPid(Tcl_Pid pid);
/* 9 */
EXTERN int TclWinGetPlatformId(void);
/* 11 */
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
Tcl_Channel chan);
/* 12 */
EXTERN int TclpCloseFile(TclFile file);
/* 13 */
EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
TclFile writeFile, TclFile errorFile,
int numPids, Tcl_Pid *pidPtr);
/* 14 */
EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 15 */
EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc,
const char **argv, TclFile inputFile,
TclFile outputFile, TclFile errorFile,
Tcl_Pid *pidPtr);
/* 16 */
EXTERN int TclpIsAtty(int fd);
/* 17 */
EXTERN int TclUnixCopyFile(const char *src, const char *dst,
const Tcl_StatBuf *statBufPtr,
int dontCopyAtts);
/* 18 */
EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction);
/* 19 */
EXTERN TclFile TclpOpenFile(const char *fname, int mode);
/* 20 */
EXTERN void TclWinAddProcess(void *hProcess, Tcl_Size id);
/* 21 */
EXTERN char * TclpInetNtoa(struct in_addr addr);
/* 22 */
EXTERN TclFile TclpCreateTempFile(const char *contents);
/* Slot 23 is reserved */
/* 24 */
EXTERN char * TclWinNoBackslash(char *path);
/* Slot 25 is reserved */
/* 26 */
EXTERN void TclWinSetInterfaces(int wide);
/* 27 */
EXTERN void TclWinFlushDirtyChannels(void);
/* 28 */
EXTERN void TclWinResetInterfaces(void);
/* 29 */
EXTERN int TclWinCPUID(int index, int *regs);
/* 30 */
EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
Tcl_Obj *resultingNameObj);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 0 */
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
Tcl_Channel chan);
/* 1 */
EXTERN int TclpCloseFile(TclFile file);
/* 2 */
EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
TclFile writeFile, TclFile errorFile,
int numPids, Tcl_Pid *pidPtr);
/* 3 */
EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 4 */
EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc,
const char **argv, TclFile inputFile,
TclFile outputFile, TclFile errorFile,
Tcl_Pid *pidPtr);
/* 5 */
EXTERN int TclUnixWaitForFile_(int fd, int mask, int timeout);
/* 6 */
EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction);
/* 7 */
EXTERN TclFile TclpOpenFile(const char *fname, int mode);
/* 8 */
EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile TclpCreateTempFile(const char *contents);
/* 10 */
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
/* 11 */
EXTERN struct tm * TclpLocaltime_unix(const time_t *clock);
/* 12 */
EXTERN struct tm * TclpGmtime_unix(const time_t *clock);
/* 13 */
EXTERN char * TclpInetNtoa(struct in_addr addr);
/* 14 */
EXTERN int TclUnixCopyFile(const char *src, const char *dst,
const Tcl_StatBuf *statBufPtr,
int dontCopyAtts);
/* 15 */
EXTERN int TclMacOSXGetFileAttribute(Tcl_Interp *interp,
int objIndex, Tcl_Obj *fileName,
Tcl_Obj **attributePtrPtr);
/* 16 */
EXTERN int TclMacOSXSetFileAttribute(Tcl_Interp *interp,
int objIndex, Tcl_Obj *fileName,
Tcl_Obj *attributePtr);
/* 17 */
EXTERN int TclMacOSXCopyFileAttributes(const char *src,
const char *dst,
const Tcl_StatBuf *statBufPtr);
/* 18 */
EXTERN int TclMacOSXMatchType(Tcl_Interp *interp,
const char *pathName, const char *fileName,
Tcl_StatBuf *statBufPtr,
Tcl_GlobTypeData *types);
/* 19 */
EXTERN void TclMacOSXNotifierAddRunLoopMode(
const void *runLoopMode);
/* Slot 20 is reserved */
/* Slot 21 is reserved */
/* 22 */
EXTERN TclFile TclpCreateTempFile_(const char *contents);
/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* Slot 28 is reserved */
/* 29 */
EXTERN int TclWinCPUID(int index, int *regs);
/* 30 */
EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
Tcl_Obj *resultingNameObj);
#endif /* MACOSX */
typedef struct TclIntPlatStubs {
int magic;
void *hooks;
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
int (*tclpCloseFile) (TclFile file); /* 1 */
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
int (*tclUnixWaitForFile_) (int fd, int mask, int timeout); /* 5 */
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */
int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */
void (*reserved20)(void);
void (*reserved21)(void);
TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */
void (*reserved23)(void);
void (*reserved24)(void);
void (*reserved25)(void);
void (*reserved26)(void);
void (*reserved27)(void);
void (*reserved28)(void);
int (*tclWinCPUID) (int index, int *regs); /* 29 */
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
void (*tclWinConvertError) (DWORD errCode); /* 0 */
void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */
struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */
int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */
HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */
int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */
Tcl_Size (*tclpGetPid) (Tcl_Pid pid); /* 8 */
int (*tclWinGetPlatformId) (void); /* 9 */
void *(*tclpReaddir) (void *dir); /* 10 */
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
int (*tclpCloseFile) (TclFile file); /* 12 */
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */
int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
int (*tclpIsAtty) (int fd); /* 16 */
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
void (*tclWinAddProcess) (void *hProcess, Tcl_Size id); /* 20 */
char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */
TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
void (*reserved23)(void);
char * (*tclWinNoBackslash) (char *path); /* 24 */
void (*reserved25)(void);
void (*tclWinSetInterfaces) (int wide); /* 26 */
void (*tclWinFlushDirtyChannels) (void); /* 27 */
void (*tclWinResetInterfaces) (void); /* 28 */
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 */
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
int (*tclpCloseFile) (TclFile file); /* 1 */
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
int (*tclUnixWaitForFile_) (int fd, int mask, int timeout); /* 5 */
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */
int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */
void (*reserved20)(void);
void (*reserved21)(void);
TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */
void (*reserved23)(void);
void (*reserved24)(void);
void (*reserved25)(void);
void (*reserved26)(void);
void (*reserved27)(void);
void (*reserved28)(void);
int (*tclWinCPUID) (int index, int *regs); /* 29 */
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* MACOSX */
} TclIntPlatStubs;
extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#ifdef __cplusplus
}
#endif
#if defined(USE_TCL_STUBS)
/*
* Inline function declarations:
*/
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
#define TclGetAndDetachPids \
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
#define TclpCloseFile \
(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
#define TclpCreateCommandChannel \
(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
#define TclpCreatePipe \
(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
#define TclpCreateProcess \
(tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
#define TclUnixWaitForFile_ \
(tclIntPlatStubsPtr->tclUnixWaitForFile_) /* 5 */
#define TclpMakeFile \
(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
#define TclpOpenFile \
(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
#define TclUnixWaitForFile \
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#define TclpCreateTempFile \
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
#define TclpReaddir \
(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
#define TclpLocaltime_unix \
(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
#define TclpGmtime_unix \
(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
#define TclpInetNtoa \
(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
#define TclUnixCopyFile \
(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
#define TclMacOSXGetFileAttribute \
(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
#define TclMacOSXSetFileAttribute \
(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
#define TclMacOSXCopyFileAttributes \
(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */
#define TclMacOSXMatchType \
(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
#define TclMacOSXNotifierAddRunLoopMode \
(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
/* Slot 20 is reserved */
/* Slot 21 is reserved */
#define TclpCreateTempFile_ \
(tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */
/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* Slot 28 is reserved */
#define TclWinCPUID \
(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
#define TclWinConvertError \
(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
#define TclWinConvertWSAError \
(tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */
#define TclWinGetServByName \
(tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */
#define TclWinGetSockOpt \
(tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */
#define TclWinGetTclInstance \
(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
#define TclUnixWaitForFile \
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
#define TclWinNToHS \
(tclIntPlatStubsPtr->tclWinNToHS) /* 6 */
#define TclWinSetSockOpt \
(tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */
#define TclpGetPid \
(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
#define TclWinGetPlatformId \
(tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */
#define TclGetAndDetachPids \
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
#define TclpCloseFile \
(tclIntPlatStubsPtr->tclpCloseFile) /* 12 */
#define TclpCreateCommandChannel \
(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 13 */
#define TclpCreatePipe \
(tclIntPlatStubsPtr->tclpCreatePipe) /* 14 */
#define TclpCreateProcess \
(tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */
#define TclpIsAtty \
(tclIntPlatStubsPtr->tclpIsAtty) /* 16 */
#define TclUnixCopyFile \
(tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */
#define TclpMakeFile \
(tclIntPlatStubsPtr->tclpMakeFile) /* 18 */
#define TclpOpenFile \
(tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
#define TclWinAddProcess \
(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
#define TclpInetNtoa \
(tclIntPlatStubsPtr->tclpInetNtoa) /* 21 */
#define TclpCreateTempFile \
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
/* Slot 23 is reserved */
#define TclWinNoBackslash \
(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
/* Slot 25 is reserved */
#define TclWinSetInterfaces \
(tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */
#define TclWinFlushDirtyChannels \
(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
#define TclWinResetInterfaces \
(tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */
#define TclWinCPUID \
(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
#define TclGetAndDetachPids \
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
#define TclpCloseFile \
(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
#define TclpCreateCommandChannel \
(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
#define TclpCreatePipe \
(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
#define TclpCreateProcess \
(tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
#define TclUnixWaitForFile_ \
(tclIntPlatStubsPtr->tclUnixWaitForFile_) /* 5 */
#define TclpMakeFile \
(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
#define TclpOpenFile \
(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
#define TclUnixWaitForFile \
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#define TclpCreateTempFile \
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
#define TclpReaddir \
(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
#define TclpLocaltime_unix \
(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
#define TclpGmtime_unix \
(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
#define TclpInetNtoa \
(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
#define TclUnixCopyFile \
(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
#define TclMacOSXGetFileAttribute \
(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
#define TclMacOSXSetFileAttribute \
(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
#define TclMacOSXCopyFileAttributes \
(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */
#define TclMacOSXMatchType \
(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
#define TclMacOSXNotifierAddRunLoopMode \
(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
/* Slot 20 is reserved */
/* Slot 21 is reserved */
#define TclpCreateTempFile_ \
(tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */
/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* Slot 28 is reserved */
#define TclWinCPUID \
(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* MACOSX */
#endif /* defined(USE_TCL_STUBS) */
#else /* TCL_MAJOR_VERSION > 8 */
/* !BEGIN!: Do not edit below this line. */
#ifdef __cplusplus
@@ -731,7 +202,6 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#endif /* defined(USE_TCL_STUBS) */
/* !END!: Do not edit above this line. */
#endif /* TCL_MAJOR_VERSION */
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
@@ -739,17 +209,13 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#undef TclpGmtime_unix
#undef TclWinConvertWSAError
#define TclWinConvertWSAError TclWinConvertError
#if !defined(TCL_USE_STUBS) && !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
# undef TclWinConvertError
# define TclWinConvertError Tcl_WinConvertError
#endif
#undef TclpInetNtoa
#define TclpInetNtoa inet_ntoa
#undef TclpCreateTempFile_
#undef TclUnixWaitForFile_
#ifdef MAC_OSX_TCL /* not accessible on Win32/UNIX */
#ifdef MAC_OSX_TCL /* not accessable on Win32/UNIX */
MODULE_SCOPE int TclMacOSXGetFileAttribute(Tcl_Interp *interp,
int objIndex, Tcl_Obj *fileName,
Tcl_Obj **attributePtrPtr);
@@ -782,15 +248,6 @@ MODULE_SCOPE int TclMacOSXMatchType(Tcl_Interp *interp,
# undef TclWinGetPlatformId
# undef TclWinResetInterfaces
# undef TclWinSetInterfaces
# if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
# define TclWinNToHS ntohs
# define TclWinGetServByName getservbyname
# define TclWinGetSockOpt getsockopt
# define TclWinSetSockOpt setsockopt
# define TclWinGetPlatformId() (2) /* VER_PLATFORM_WIN32_NT */
# define TclWinResetInterfaces() /* nop */
# define TclWinSetInterfaces(dummy) /* nop */
# endif /* TCL_NO_DEPRECATED */
#else
# undef TclpGetPid
# define TclpGetPid(pid) ((size_t)(pid))
-6
View File
@@ -624,9 +624,7 @@ NRInterpCmd(
"hidden", "issafe", "invokehidden",
"limit", "marktrusted", "recursionlimit",
"share",
#ifndef TCL_NO_DEPRECATED
"slaves",
#endif
"target", "transfer", NULL
};
static const char *const optionsNoSlaves[] = {
@@ -644,9 +642,7 @@ NRInterpCmd(
OPT_EVAL, OPT_EXISTS, OPT_EXPOSE, OPT_HIDE,
OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHID,
OPT_LIMIT, OPT_MARKTRUSTED, OPT_RECLIMIT, OPT_SHARE,
#ifndef TCL_NO_DEPRECATED
OPT_SLAVES,
#endif
OPT_TARGET, OPT_TRANSFER
} index;
@@ -1033,9 +1029,7 @@ NRInterpCmd(
return TCL_ERROR;
}
return ChildRecursionLimit(interp, childInterp, objc - 3, objv + 3);
#ifndef TCL_NO_DEPRECATED
case OPT_SLAVES:
#endif
case OPT_CHILDREN: {
InterpInfo *iiPtr;
Tcl_Obj *resultPtr;
+1 -17
View File
@@ -179,14 +179,6 @@ Tcl_LinkVar(
Tcl_IncrRefCount(linkPtr->varName);
linkPtr->addr = addr;
linkPtr->type = type & ~TCL_LINK_READ_ONLY;
#if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \
|| defined(_WIN32) || defined(__CYGWIN__))
if (linkPtr->type == 11 /* legacy TCL_LINK_LONG */) {
linkPtr->type = TCL_LINK_LONG;
} else if (linkPtr->type == 12 /* legacy TCL_LINK_ULONG */) {
linkPtr->type = TCL_LINK_ULONG;
}
#endif
if (type & TCL_LINK_READ_ONLY) {
linkPtr->flags = LINK_READ_ONLY;
} else {
@@ -262,14 +254,6 @@ Tcl_LinkArray(
linkPtr = (Link *)Tcl_Alloc(sizeof(Link));
linkPtr->type = type & ~TCL_LINK_READ_ONLY;
#if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \
|| defined(_WIN32) || defined(__CYGWIN__))
if (linkPtr->type == 11 /* legacy TCL_LINK_LONG */) {
linkPtr->type = TCL_LINK_LONG;
} else if (linkPtr->type == 12 /* legacy TCL_LINK_ULONG */) {
linkPtr->type = TCL_LINK_ULONG;
}
#endif
linkPtr->numElems = size;
if (type & TCL_LINK_READ_ONLY) {
linkPtr->flags = LINK_READ_ONLY;
@@ -547,7 +531,7 @@ GetDouble(
return 0;
} else {
#ifdef ACCEPT_NAN
Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &tclDoubleType);
Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, tclDoubleType);
if (irPtr != NULL) {
*dblPtr = irPtr->doubleValue;
+539 -395
View File
File diff suppressed because it is too large Load Diff
+1 -1
View File
@@ -395,7 +395,7 @@ Tcl_PopCallFrame(
Tcl_Free(framePtr->varTablePtr);
framePtr->varTablePtr = NULL;
}
if (framePtr->numCompiledLocals > 0) {
if (framePtr->numCompiledLocals + 1 > 1) {
TclDeleteCompiledLocalVars(iPtr, framePtr);
if (framePtr->localCachePtr->refCount-- <= 1) {
TclFreeLocalCache(interp, framePtr->localCachePtr);
-7
View File
@@ -138,9 +138,6 @@ static const Tcl_MethodType classConstructor = {
*/
static const char initScript[] =
#ifndef TCL_NO_DEPRECATED
"package ifneeded TclOO " TCLOO_PATCHLEVEL " {# Already present, OK?};"
#endif
"package ifneeded tcl::oo " TCLOO_PATCHLEVEL " {# Already present, OK?};"
"namespace eval ::oo { variable version " TCLOO_VERSION " };"
"namespace eval ::oo { variable patchlevel " TCLOO_PATCHLEVEL " };";
@@ -260,10 +257,6 @@ TclOOInit(
return TCL_ERROR;
}
#ifndef TCL_NO_DEPRECATED
Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,
&tclOOStubs);
#endif
return Tcl_PkgProvideEx(interp, "tcl::oo", TCLOO_PATCHLEVEL,
&tclOOStubs);
}
+2 -2
View File
@@ -588,7 +588,7 @@ TclOOMakeProcInstanceMethod(
cfPtr->level = -1;
cfPtr->type = context.type;
cfPtr->line = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size));
cfPtr->line = (int *)Tcl_Alloc(sizeof(int));
cfPtr->line[0] = context.line[3];
cfPtr->nline = 1;
cfPtr->framePtr = NULL;
@@ -701,7 +701,7 @@ TclOOMakeProcMethod(
cfPtr->level = -1;
cfPtr->type = context.type;
cfPtr->line = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size));
cfPtr->line = (int *)Tcl_Alloc(sizeof(int));
cfPtr->line[0] = context.line[3];
cfPtr->nline = 1;
cfPtr->framePtr = NULL;
+5 -6
View File
@@ -164,13 +164,12 @@ static const char *tclOOSetupScript =
"\t\tmethod -appendifnew -export args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
"\t\t\tforeach a $args {\n"
"\t\t\tset args [lmap a $args {\n"
"\t\t\t\tset a [uplevel 1 [list $my Resolve $a]]\n"
"\t\t\t\tif {$a ni $current} {\n"
"\t\t\t\t\tlappend current $a\n"
"\t\t\t\t}\n"
"\t\t\t}\n"
"\t\t\ttailcall my Set $current\n"
"\t\t\t\tif {$a in $current} continue\n"
"\t\t\t\tset a\n"
"\t\t\t}]\n"
"\t\t\ttailcall my Set [list {*}$current {*}$args]\n"
"\t\t}\n"
"\t\tmethod -clear -export {} {tailcall my Set {}}\n"
"\t\tmethod -prepend -export args {\n"
+338 -119
View File
@@ -9,6 +9,7 @@
* Copyright © 2001 ActiveState Corporation.
* Copyright © 2005 Kevin B. Kenny. All rights reserved.
* Copyright © 2007 Daniel A. Steffen <das@users.sourceforge.net>
* Copyright © 2021 Nathan Coulter. All rights reserved.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -19,6 +20,7 @@
#include <math.h>
#include <assert.h>
/*
* Table of all object types.
*/
@@ -27,6 +29,10 @@ static Tcl_HashTable typeTable;
static int typeTableInitialized = 0; /* 0 means not yet initialized. */
TCL_DECLARE_MUTEX(tableMutex)
TclObjectTypeType TclObjectTypeType0 = {
(int *)1
};
/*
* Head of the list of free Tcl_Obj structs we maintain.
*/
@@ -202,6 +208,9 @@ static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static void UpdateStringOfBignum(Tcl_Obj *objPtr);
static int GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
int copy, mp_int *bignumValue);
static int SetDuplicatePureObj(Tcl_Interp *interp,
Tcl_Obj *dupPtr, Tcl_Obj *objPtr,
const Tcl_ObjType *typePtr);
/*
* Prototypes for the array hash key methods.
@@ -218,6 +227,32 @@ static void DupCmdNameInternalRep(Tcl_Obj *objPtr,
static void FreeCmdNameInternalRep(Tcl_Obj *objPtr);
static int SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static int ScalarObjIndex(tclObjTypeInterfaceArgsListIndex);
static int ScalarObjInterfaceListLength(tclObjTypeInterfaceArgsListLength);
static Tcl_Obj* ScalarObjRange(tclObjTypeInterfaceArgsListRange);
ObjInterface tclScalarInterface = {
1,
{},
{
NULL,
NULL, /* append */
NULL, /* appendList */
&ScalarObjIndex, /* index */
NULL, /* indexEnd */
NULL, /* isSorted */
&ScalarObjInterfaceListLength, /* length */
&ScalarObjRange, /* range */
NULL, /* rangeEnd */
NULL, /* replace */
NULL, /* replaceList */
NULL, /* reverse */
NULL, /* set */
NULL, /* setList */
},
};
/*
* The structures below defines the Tcl object types defined in this file by
* means of functions that can be invoked by generic object code. See also
@@ -225,39 +260,55 @@ static int SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
* implementations.
*/
const Tcl_ObjType tclBooleanType= {
const ObjectType tclBooleanObjType= {
"boolean", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
TclSetBooleanFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V1(TclLengthOne)
TclSetBooleanFromAny, /* setFromAnyProc */
2,
(Tcl_ObjInterface *)&tclScalarInterface
};
const Tcl_ObjType tclDoubleType= {
MODULE_SCOPE const Tcl_ObjType *tclBooleanType = (Tcl_ObjType *)&tclBooleanObjType;
const ObjectType tclDoubleObjType= {
"double", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfDouble, /* updateStringProc */
SetDoubleFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V1(TclLengthOne)
2,
(Tcl_ObjInterface *)&tclScalarInterface
};
const Tcl_ObjType tclIntType = {
MODULE_SCOPE const Tcl_ObjType *tclDoubleType = (Tcl_ObjType *)&tclDoubleObjType;
const ObjectType tclIntObjType = {
"int", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfInt, /* updateStringProc */
SetIntFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V1(TclLengthOne)
2,
(Tcl_ObjInterface *)&tclScalarInterface
};
const Tcl_ObjType tclBignumType = {
MODULE_SCOPE const Tcl_ObjType *tclIntType = (Tcl_ObjType *)&tclIntObjType;
const ObjectType tclBignumObjType = {
"bignum", /* name */
FreeBignum, /* freeIntRepProc */
DupBignum, /* dupIntRepProc */
UpdateStringOfBignum, /* updateStringProc */
NULL, /* setFromAnyProc */
TCL_OBJTYPE_V1(TclLengthOne)
2,
(Tcl_ObjInterface *)&tclScalarInterface
};
MODULE_SCOPE const Tcl_ObjType *tclBignumType = (Tcl_ObjType *)&tclBignumObjType;
/*
* The structure below defines the Tcl obj hash key type.
*/
@@ -300,7 +351,7 @@ Tcl_ObjType tclCmdNameType = {
DupCmdNameInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
SetCmdNameFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V0
0
};
/*
@@ -377,24 +428,15 @@ TclInitObjSubsystem(void)
Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS);
Tcl_MutexUnlock(&tableMutex);
Tcl_RegisterObjType(&tclDoubleType);
Tcl_RegisterObjType(tclDoubleType);
Tcl_RegisterObjType(&tclStringType);
Tcl_RegisterObjType(&tclListType);
Tcl_RegisterObjType(tclListType);
Tcl_RegisterObjType(&tclDictType);
Tcl_RegisterObjType(&tclByteCodeType);
Tcl_RegisterObjType(&tclCmdNameType);
Tcl_RegisterObjType(&tclRegexpType);
Tcl_RegisterObjType(&tclProcBodyType);
/* For backward compatibility only ... */
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
Tcl_RegisterObjType(&tclIntType);
#if !defined(TCL_WIDE_INT_IS_LONG)
Tcl_RegisterObjType(&oldIntType);
#endif
Tcl_RegisterObjType(&oldBooleanType);
#endif
#ifdef TCL_COMPILE_STATS
Tcl_MutexLock(&tclObjMutex);
tclObjsAlloced = 0;
@@ -552,13 +594,13 @@ ContLineLoc *
TclContinuationsEnter(
Tcl_Obj *objPtr,
Tcl_Size num,
Tcl_Size *loc)
int *loc)
{
int newEntry;
ThreadSpecificData *tsdPtr = TclGetContLineTable();
Tcl_HashEntry *hPtr =
Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
ContLineLoc *clLocPtr = (ContLineLoc *)Tcl_Alloc(offsetof(ContLineLoc, loc) + (num + 1U) *sizeof(Tcl_Size));
ContLineLoc *clLocPtr = (ContLineLoc *)Tcl_Alloc(offsetof(ContLineLoc, loc) + (num + 1U) *sizeof(int));
if (!newEntry) {
/*
@@ -586,7 +628,7 @@ TclContinuationsEnter(
}
clLocPtr->num = num;
memcpy(&clLocPtr->loc, loc, num*sizeof(Tcl_Size));
memcpy(&clLocPtr->loc, loc, num*sizeof(int));
clLocPtr->loc[num] = CLL_END; /* Sentinel */
Tcl_SetHashValue(hPtr, clLocPtr);
@@ -615,12 +657,12 @@ TclContinuationsEnter(
void
TclContinuationsEnterDerived(
Tcl_Obj *objPtr,
Tcl_Size start,
Tcl_Size *clNext)
int start,
int *clNext)
{
Tcl_Size length;
Tcl_Size end, num;
Tcl_Size *wordCLLast = clNext;
int end, num;
int *wordCLLast = clNext;
/*
* We have to handle invisible continuations lines here as well, despite
@@ -663,7 +705,7 @@ TclContinuationsEnterDerived(
num = wordCLLast - clNext;
if (num) {
Tcl_Size i;
int i;
ContLineLoc *clLocPtr = TclContinuationsEnter(objPtr, num, clNext);
/*
@@ -814,6 +856,25 @@ TclThreadFinalizeContLines(
*--------------------------------------------------------------
*/
int TclObjTypeVersion (
const Tcl_ObjType *typePtr)
{
ObjectType *otPtr = (ObjectType *)typePtr;
if ((void *)otPtr->name == (void *)&TclObjectTypeType0) {
return otPtr->version;
}
return 1;
}
const char *TclObjTypeName(
const Tcl_ObjType *typePtr)
{
ObjectType *otPtr = (ObjectType *)typePtr;
return otPtr->name;
}
void
Tcl_RegisterObjType(
const Tcl_ObjType *typePtr) /* Information about object type; storage must
@@ -823,8 +884,9 @@ Tcl_RegisterObjType(
int isNew;
Tcl_MutexLock(&tableMutex);
const char *name = TclObjTypeName(typePtr);
Tcl_SetHashValue(
Tcl_CreateHashEntry(&typeTable, typePtr->name, &isNew), typePtr);
Tcl_CreateHashEntry(&typeTable, name, &isNew), typePtr);
Tcl_MutexUnlock(&tableMutex);
}
@@ -950,7 +1012,7 @@ Tcl_ConvertToType(
}
/*
* Use the target type's Tcl_SetFromAnyProc to set "objPtr"s internal form
* Use the target type's setFromAnyProc to set "objPtr"s internal form
* as appropriate for the target type. This frees the old internal
* representation.
*/
@@ -1526,6 +1588,14 @@ TclObjBeingDeleted(
* Create and return a new object that is a duplicate of the argument
* object.
*
* TclDuplicatePureObj --
* Like Tcl_DuplicateObj, except that it converts the duplicate to the
* specifid typ, does not duplicate the 'bytes'
* field unless it is necessary, i.e. the duplicated Tcl_Obj provides no
* updateStringProc. This can avoid an expensive memory allocation since
* the data in the 'bytes' field of each Tcl_Obj must reside in allocated
* memory.
*
* Results:
* The return value is a pointer to a newly created Tcl_Obj. This object
* has reference count 0 and the same type, if any, as the source object
@@ -1577,6 +1647,111 @@ Tcl_DuplicateObj(
return dupPtr;
}
/*
*----------------------------------------------------------------------
*
* TclDuplicatePureObj --
*
* Duplicates a Tcl_Obj and converts the internal representation of the
* duplicate to the given type, changing neither the 'bytes' field
* nor the internal representation of the original object, and without
* duplicating the bytes field unless necessary, i.e. unless the
* duplicate provides no updateStringProc after conversion. This can
* avoid an expensive memory allocation since the data in the 'bytes'
* field of each Tcl_Obj must reside in allocated memory.
*
* Results:
* A pointer to a newly-created Tcl_Obj or NULL if there was an error.
* This object has reference count 0. Also:
*
*----------------------------------------------------------------------
*/
int SetDuplicatePureObj(
Tcl_Interp *interp,
Tcl_Obj *dupPtr,
Tcl_Obj *objPtr,
const Tcl_ObjType *typePtr)
{
char *bytes = objPtr->bytes;
int status = TCL_OK;
TclInvalidateStringRep(dupPtr);
assert(dupPtr->typePtr == NULL);
if (objPtr->typePtr && objPtr->typePtr->dupIntRepProc) {
objPtr->typePtr->dupIntRepProc(objPtr, dupPtr);
} else {
dupPtr->internalRep = objPtr->internalRep;
dupPtr->typePtr = objPtr->typePtr;
}
if (typePtr != NULL && dupPtr->typePtr != typePtr) {
if (bytes) {
dupPtr->bytes = bytes;
dupPtr->length = objPtr->length;
}
/* borrow bytes from original object */
status = Tcl_ConvertToType(interp, dupPtr, typePtr);
if (bytes) {
dupPtr->bytes = NULL;
dupPtr->length = 0;
}
if (status != TCL_OK) {
return status;
}
}
/* tclStringType is treated as a special case because a Tcl_Obj having this
* type can not always update the string representation. This happens, for
* example, when Tcl_GetCharLength() converts the internal representation
* to tclStringType in order to store the number of characters, but does
* not store enough information to generate the string representation.
*
* Perhaps in the future this can be remedied and this special treatment
* removed.
*/
if (bytes && (dupPtr->typePtr == NULL
|| dupPtr->typePtr->updateStringProc == NULL
|| typePtr == &tclStringType
)
) {
if (!TclAttemptInitStringRep(dupPtr, bytes, objPtr->length)) {
if (interp) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"insufficient memory to initialize string", -1));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
status = TCL_ERROR;
}
}
return status;
}
Tcl_Obj *
TclDuplicatePureObj(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
const Tcl_ObjType *typePtr
) /* The object to duplicate. */
{
int status;
Tcl_Obj *dupPtr;
TclNewObj(dupPtr);
status = SetDuplicatePureObj(interp, dupPtr, objPtr, typePtr);
if (status == TCL_OK) {
return dupPtr;
} else {
Tcl_DecrRefCount(dupPtr);
return NULL;
}
}
void
TclSetDuplicateObj(
Tcl_Obj *dupPtr,
@@ -1668,52 +1843,7 @@ Tcl_GetString(
*----------------------------------------------------------------------
*/
#if !defined(TCL_NO_DEPRECATED)
char *
TclGetStringFromObj(
Tcl_Obj *objPtr, /* Object whose string rep byte pointer should
* be returned. */
void *lengthPtr) /* If non-NULL, the location where the string
* rep's byte array length should * be stored.
* If NULL, no length is stored. */
{
if (objPtr->bytes == NULL) {
/*
* Note we do not check for objPtr->typePtr == NULL. An invariant
* of a properly maintained Tcl_Obj is that at least one of
* objPtr->bytes and objPtr->typePtr must not be NULL. If broken
* extensions fail to maintain that invariant, we can crash here.
*/
if (objPtr->typePtr->updateStringProc == NULL) {
/*
* Those Tcl_ObjTypes which choose not to define an
* updateStringProc must be written in such a way that
* (objPtr->bytes) never becomes NULL.
*/
Tcl_Panic("UpdateStringProc should not be invoked for type %s",
objPtr->typePtr->name);
}
objPtr->typePtr->updateStringProc(objPtr);
if (objPtr->bytes == NULL || objPtr->length == TCL_INDEX_NONE
|| objPtr->bytes[objPtr->length] != '\0') {
Tcl_Panic("UpdateStringProc for type '%s' "
"failed to create a valid string rep",
objPtr->typePtr->name);
}
}
if (lengthPtr != NULL) {
if (objPtr->length > INT_MAX) {
Tcl_Panic("Tcl_GetStringFromObj with 'int' lengthPtr"
" cannot handle such long strings. Please use 'Tcl_Size'");
}
*(int *)lengthPtr = (int)objPtr->length;
}
return objPtr->bytes;
}
#endif /* !defined(TCL_NO_DEPRECATED) */
#undef Tcl_GetStringFromObj
char *
Tcl_GetStringFromObj(
Tcl_Obj *objPtr, /* Object whose string rep byte pointer should
@@ -2007,7 +2137,6 @@ Tcl_FreeInternalRep(
*----------------------------------------------------------------------
*/
#undef Tcl_GetBoolFromObj
int
Tcl_GetBoolFromObj(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
@@ -2030,11 +2159,11 @@ Tcl_GetBoolFromObj(
return TCL_ERROR;
}
do {
if (objPtr->typePtr == &tclIntType || objPtr->typePtr == &tclBooleanType) {
if (objPtr->typePtr == tclIntType || objPtr->typePtr == tclBooleanType) {
result = (objPtr->internalRep.wideValue != 0);
goto boolEnd;
}
if (objPtr->typePtr == &tclDoubleType) {
if (objPtr->typePtr == tclDoubleType) {
/*
* Caution: Don't be tempted to check directly for the "double"
* Tcl_ObjType and then compare the internalrep to 0.0. This isn't
@@ -2051,7 +2180,7 @@ Tcl_GetBoolFromObj(
result = (d != 0.0);
goto boolEnd;
}
if (objPtr->typePtr == &tclBignumType) {
if (objPtr->typePtr == tclBignumType) {
result = 1;
boolEnd:
if (charPtr != NULL) {
@@ -2077,7 +2206,6 @@ Tcl_GetBoolFromObj(
return TCL_ERROR;
}
#undef Tcl_GetBooleanFromObj
int
Tcl_GetBooleanFromObj(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
@@ -2119,18 +2247,18 @@ TclSetBooleanFromAny(
*/
if (objPtr->bytes == NULL) {
if (objPtr->typePtr == &tclIntType) {
if (objPtr->typePtr == tclIntType) {
if ((Tcl_WideUInt)objPtr->internalRep.wideValue < 2) {
return TCL_OK;
}
goto badBoolean;
}
if (objPtr->typePtr == &tclBignumType) {
if (objPtr->typePtr == tclBignumType) {
goto badBoolean;
}
if (objPtr->typePtr == &tclDoubleType) {
if (objPtr->typePtr == tclDoubleType) {
goto badBoolean;
}
}
@@ -2261,13 +2389,13 @@ ParseBoolean(
goodBoolean:
TclFreeInternalRep(objPtr);
objPtr->internalRep.wideValue = newBool;
objPtr->typePtr = &tclBooleanType;
objPtr->typePtr = tclBooleanType;
return TCL_OK;
numericBoolean:
TclFreeInternalRep(objPtr);
objPtr->internalRep.wideValue = newBool;
objPtr->typePtr = &tclIntType;
objPtr->typePtr = tclIntType;
return TCL_OK;
}
@@ -2359,7 +2487,7 @@ Tcl_DbNewDoubleObj(
objPtr->bytes = NULL;
objPtr->internalRep.doubleValue = dblValue;
objPtr->typePtr = &tclDoubleType;
objPtr->typePtr = tclDoubleType;
return objPtr;
}
@@ -2432,7 +2560,7 @@ Tcl_GetDoubleFromObj(
double *dblPtr) /* Place to store resulting double. */
{
do {
if (objPtr->typePtr == &tclDoubleType) {
if (objPtr->typePtr == tclDoubleType) {
if (isnan(objPtr->internalRep.doubleValue)) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
@@ -2445,11 +2573,11 @@ Tcl_GetDoubleFromObj(
*dblPtr = (double) objPtr->internalRep.doubleValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclIntType) {
if (objPtr->typePtr == tclIntType) {
*dblPtr = (double) objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclBignumType) {
if (objPtr->typePtr == tclBignumType) {
mp_int big;
TclUnpackBignum(objPtr, big);
@@ -2577,6 +2705,17 @@ Tcl_GetIntFromObj(
return TCL_OK;
#endif
}
int
ScalarObjInterfaceListLength(
TCL_UNUSED(Tcl_Interp *), /* Used to report errors if not NULL. */ \
TCL_UNUSED(Tcl_Obj *), /* List object whose #elements to return. */ \
Tcl_Size *lenPtr /* The resulting length is stored here. */
)
{
*lenPtr = 1;
return TCL_OK;
}
/*
@@ -2663,12 +2802,12 @@ Tcl_GetLongFromObj(
{
do {
#ifdef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclIntType) {
if (objPtr->typePtr == tclIntType) {
*longPtr = objPtr->internalRep.wideValue;
return TCL_OK;
}
#else
if (objPtr->typePtr == &tclIntType) {
if (objPtr->typePtr == tclIntType) {
/*
* We return any integer in the range LONG_MIN to ULONG_MAX
* converted to a long, ignoring overflow. The rule preserves
@@ -2687,7 +2826,7 @@ Tcl_GetLongFromObj(
goto tooLarge;
}
#endif
if (objPtr->typePtr == &tclDoubleType) {
if (objPtr->typePtr == tclDoubleType) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
@@ -2696,7 +2835,7 @@ Tcl_GetLongFromObj(
}
return TCL_ERROR;
}
if (objPtr->typePtr == &tclBignumType) {
if (objPtr->typePtr == tclBignumType) {
/*
* Must check for those bignum values that can fit in a long, even
* when auto-narrowing is enabled. Only those values in the signed
@@ -2924,11 +3063,11 @@ Tcl_GetWideIntFromObj(
/* Place to store resulting long. */
{
do {
if (objPtr->typePtr == &tclIntType) {
if (objPtr->typePtr == tclIntType) {
*wideIntPtr = objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclDoubleType) {
if (objPtr->typePtr == tclDoubleType) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
@@ -2937,7 +3076,7 @@ Tcl_GetWideIntFromObj(
}
return TCL_ERROR;
}
if (objPtr->typePtr == &tclBignumType) {
if (objPtr->typePtr == tclBignumType) {
/*
* Must check for those bignum values that can fit in a
* Tcl_WideInt, even when auto-narrowing is enabled.
@@ -3009,7 +3148,7 @@ Tcl_GetWideUIntFromObj(
/* Place to store resulting long. */
{
do {
if (objPtr->typePtr == &tclIntType) {
if (objPtr->typePtr == tclIntType) {
if (objPtr->internalRep.wideValue < 0) {
wideUIntOutOfRange:
if (interp != NULL) {
@@ -3023,10 +3162,10 @@ Tcl_GetWideUIntFromObj(
*wideUIntPtr = (Tcl_WideUInt)objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclDoubleType) {
if (objPtr->typePtr == tclDoubleType) {
goto wideUIntOutOfRange;
}
if (objPtr->typePtr == &tclBignumType) {
if (objPtr->typePtr == tclBignumType) {
/*
* Must check for those bignum values that can fit in a
* Tcl_WideUInt, even when auto-narrowing is enabled.
@@ -3093,11 +3232,11 @@ TclGetWideBitsFromObj(
Tcl_WideInt *wideIntPtr) /* Place to store resulting wide integer. */
{
do {
if (objPtr->typePtr == &tclIntType) {
if (objPtr->typePtr == tclIntType) {
*wideIntPtr = objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclDoubleType) {
if (objPtr->typePtr == tclDoubleType) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
@@ -3106,7 +3245,7 @@ TclGetWideBitsFromObj(
}
return TCL_ERROR;
}
if (objPtr->typePtr == &tclBignumType) {
if (objPtr->typePtr == tclBignumType) {
mp_int big;
mp_err err;
@@ -3210,7 +3349,7 @@ DupBignum(
mp_int bignumVal;
mp_int bignumCopy;
copyPtr->typePtr = &tclBignumType;
copyPtr->typePtr = tclBignumType;
TclUnpackBignum(srcPtr, bignumVal);
if (mp_init_copy(&bignumCopy, &bignumVal) != MP_OKAY) {
Tcl_Panic("initialization failure in DupBignum");
@@ -3380,7 +3519,7 @@ GetBignumFromObj(
mp_int *bignumValue) /* Returned bignum value. */
{
do {
if (objPtr->typePtr == &tclBignumType) {
if (objPtr->typePtr == tclBignumType) {
if (copy || Tcl_IsShared(objPtr)) {
mp_int temp;
@@ -3405,14 +3544,14 @@ GetBignumFromObj(
}
return TCL_OK;
}
if (objPtr->typePtr == &tclIntType) {
if (objPtr->typePtr == tclIntType) {
if (mp_init_i64(bignumValue,
objPtr->internalRep.wideValue) != MP_OKAY) {
return TCL_ERROR;
}
return TCL_OK;
}
if (objPtr->typePtr == &tclDoubleType) {
if (objPtr->typePtr == tclDoubleType) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
@@ -3572,7 +3711,7 @@ TclSetBignumInternalRep(
void *big)
{
mp_int *bignumValue = (mp_int *)big;
objPtr->typePtr = &tclBignumType;
objPtr->typePtr = tclBignumType;
PACK_BIGNUM(*bignumValue, objPtr);
/*
@@ -3595,14 +3734,13 @@ TclSetBignumInternalRep(
* Extracts a number (of any possible numeric type) from an object.
*
* Results:
* Whether the extraction worked. The type is stored in the variable
* referred to by the typePtr argument, and a pointer to the
* representation is stored in the variable referred to by the
* clientDataPtr.
* A standard Tcl completion code. On success, the type is stored at the
* address given by typePtr, and a pointer to the representation is stored
* at the address given by clientDataPtr.
*
* Side effects:
* Can allocate thread-specific data for handling the copy-out space for
* bignums; this space is shared within a thread.
* May allocate thread-specific data shared within a thread for handling
* the copy-out space for bignums.
*
*----------------------------------------------------------------------
*/
@@ -3615,7 +3753,7 @@ Tcl_GetNumberFromObj(
int *typePtr)
{
do {
if (objPtr->typePtr == &tclDoubleType) {
if (objPtr->typePtr == tclDoubleType) {
if (isnan(objPtr->internalRep.doubleValue)) {
*typePtr = TCL_NUMBER_NAN;
} else {
@@ -3624,12 +3762,12 @@ Tcl_GetNumberFromObj(
*clientDataPtr = &objPtr->internalRep.doubleValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclIntType) {
if (objPtr->typePtr == tclIntType) {
*typePtr = TCL_NUMBER_INT;
*clientDataPtr = &objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclBignumType) {
if (objPtr->typePtr == tclBignumType) {
static Tcl_ThreadDataKey bignumKey;
mp_int *bigPtr = (mp_int *)Tcl_GetThreadData(&bignumKey,
sizeof(mp_int));
@@ -3680,6 +3818,29 @@ Tcl_GetNumber(
return Tcl_GetNumberFromObj(interp, objPtr, clientDataPtr, typePtr);
}
/*
*----------------------------------------------------------------------
*
* TclBounceRefCount --
*
* Performs the equivante of incrementing and then decrementing the
* reference count.
*
* Results:
* None.
*
*----------------------------------------------------------------------
*/
void
TclBounceRefCount(
Tcl_Obj *objPtr) /* The object we are registering a reference to. */
{
if (objPtr->refCount < 1) {
TclFreeObj(objPtr);
}
}
/*
*----------------------------------------------------------------------
*
@@ -4472,6 +4633,37 @@ DupCmdNameInternalRep(
resPtr->refCount++;
copyPtr->typePtr = &tclCmdNameType;
}
static int
ScalarObjIndex(
TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
Tcl_Obj *listPtr, /* List object to index into. */ \
Tcl_Size index, /* Index of element to return. */ \
Tcl_Obj **objPtrPtr /* The resulting Tcl_Obj* is stored here. */
) {
if (index == 0) {
*objPtrPtr = listPtr;
} else {
*objPtrPtr = NULL;
}
return TCL_OK;
}
static Tcl_Obj* ScalarObjRange(
TCL_UNUSED(Tcl_Interp *),/* Used to report errors */ \
Tcl_Obj *listObj, /* List object to take a range from. */ \
Tcl_Size rangeStart, /* Index of first element to */ \
/* include. */ \
Tcl_Size rangeEnd /* Index of last element to include. */
)
{
if (rangeEnd >= 0 && rangeEnd >= rangeStart) {
return listObj;
} else {
return NULL;
}
}
/*
*----------------------------------------------------------------------
@@ -4584,13 +4776,14 @@ Tcl_RepresentationCmd(
* "1872361827361287"
*/
const char *name = objv[1]->typePtr ? TclObjTypeName(objv[1]->typePtr) : "pure string";
descObj = Tcl_ObjPrintf("value is a %s with a refcount of %" TCL_Z_MODIFIER "u,"
" object pointer at %p",
objv[1]->typePtr ? objv[1]->typePtr->name : "pure string",
name,
objv[1]->refCount, objv[1]);
if (objv[1]->typePtr) {
if (objv[1]->typePtr == &tclDoubleType) {
if (objv[1]->typePtr == tclDoubleType) {
Tcl_AppendPrintfToObj(descObj, ", internal representation %g",
objv[1]->internalRep.doubleValue);
} else {
@@ -4612,6 +4805,32 @@ Tcl_RepresentationCmd(
Tcl_SetObjResult(interp, descObj);
return TCL_OK;
}
void Tcl_ObjTypeVersion(Tcl_Obj *objPtr, int *version) {
if ((void *)objPtr->typePtr->name == (void *)&TclObjectTypeType0) {
*version = ((ObjectType *)objPtr->typePtr)->version;
} else {
*version = 1;
}
return;
}
TclObjectTypeType * TclGetObjectTypeType () {
return &TclObjectTypeType0;
}
int (*TclObjInterfaceGetListIndex (Tcl_Obj *objPtr))
(tclObjTypeInterfaceArgsListIndex)
{
ObjInterface *interface = (ObjInterface *)((ObjectType *)objPtr->typePtr)->interface;
if (interface->version >= 1) {
return interface->list.index;
}
return NULL;
}
/*
* Local Variables:
+14 -31
View File
@@ -871,18 +871,6 @@ TclParseBackslash(
* No hexdigits -> This is just "u".
*/
result = 'u';
#if TCL_UTF_MAX < 4
} else if (((result & 0xFC00) == 0xD800) && (count == 6)
&& (p[5] == '\\') && (p[6] == 'u') && (numBytes >= 10)) {
/* If high surrogate is immediately followed by a low surrogate
* escape, combine them into one character. */
int low;
int count2 = ParseHex(p+7, 4, &low);
if ((count2 == 4) && ((low & 0xFC00) == 0xDC00)) {
result = ((result & 0x3FF)<<10 | (low & 0x3FF)) + 0x10000;
count += count2 + 2;
}
#endif
}
break;
case 'U':
@@ -938,13 +926,13 @@ TclParseBackslash(
*/
if (Tcl_UtfCharComplete(p, numBytes - 1)) {
count = TclUtfToUCS4(p, &unichar) + 1; /* +1 for '\' */
count = Tcl_UtfToUniChar(p, &unichar) + 1; /* +1 for '\' */
} else {
char utfBytes[8];
memcpy(utfBytes, p, numBytes - 1);
utfBytes[numBytes - 1] = '\0';
count = TclUtfToUCS4(utfBytes, &unichar) + 1;
count = Tcl_UtfToUniChar(utfBytes, &unichar) + 1;
}
result = unichar;
break;
@@ -955,12 +943,6 @@ TclParseBackslash(
*readPtr = count;
}
count = Tcl_UniCharToUtf(result, dst);
#if TCL_UTF_MAX < 4
if ((result >= 0xD800) && (count < 3)) {
/* Special case for handling high surrogates. */
count += Tcl_UniCharToUtf(-1, dst + count);
}
#endif
return count;
}
@@ -1072,7 +1054,7 @@ ParseTokens(
* termination information. */
{
char type;
Tcl_Size originalTokens;
int originalTokens;
int noSubstCmds = !(flags & TCL_SUBST_COMMANDS);
int noSubstVars = !(flags & TCL_SUBST_VARIABLES);
int noSubstBS = !(flags & TCL_SUBST_BACKSLASHES);
@@ -1106,7 +1088,7 @@ ParseTokens(
tokenPtr->size = src - tokenPtr->start;
parsePtr->numTokens++;
} else if (*src == '$') {
Tcl_Size varToken;
int varToken;
if (noSubstVars) {
tokenPtr->type = TCL_TOKEN_TEXT;
@@ -1233,7 +1215,7 @@ ParseTokens(
*/
if (mask & TYPE_SPACE) {
if (parsePtr->numTokens == originalTokens) {
if ((int)parsePtr->numTokens == originalTokens) {
goto finishToken;
}
break;
@@ -1254,7 +1236,7 @@ ParseTokens(
Tcl_Panic("ParseTokens encountered unknown character");
}
}
if (parsePtr->numTokens == originalTokens) {
if ((int)parsePtr->numTokens == originalTokens) {
/*
* There was nothing in this range of text. Add an empty token for the
* empty range, so that there is always at least one token added.
@@ -1651,7 +1633,8 @@ Tcl_ParseBraces(
{
Tcl_Token *tokenPtr;
const char *src;
Tcl_Size length, startIndex, level;
int startIndex, level;
Tcl_Size length;
if (numBytes < 0 && start) {
numBytes = strlen(start);
@@ -1702,7 +1685,7 @@ Tcl_ParseBraces(
*/
if ((src != tokenPtr->start)
|| (parsePtr->numTokens == startIndex)) {
|| ((int)parsePtr->numTokens == startIndex)) {
tokenPtr->size = (src - tokenPtr->start);
parsePtr->numTokens++;
}
@@ -2121,7 +2104,7 @@ TclSubstTokens(
* integer representing the number of tokens
* left to be substituted will be written */
Tcl_Size line, /* The line the script starts on. */
Tcl_Size *clNextOuter, /* Information about an outer context for */
int *clNextOuter, /* Information about an outer context for */
const char *outerScript) /* continuation line data. This is set by
* EvalEx() to properly handle [...]-nested
* commands. The 'outerScript' refers to the
@@ -2144,7 +2127,7 @@ TclSubstTokens(
#define NUM_STATIC_POS 20
int isLiteral;
Tcl_Size i, maxNumCL, numCL, adjust;
Tcl_Size *clPosition = NULL;
int *clPosition = NULL;
Interp *iPtr = (Interp *) interp;
int inFile = iPtr->evalFlags & TCL_EVAL_FILE;
@@ -2179,7 +2162,7 @@ TclSubstTokens(
if (isLiteral) {
maxNumCL = NUM_STATIC_POS;
clPosition = (Tcl_Size *)Tcl_Alloc(maxNumCL * sizeof(Tcl_Size));
clPosition = (int *)Tcl_Alloc(maxNumCL * sizeof(int));
}
adjust = 0;
@@ -2229,8 +2212,8 @@ TclSubstTokens(
if (numCL >= maxNumCL) {
maxNumCL *= 2;
clPosition = (Tcl_Size *)Tcl_Realloc(clPosition,
maxNumCL * sizeof(Tcl_Size));
clPosition = (int *)Tcl_Realloc(clPosition,
maxNumCL * sizeof(int));
}
clPosition[numCL] = clPos;
numCL++;
+1 -90
View File
@@ -48,93 +48,6 @@
# endif
#endif
#if TCL_MAJOR_VERSION < 9
#ifdef __cplusplus
extern "C" {
#endif
/*
* Exported function declarations:
*/
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len,
Tcl_DString *dsPtr);
/* 1 */
EXTERN char * Tcl_WinTCharToUtf(const TCHAR *str, int len,
Tcl_DString *dsPtr);
/* Slot 2 is reserved */
/* 3 */
EXTERN void Tcl_WinConvertError(unsigned errCode);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 0 */
EXTERN int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
const char *bundleName, int hasResourceFile,
Tcl_Size maxPathLen, char *libraryPath);
/* 1 */
EXTERN int Tcl_MacOSXOpenVersionedBundleResources(
Tcl_Interp *interp, const char *bundleName,
const char *bundleVersion,
int hasResourceFile, Tcl_Size maxPathLen,
char *libraryPath);
/* 2 */
EXTERN void Tcl_MacOSXNotifierAddRunLoopMode(
const void *runLoopMode);
#endif /* MACOSX */
typedef struct TclPlatStubs {
int magic;
void *hooks;
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */
char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */
void (*reserved2)(void);
void (*tcl_WinConvertError) (unsigned errCode); /* 3 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, Tcl_Size maxPathLen, char *libraryPath); /* 0 */
int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, Tcl_Size maxPathLen, char *libraryPath); /* 1 */
void (*tcl_MacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 2 */
#endif /* MACOSX */
} TclPlatStubs;
extern const TclPlatStubs *tclPlatStubsPtr;
#ifdef __cplusplus
}
#endif
#if defined(USE_TCL_STUBS)
/*
* Inline function declarations:
*/
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
#define Tcl_WinUtfToTChar \
(tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */
#define Tcl_WinTCharToUtf \
(tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */
/* Slot 2 is reserved */
#define Tcl_WinConvertError \
(tclPlatStubsPtr->tcl_WinConvertError) /* 3 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
#define Tcl_MacOSXOpenBundleResources \
(tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */
#define Tcl_MacOSXOpenVersionedBundleResources \
(tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */
#define Tcl_MacOSXNotifierAddRunLoopMode \
(tclPlatStubsPtr->tcl_MacOSXNotifierAddRunLoopMode) /* 2 */
#endif /* MACOSX */
#endif /* defined(USE_TCL_STUBS) */
#else /* TCL_MAJOR_VERSION > 8 */
/* !BEGIN!: Do not edit below this line. */
@@ -193,7 +106,6 @@ extern const TclPlatStubs *tclPlatStubsPtr;
/* !END!: Do not edit above this line. */
#endif /* TCL_MAJOR_VERSION */
#ifdef MAC_OSX_TCL /* MACOSX */
#undef Tcl_MacOSXOpenBundleResources
@@ -213,8 +125,7 @@ extern const TclPlatStubs *tclPlatStubsPtr;
# undef Tcl_MacOSXNotifierAddRunLoopMode
#endif
#if defined(USE_TCL_STUBS) && (defined(_WIN32) || defined(__CYGWIN__))\
&& (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8)
#if defined(USE_TCL_STUBS) && (defined(_WIN32) || defined(__CYGWIN__))
#undef Tcl_WinUtfToTChar
#undef Tcl_WinTCharToUtf
#ifdef _WIN32
+8 -8
View File
@@ -268,7 +268,7 @@ Tcl_ProcObjCmd(
cfPtr->level = -1;
cfPtr->type = contextPtr->type;
cfPtr->line = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size));
cfPtr->line = (int *)Tcl_Alloc(sizeof(int));
cfPtr->line[0] = contextPtr->line[3];
cfPtr->nline = 1;
cfPtr->framePtr = NULL;
@@ -495,8 +495,8 @@ TclCreateProc(
if (precompiled) {
if (numArgs > procPtr->numArgs) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"procedure \"%s\": arg list contains %" TCL_SIZE_MODIFIER "u entries, "
"precompiled header expects %" TCL_SIZE_MODIFIER "u", procName, numArgs,
"procedure \"%s\": arg list contains %" TCL_Z_MODIFIER "u entries, "
"precompiled header expects %" TCL_Z_MODIFIER "u", procName, numArgs,
procPtr->numArgs));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"BYTECODELIES", NULL);
@@ -590,7 +590,7 @@ TclCreateProc(
|| (localPtr->defValuePtr == NULL && fieldCount == 2)
|| (localPtr->defValuePtr != NULL && fieldCount != 2)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"procedure \"%s\": formal parameter %" TCL_SIZE_MODIFIER "u is "
"procedure \"%s\": formal parameter %" TCL_Z_MODIFIER "u is "
"inconsistent with precompiled body", procName, i));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"BYTECODELIES", NULL);
@@ -1067,7 +1067,7 @@ ProcWrongNumArgs(
{
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
Proc *procPtr = framePtr->procPtr;
Tcl_Size localCt = procPtr->numCompiledLocals, numArgs, i;
int localCt = procPtr->numCompiledLocals, numArgs, i;
Tcl_Obj **desiredObjs;
const char *final = NULL;
@@ -1348,7 +1348,7 @@ InitArgsAndLocals(
Proc *procPtr = framePtr->procPtr;
ByteCode *codePtr;
Var *varPtr, *defPtr;
Tcl_Size localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
Tcl_Obj *const *argObjs;
ByteCodeGetInternalRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
@@ -2547,7 +2547,7 @@ SetLambdaFromAny(
if (contextPtr->line
&& (contextPtr->nline >= 2) && (contextPtr->line[1] >= 0)) {
Tcl_Size buf[2];
int buf[2];
/*
* Move from approximation (line of list cmd word) to actual
@@ -2559,7 +2559,7 @@ SetLambdaFromAny(
cfPtr->level = -1;
cfPtr->type = contextPtr->type;
cfPtr->line = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size));
cfPtr->line = (int *)Tcl_Alloc(sizeof(int));
cfPtr->line[0] = buf[1];
cfPtr->nline = 1;
cfPtr->framePtr = NULL;
+2 -2
View File
@@ -903,7 +903,7 @@ Tcl_ScanObjCmd(
* Scan a single Unicode character.
*/
offset = TclUtfToUCS4(string, &i);
offset = Tcl_UtfToUniChar(string, &i);
string += offset;
if (!(flags & SCAN_SUPPRESS)) {
TclNewIntObj(objPtr, i);
@@ -1046,7 +1046,7 @@ Tcl_ScanObjCmd(
if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) {
#ifdef ACCEPT_NAN
const Tcl_ObjInternalRep *irPtr
= TclFetchInternalRep(objPtr, &tclDoubleType);
= TclFetchInternalRep(objPtr, tclDoubleType);
if (irPtr) {
dvalue = irPtr->doubleValue;
} else
+6 -6
View File
@@ -555,7 +555,7 @@ TclParseNumber(
/* A dict can never be a (single) number */
return TCL_ERROR;
}
if (TclHasInternalRep(objPtr, &tclListType)) {
if (TclHasInternalRep(objPtr, tclListType)) {
Tcl_Size length;
/* A list can only be a (single) number if its length == 1 */
TclListObjLengthM(NULL, objPtr, &length);
@@ -1378,7 +1378,7 @@ TclParseNumber(
octalSignificandWide);
octalSignificandOverflow = 1;
} else {
objPtr->typePtr = &tclIntType;
objPtr->typePtr = tclIntType;
if (signum) {
objPtr->internalRep.wideValue =
(Tcl_WideInt)(-octalSignificandWide);
@@ -1414,7 +1414,7 @@ TclParseNumber(
significandWide);
significandOverflow = 1;
} else {
objPtr->typePtr = &tclIntType;
objPtr->typePtr = tclIntType;
if (signum) {
objPtr->internalRep.wideValue =
(Tcl_WideInt)(-significandWide);
@@ -1446,7 +1446,7 @@ TclParseNumber(
* k = numTrailZeros+exponent-numDigitsAfterDp.
*/
objPtr->typePtr = &tclDoubleType;
objPtr->typePtr = tclDoubleType;
if (exponentSignum) {
/*
* At this point exponent>=0, so the following calculation
@@ -1497,14 +1497,14 @@ TclParseNumber(
} else {
objPtr->internalRep.doubleValue = HUGE_VAL;
}
objPtr->typePtr = &tclDoubleType;
objPtr->typePtr = tclDoubleType;
break;
#ifdef IEEE_FLOATING_POINT
case sNAN:
case sNANFINISH:
objPtr->internalRep.doubleValue = MakeNaN(signum, significandWide);
objPtr->typePtr = &tclDoubleType;
objPtr->typePtr = tclDoubleType;
break;
#endif
case INITIAL:
-602
View File
@@ -1,602 +0,0 @@
/*
* tclStringList.c --
*
* This file contains the StringList concrete abstract list
* implementation. It implements a view of a string as a list of
* of characters.
*
* Copyright © 2023 Ashok P. Nadkarni
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tcl.h"
#include "tclInt.h"
#include <assert.h>
#include <math.h>
/*
* The structure below defines the StringList Tcl_ObjType. Implementation
* stores the target Tcl_Obj being split in the internal representation of the
* abstract list Tcl_Obj. List operations are then mapped to the corresponding
* string operations. This makes per character processing of the form
* foreach ch [split $str ""] {...}
* less expensive for large strings.
*
* The source string is stored in the internalRep.twpPtrValue.ptr1 field.
* The ptr2 field holds a StringListInfo struct with ancillary information
* as below. If ptr2 is NULL, list covers all elements of source string.
*/
typedef struct StringListInfo {
Tcl_Size startIndex; /* Starting index in source string where this list
begins. Used for fast range operations */
Tcl_Size count; /* Number of elements in list. If negative, count
is entire source string */
int flags;
#define STRINGLIST_REVERSE 0x01 /* If set, reverse element order */
} StringListInfo;
/* -------------------------- StringList object ---------------------------- */
static int StringListObjIndex(TCL_UNUSED(Tcl_Interp *), Tcl_Obj *arithSeriesObj,
Tcl_Size index, Tcl_Obj **elemObj);
static Tcl_Size StringListObjLength(Tcl_Obj *strListObj);
static int StringListObjRange(Tcl_Interp *interp, Tcl_Obj *strListObj,
Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **newObjPtr);
static int StringListObjReverse(Tcl_Interp *interp, Tcl_Obj *strListObj, Tcl_Obj **newObjPtr);
static void DupStringListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void FreeStringListInternalRep(Tcl_Obj *strListObj);
static void UpdateStringOfStringList(Tcl_Obj *strListObj);
static const Tcl_ObjType stringListType = {
"stringlist", /* name */
FreeStringListInternalRep, /* freeIntRepProc */
DupStringListInternalRep, /* dupIntRepProc */
UpdateStringOfStringList, /* updateStringProc */
NULL, /* setFromAnyProc */
TCL_OBJTYPE_V2(
StringListObjLength,
StringListObjIndex,
StringListObjRange,
StringListObjReverse,
NULL, /* GetElements */
NULL, /* SetElement */
NULL, /* Replace */
NULL) /* "in" operator */
};
/* Returns the source for a StringList, NULL if objPtr is not a StringList */
static inline Tcl_Obj *
StringListGetSourceObj(Tcl_Obj *objPtr)
{
const Tcl_ObjInternalRep *irPtr;
irPtr = TclFetchInternalRep((objPtr), &stringListType);
return irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL;
}
/*
* Returns the ancillary information about a StringList. May return an
* NULL either because objPtr is not a StringList or because it has no
* ancillary information. Use StringListGetSourceObj to distinguish.
*/
static inline StringListInfo *
StringListGetInfo(Tcl_Obj *objPtr)
{
const Tcl_ObjInternalRep *irPtr;
irPtr = TclFetchInternalRep((objPtr), &stringListType);
return irPtr ? (StringListInfo *)irPtr->twoPtrValue.ptr2 : NULL;
}
/*
*----------------------------------------------------------------------
*
* DupStringListInternalRep --
*
* Initialize the internal representation of a StringList Tcl_Obj to a
* copy of the internal representation of an existing one.
*
* Results:
* None.
*
* Side effects:
* We set "copyPtr"s internal rep to a newly allocated structure.
*----------------------------------------------------------------------
*/
static void
DupStringListInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
/* Copy the source string and hold a reference */
Tcl_Obj *srcStringObj = StringListGetSourceObj(srcPtr);
copyPtr->internalRep.twoPtrValue.ptr1 = srcStringObj;
Tcl_IncrRefCount(srcStringObj);
/* Copy the ancillary information if there is any. */
StringListInfo *srcInfoPtr = StringListGetInfo(srcPtr);
if (srcInfoPtr) {
StringListInfo *copyInfoPtr;
copyInfoPtr = (StringListInfo *)Tcl_Alloc(sizeof(*copyInfoPtr));
*copyInfoPtr = *srcInfoPtr;
copyPtr->internalRep.twoPtrValue.ptr2 = copyInfoPtr;
} else {
copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
}
copyPtr->typePtr = &stringListType;
}
/*
*----------------------------------------------------------------------
*
* FreeStringListInternalRep --
*
* Free any allocated memory in the StringList Rep
*
* Results:
* None.
*
* Side effects:
*
*----------------------------------------------------------------------
*/
static void
FreeStringListInternalRep(Tcl_Obj *strListObj)
{
Tcl_Obj *srcStringObj = StringListGetSourceObj(strListObj);
assert(srcStringObj);
if (srcStringObj) {
Tcl_DecrRefCount(srcStringObj);
}
StringListInfo *infoPtr = StringListGetInfo(strListObj);
if (infoPtr) {
Tcl_Free(infoPtr);
}
}
/*
*----------------------------------------------------------------------
*
* TclNewStringListObj --
*
* Creates a new StringList object formed by splitting the source string
* object.
*
* Results:
*
* A Tcl_Obj pointer to the created StringList object with ref count 0.
*
* Side Effects:
*
* None.
*----------------------------------------------------------------------
*/
Tcl_Obj *
TclNewStringListObj(
TCL_UNUSED(Tcl_Interp *),
Tcl_Obj *srcStringObj) /* String to split */
{
Tcl_Obj *objPtr = Tcl_NewObj();
Tcl_InvalidateStringRep(objPtr);
objPtr->internalRep.twoPtrValue.ptr1 = srcStringObj;
Tcl_IncrRefCount(srcStringObj);
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = &stringListType;
return objPtr;
}
/*
*----------------------------------------------------------------------
*
* StringListGetExtent
*
* Gets the starting index and length subrange within the source string
* that comprises this list.
*
* Results:
*
* Returns the length of the list.
*
* Side Effects:
*
* The starting index in the source string is stored in startIndexPtr
* if it is not NULL.
*----------------------------------------------------------------------
*/
static Tcl_Size
StringListGetExtent(Tcl_Obj *strListObj, Tcl_Size *startIndexPtr, Tcl_Size *numCharsPtr, int *reversedPtr)
{
Tcl_Obj *srcStringObj;
StringListInfo *infoPtr;
Tcl_Size numChars;
Tcl_Size listLen;
Tcl_Size startIndex;
int reversed;
srcStringObj = StringListGetSourceObj(strListObj);
infoPtr = StringListGetInfo(strListObj);
assert(srcStringObj);
numChars = Tcl_GetCharLength(srcStringObj);
if (infoPtr) {
/* The list is a subrange of the string */
startIndex = infoPtr->startIndex;
if (infoPtr->count >= 0) {
listLen = infoPtr->count;
assert(listLen <= numChars);
}
else {
listLen = numChars - startIndex;
}
reversed = (infoPtr->flags & STRINGLIST_REVERSE) != 0;
} else {
startIndex = 0;
listLen = numChars;
reversed = 0;
}
assert(listLen <= numChars);
assert(startIndex == 0 || startIndex < numChars);
assert(startIndex <= (numChars - listLen));
if (startIndexPtr) {
*startIndexPtr = startIndex;
}
if (numCharsPtr) {
*numCharsPtr = numChars;
}
if (reversedPtr) {
*reversedPtr = reversed;
}
return listLen;
}
/*
*----------------------------------------------------------------------
*
* StringListObjIndex --
*
* Returns the element with the specified index in the list. If index
* is out of range, an empty Tcl_Obj is returned.
*
* Results:
*
* TCL_OK on success.
*
* Side Effects:
*
* On success, the
*
*----------------------------------------------------------------------
*/
int
StringListObjIndex(
TCL_UNUSED(Tcl_Interp *),/* Used for error reporting if not NULL. */
Tcl_Obj *strListObj, /* List obj */
Tcl_Size index, /* index to element of interest */
Tcl_Obj **elemObj) /* Return value */
{
Tcl_Size listLen;
Tcl_Size startIndex;
Tcl_Obj *srcStringObj;
int reversed;
Tcl_Size strIndex;
if (index < 0) {
goto outOfBounds;
}
srcStringObj = StringListGetSourceObj(strListObj);
assert(srcStringObj);
listLen = StringListGetExtent(strListObj, &startIndex, NULL, &reversed);
if (index >= listLen) {
goto outOfBounds;
}
/*
* The index into the string depends on whether the list is only a
* substring of the string and whether it is reversed.
*/
if (reversed) {
strIndex = startIndex + listLen - index - 1;
} else {
strIndex = startIndex + index;
}
char buf[TCL_UTF_MAX];
int utfLen;
assert(strIndex <
Tcl_GetCharLength(srcStringObj));
Tcl_UniChar ch = Tcl_GetUniChar(srcStringObj, strIndex);
utfLen = Tcl_UniCharToUtf(ch, buf);
*elemObj = Tcl_NewStringObj(buf, utfLen);
return TCL_OK;
outOfBounds:
/* TODO - NULL or empty obj? */
*elemObj = Tcl_NewObj();
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* StringListObjLength
*
* Returns the length of the StringList
*
* Results:
*
* The length of the list.
*
* Side Effects:
*
* None.
*
*----------------------------------------------------------------------
*/
Tcl_Size StringListObjLength(Tcl_Obj *strListObj)
{
return StringListGetExtent(strListObj, NULL, NULL, NULL);
}
/*
*----------------------------------------------------------------------
*
* StringListObjRange --
*
* Makes a slice of an StringList.
*
* Results:
* Returns a pointer to the sliced series.
* This may be a new object or the same object if not shared.
*
* Side effects:
* ?The possible conversion of the object referenced by listPtr?
* ?to a list object.?
*
*----------------------------------------------------------------------
*/
int
StringListObjRange(
TCL_UNUSED(Tcl_Interp *), /* For error message(s) */
Tcl_Obj *strListObj, /* List object to take a range from. */
Tcl_Size fromIdx, /* Index of first element to include. */
Tcl_Size toIdx, /* Index of last element to include. */
Tcl_Obj **newObjPtr) /* return value */
{
Tcl_Size listLen;
Tcl_Size startIndex;
Tcl_Obj *srcStringObj;
int reversed;
srcStringObj = StringListGetSourceObj(strListObj);
assert(srcStringObj);
listLen = StringListGetExtent(strListObj, &startIndex, NULL, &reversed);
if (fromIdx < 0) {
fromIdx = 0;
}
if (toIdx >= listLen) {
toIdx = listLen - 1;
}
if (fromIdx > toIdx ||
fromIdx >= listLen) {
TclNewObj(*newObjPtr);
return TCL_OK;
}
assert(fromIdx >= 0);
assert(toIdx >= fromIdx);
assert(listLen > toIdx);
/*
* We could do a Tcl_Range to allocate a new string but instead
* keep the old one and just add ancillary information specifying
* range and reverse setting.
*/
StringListInfo *infoPtr;
infoPtr = (StringListInfo *) Tcl_Alloc(sizeof(*infoPtr));
infoPtr->count = toIdx - fromIdx + 1;
if (reversed) {
infoPtr->startIndex = startIndex + listLen - toIdx - 1;
infoPtr->flags = STRINGLIST_REVERSE;
} else {
infoPtr->startIndex = startIndex + fromIdx;
infoPtr->flags = 0;
assert(fromIdx < Tcl_GetCharLength(strListObj));
assert(toIdx < Tcl_GetCharLength(strListObj));
}
Tcl_Obj *newObj = Tcl_NewObj();
Tcl_InvalidateStringRep(newObj);
newObj->internalRep.twoPtrValue.ptr1 = srcStringObj;
Tcl_IncrRefCount(srcStringObj);
newObj->internalRep.twoPtrValue.ptr2 = infoPtr;
newObj->typePtr = &stringListType;
*newObjPtr = newObj;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* StringListObjReverse --
*
* Reverse the order of the StringList value.
*
* Results:
* The result will be StringList in the reverse order.
*
* Side effects:
*
*----------------------------------------------------------------------
*/
int
StringListObjReverse(
TCL_UNUSED(Tcl_Interp *), /* For error message(s) */
Tcl_Obj *strListObj, /* List object to reverse. */
Tcl_Obj **newObjPtr)
{
Tcl_Obj *srcStringObj, *newObj;
StringListInfo *infoPtr, *newInfoPtr;
srcStringObj = StringListGetSourceObj(strListObj);
assert(srcStringObj);
newObj = Tcl_NewObj();
Tcl_InvalidateStringRep(newObj);
newObj->internalRep.twoPtrValue.ptr1 = srcStringObj;
Tcl_IncrRefCount(srcStringObj);
newObj->typePtr = &stringListType;
infoPtr = StringListGetInfo(strListObj);
if (infoPtr) {
if (infoPtr->startIndex == 0 && infoPtr->count < 0 &&
(infoPtr->flags & STRINGLIST_REVERSE)) {
/* No need for ancillary information */
newInfoPtr = NULL;
} else {
newInfoPtr = (StringListInfo *) Tcl_Alloc(sizeof(*newInfoPtr));
newInfoPtr->startIndex = infoPtr->startIndex;
newInfoPtr->count = infoPtr->count;
newInfoPtr->flags = infoPtr->flags ^ STRINGLIST_REVERSE;
}
} else {
newInfoPtr = (StringListInfo *) Tcl_Alloc(sizeof(*newInfoPtr));
newInfoPtr->startIndex = 0;
newInfoPtr->count = -1; /* Entire string */
newInfoPtr->flags = STRINGLIST_REVERSE;
}
newObj->internalRep.twoPtrValue.ptr2 = newInfoPtr;
*newObjPtr = newObj;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* UpdateStringOfStringList --
*
* Update the string representation for an StringList object.
* Note: This procedure does not invalidate an existing old string rep
* so storage will be lost if this has not already been done.
*
* Results:
* None.
*
* Side effects:
* The object's string is set to a valid string that results from
* the list-to-string conversion. This string will be empty if the
* list has no elements. The list internal representation
* should be a StringList when this function is called.
*
*----------------------------------------------------------------------
*/
static void
UpdateStringOfStringList(Tcl_Obj *strListObj)
{
Tcl_Size listLen;
Tcl_Size startIndex;
Tcl_Size numChars;
Tcl_Obj *srcStringObj;
int reversed;
assert(strListObj->bytes == NULL);
srcStringObj = StringListGetSourceObj(strListObj);
assert(srcStringObj);
listLen =
StringListGetExtent(strListObj, &startIndex, &numChars, &reversed);
if (listLen == 0) {
Tcl_InitStringRep(strListObj, NULL, 0);
return;
}
if (reversed) {
Tcl_Obj *tempObj = TclStringReverse(srcStringObj, TCL_STRING_IN_PLACE);
/* NOTE: TclStringReverse may return same or different Tcl_Obj! */
srcStringObj = tempObj;
startIndex = numChars - (startIndex + listLen) - 1;
}
/* srcStringObj may be original or newly allocated so we have to decrref later */
Tcl_IncrRefCount(srcStringObj);
const char *utf;
const char *utfStart = Tcl_GetString(srcStringObj);
# define LOCAL_SIZE 64
char localFlags[LOCAL_SIZE], *flagPtr = NULL;
Tcl_Size i, bytesNeeded;
int utfLen, uniChar;
utfStart = Tcl_UtfAtIndex(utfStart, startIndex);
/* Pass 1: estimate space, gather flags. */
if (listLen <= LOCAL_SIZE) {
flagPtr = localFlags;
} else {
/* We know numElems <= LIST_MAX, so this is safe. */
flagPtr = (char *)Tcl_Alloc(listLen);
}
for (i = 0, bytesNeeded = 0, utf = utfStart; i < listLen; ++i) {
flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
utfLen = Tcl_UtfToUniChar(utf, &uniChar);
bytesNeeded += TclScanElement(utf, utfLen, flagPtr+i);
if (bytesNeeded > TCL_SIZE_MAX - listLen) {
Tcl_Panic("max size for a Tcl value (%" TCL_Z_MODIFIER "d bytes) exceeded", TCL_SIZE_MAX);
}
utf += utfLen;
}
bytesNeeded += listLen - 1; /* Room for space separators */
/*
* Pass 2: copy into string rep buffer.
*/
char * const dstStart = Tcl_InitStringRep(strListObj, NULL, bytesNeeded);
char *dst;
TclOOM(dstStart, bytesNeeded);
for (i = 0, dst = dstStart, utf = utfStart; i < listLen; ++i) {
flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
utfLen = Tcl_UtfToUniChar(utf, &uniChar);
dst += TclConvertElement(utf, utfLen, dst, flagPtr[i]);
*dst++ = ' ';
utf += utfLen;
}
/* Set the string length to what was actually written, the safe choice */
(void) Tcl_InitStringRep(strListObj, NULL, dst - 1 - dstStart);
Tcl_DecrRefCount(srcStringObj);
if (flagPtr != localFlags) {
Tcl_Free(flagPtr);
}
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
+50 -146
View File
@@ -59,6 +59,8 @@ static void ExtendUnicodeRepWithString(Tcl_Obj *objPtr,
Tcl_Size numAppendChars);
static void FillUnicodeRep(Tcl_Obj *objPtr);
static void FreeStringInternalRep(Tcl_Obj *objPtr);
static Tcl_Size GetCharLength(Tcl_Obj *objPtr);
static Tcl_Obj* GetRange(tclObjTypeInterfaceArgsStringRange);
static void GrowStringBuffer(Tcl_Obj *objPtr, Tcl_Size needed, int flag);
static void GrowUnicodeBuffer(Tcl_Obj *objPtr, Tcl_Size needed);
static int SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
@@ -67,16 +69,6 @@ static void SetUnicodeObj(Tcl_Obj *objPtr,
static Tcl_Size UnicodeLength(const Tcl_UniChar *unicode);
static void UpdateStringOfString(Tcl_Obj *objPtr);
#if TCL_UTF_MAX > 3
#define ISCONTINUATION(bytes) (\
((bytes)[0] & 0xC0) == 0x80)
#else
#define ISCONTINUATION(bytes) (\
((((bytes)[0] & 0xC0) == 0x80) || (((bytes)[0] == '\xED') \
&& (((bytes)[1] & 0xF0) == 0xB0) && (((bytes)[2] & 0xC0) == 0x80))))
#endif
/*
* The structure below defines the string Tcl object type by means of
* functions that can be invoked by generic object code.
@@ -379,11 +371,18 @@ Tcl_NewUnicodeObj(
*
*----------------------------------------------------------------------
*/
Tcl_Size
Tcl_GetCharLength(
Tcl_Obj *objPtr) /* The String object to get the num chars
* of. */
{
return TclObjectDispatch(objPtr, GetCharLength,
string, length, objPtr);
}
Tcl_Size
GetCharLength(
Tcl_Obj *objPtr)
{
String *stringPtr;
Tcl_Size numChars = 0;
@@ -589,22 +588,6 @@ Tcl_GetUniChar(
return -1;
}
ch = stringPtr->unicode[index];
#if TCL_UTF_MAX < 4
/* See: bug [11ae2be95dac9417] */
if ((ch & 0xF800) == 0xD800) {
if (ch & 0x400) {
if ((index > 0)
&& ((stringPtr->unicode[index-1] & 0xFC00) == 0xD800)) {
ch = -1; /* low surrogate preceded by high surrogate */
}
} else if ((++index < stringPtr->numChars)
&& ((stringPtr->unicode[index] & 0xFC00) == 0xDC00)) {
/* high surrogate followed by low surrogate */
ch = (((ch & 0x3FF) << 10) |
(stringPtr->unicode[index] & 0x3FF)) + 0x10000;
}
}
#endif
return ch;
}
@@ -666,36 +649,6 @@ TclGetUniChar(
*/
#undef Tcl_GetUnicodeFromObj
#if !defined(TCL_NO_DEPRECATED)
Tcl_UniChar *
TclGetUnicodeFromObj(
Tcl_Obj *objPtr, /* The object to find the Unicode string
* for. */
void *lengthPtr) /* If non-NULL, the location where the string
* rep's Tcl_UniChar length should be stored. If
* NULL, no length is stored. */
{
String *stringPtr;
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode == 0) {
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
if (lengthPtr != NULL) {
if (stringPtr->numChars > INT_MAX) {
Tcl_Panic("Tcl_GetUnicodeFromObj with 'int' lengthPtr"
" cannot handle such long strings. Please use 'Tcl_Size'");
}
*(int *)lengthPtr = (int)stringPtr->numChars;
}
return stringPtr->unicode;
}
#endif /* !defined(TCL_NO_DEPRECATED) */
Tcl_UniChar *
Tcl_GetUnicodeFromObj(
Tcl_Obj *objPtr, /* The object to find the unicode string
@@ -741,11 +694,15 @@ Tcl_GetUnicodeFromObj(
*/
Tcl_Obj *
Tcl_GetRange(
Tcl_Obj *objPtr, /* The Tcl object to find the range of. */
Tcl_Size first, /* First index of the range. */
Tcl_Size last) /* Last index of the range. */
Tcl_GetRange(tclObjTypeInterfaceArgsStringRange)
{
return TclObjectDispatch(objPtr, GetRange,
string, range, objPtr, first, last);
}
Tcl_Obj *
GetRange(tclObjTypeInterfaceArgsStringRange) {
Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */
String *stringPtr;
Tcl_Size length = 0;
@@ -816,18 +773,6 @@ Tcl_GetRange(
TclNewObj(newObjPtr);
return newObjPtr;
}
#if TCL_UTF_MAX < 4
/* See: bug [11ae2be95dac9417] */
if ((first > 0) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00)
&& ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) {
++first;
}
if ((last + 1 < stringPtr->numChars)
&& ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00)
&& ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) {
++last;
}
#endif
return Tcl_NewUnicodeObj(stringPtr->unicode + first, last - first + 1);
}
@@ -1283,12 +1228,6 @@ Tcl_AppendLimitedToObj(
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
/* If appended string starts with a continuation byte or a lower surrogate,
* force objPtr to unicode representation. See [7f1162a867] */
if (bytes && ISCONTINUATION(bytes)) {
Tcl_GetUnicode(objPtr);
stringPtr = GET_STRING(objPtr);
}
if (stringPtr->hasUnicode && (stringPtr->numChars) > 0) {
AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
} else {
@@ -1488,13 +1427,6 @@ Tcl_AppendObjToObj(
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
/* If appended string starts with a continuation byte or a lower surrogate,
* force objPtr to unicode representation. See [7f1162a867]
* This fixes append-3.4, append-3.7 and utf-1.18 testcases. */
if (ISCONTINUATION(TclGetString(appendObjPtr))) {
Tcl_GetUnicode(objPtr);
stringPtr = GET_STRING(objPtr);
}
/*
* If objPtr has a valid Unicode rep, then get a Unicode string from
* appendObjPtr and append it.
@@ -2157,12 +2089,6 @@ Tcl_AppendFormatToObj(
code = 0xFFFD;
}
length = Tcl_UniCharToUtf(code, buf);
#if TCL_UTF_MAX < 4
if ((code >= 0xD800) && (length < 3)) {
/* Special case for handling high surrogates. */
length += Tcl_UniCharToUtf(-1, buf + length);
}
#endif
segment = Tcl_NewStringObj(buf, length);
Tcl_IncrRefCount(segment);
allocSegment = 1;
@@ -3124,7 +3050,7 @@ TclStringCat(
Tcl_Obj *objResultPtr, * const *ov;
int binary = 1;
Tcl_Size oc, length = 0;
int allowUniChar = 1, requestUniChar = 0, forceUniChar = 0;
int allowUniChar = 1, requestUniChar = 0;
Tcl_Size first = objc - 1; /* Index of first value possibly not empty */
Tcl_Size last = 0; /* Index of last value possibly not empty */
int inPlace = (flags & TCL_STRING_IN_PLACE) && !Tcl_IsShared(*objv);
@@ -3166,9 +3092,7 @@ TclStringCat(
*/
binary = 0;
if (ov > objv+1 && ISCONTINUATION(TclGetString(objPtr))) {
forceUniChar = 1;
} else if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
/* Prevent shimmer of non-string types. */
allowUniChar = 0;
}
@@ -3218,7 +3142,7 @@ TclStringCat(
}
}
} while (--oc);
} else if ((allowUniChar && requestUniChar) || forceUniChar) {
} else if ((allowUniChar && requestUniChar)) {
/*
* Result will be pure Tcl_UniChar array. Pre-size it.
*/
@@ -3375,7 +3299,7 @@ TclStringCat(
dst += more;
}
}
} else if ((allowUniChar && requestUniChar) || forceUniChar) {
} else if ((allowUniChar && requestUniChar)) {
/* Efficiently produce a pure Tcl_UniChar array result */
Tcl_UniChar *dst;
@@ -3567,7 +3491,7 @@ TclStringCmp(
s1 = (char *) Tcl_GetUnicode(value1Ptr);
s2 = (char *) Tcl_GetUnicode(value2Ptr);
if (
#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
#if defined(WORDS_BIGENDIAN)
1
#else
checkEq
@@ -3790,6 +3714,32 @@ TclStringFirst(
return obj;
}
int
TclStringIndexInterface(
Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *indexPtr, Tcl_Obj **charPtrPtr)
{
Tcl_Size index, status;
status = TclGetIntForIndexM(interp, indexPtr, /*endValue*/ TCL_SIZE_MAX - 1,
&index);
if (status != TCL_OK) {
return status;
}
if (TclIndexIsFromEnd(index)) {
if (TclObjectInterfaceCall(objPtr, string, indexEnd,
interp, objPtr, index, charPtrPtr) != TCL_OK) {
return TCL_ERROR;
}
} else {
if (TclObjectInterfaceCall(objPtr, string, index, interp, objPtr,
index, charPtrPtr) != TCL_OK) {
return TCL_ERROR;
}
}
return TCL_OK;
}
/*
*---------------------------------------------------------------------------
*
@@ -3927,9 +3877,6 @@ TclStringReverse(
String *stringPtr;
Tcl_UniChar ch = 0;
int inPlace = flags & TCL_STRING_IN_PLACE;
#if TCL_UTF_MAX < 4
int needFlip = 0;
#endif
if (TclIsPureByteArray(objPtr)) {
Tcl_Size numBytes = 0;
@@ -3962,54 +3909,19 @@ TclStringReverse(
to = Tcl_GetUnicode(objPtr);
stringPtr = GET_STRING(objPtr);
while (--src >= from) {
#if TCL_UTF_MAX < 4
ch = *src;
if ((ch & 0xF800) == 0xD800) {
needFlip = 1;
}
*to++ = ch;
#else
*to++ = *src;
#endif
}
} else {
/*
* Reversing in place.
*/
#if TCL_UTF_MAX < 4
to = src;
#endif
while (--src > from) {
ch = *src;
#if TCL_UTF_MAX < 4
if ((ch & 0xF800) == 0xD800) {
needFlip = 1;
}
#endif
*src = *from;
*from++ = ch;
}
}
#if TCL_UTF_MAX < 4
if (needFlip) {
/*
* Flip back surrogate pairs.
*/
from = to - stringPtr->numChars;
while (--to >= from) {
ch = *to;
if ((ch & 0xFC00) == 0xD800) {
if ((to-1 >= from) && ((to[-1] & 0xFC00) == 0xDC00)) {
to[0] = to[-1];
to[-1] = ch;
--to;
}
}
}
}
#endif
}
if (objPtr->bytes) {
@@ -4043,7 +3955,7 @@ TclStringReverse(
* skip calling Tcl_UtfCharComplete() here.
*/
int bytesInChar = TclUtfToUCS4(from, &chw);
int bytesInChar = Tcl_UtfToUniChar(from, &chw);
ReverseBytes((unsigned char *)to, (unsigned char *)from,
bytesInChar);
@@ -4492,14 +4404,6 @@ ExtendStringRepWithUnicode(
copyBytes:
dst = objPtr->bytes + origLength;
#if TCL_UTF_MAX < 4
/* Initialize the buffer so that some random data doesn't trick
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
* prior non-stateful nature, this call to memset can also be removed.
*/
memset(dst, 0xff, stringPtr->allocated - origLength);
#endif
for (i = 0; i < numChars; i++) {
dst += Tcl_UniCharToUtf(unicode[i], dst);
}
+1 -114
View File
@@ -79,16 +79,12 @@
# undef Tcl_WinConvertError
# define Tcl_WinConvertError 0
#endif
#if defined(TCL_NO_DEPRECATED)
# undef TclGetStringFromObj
# undef TclGetBytesFromObj
# undef TclGetUnicodeFromObj
# define TclGetStringFromObj 0
# define TclGetBytesFromObj 0
# if TCL_UTF_MAX > 3
# define TclGetUnicodeFromObj 0
# endif
#endif
# define TclGetUnicodeFromObj 0
#undef Tcl_Close
#define Tcl_Close 0
#undef TclGetByteArrayFromObj
@@ -97,24 +93,10 @@
#define Tcl_GetByteArrayFromObj 0
#define TclUnusedStubEntry 0
#if TCL_UTF_MAX < 4
static void uniCodePanic() {
Tcl_Panic("This extension uses a deprecated function, not available now: Tcl is compiled with -DTCL_UTF_MAX==%d", TCL_UTF_MAX);
}
# define Tcl_GetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, Tcl_Size *))(void *)uniCodePanic
# define TclGetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, void *))(void *)uniCodePanic
# define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic
# define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic
# define Tcl_AppendUnicodeToObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic
#endif
#define TclUtfCharComplete Tcl_UtfCharComplete
#define TclUtfNext Tcl_UtfNext
#define TclUtfPrev Tcl_UtfPrev
#if defined(TCL_NO_DEPRECATED)
# define TclListObjGetElements 0
# define TclListObjLength 0
# define TclDictObjSize 0
@@ -122,101 +104,6 @@ static void uniCodePanic() {
# define TclSplitPath 0
# define TclFSSplitPath 0
# define TclParseArgsObjv 0
#else /* !defined(TCL_NO_DEPRECATED) */
int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr,
void *objcPtr, Tcl_Obj ***objvPtr) {
Tcl_Size n = TCL_INDEX_NONE;
int result = Tcl_ListObjGetElements(interp, listPtr, &n, objvPtr);
if (objcPtr) {
if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
if (interp) {
Tcl_AppendResult(interp, "List too large to be processed", NULL);
}
return TCL_ERROR;
}
*(int *)objcPtr = (int)n;
}
return result;
}
int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr,
void *lengthPtr) {
Tcl_Size n = TCL_INDEX_NONE;
int result = Tcl_ListObjLength(interp, listPtr, &n);
if (lengthPtr) {
if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
if (interp) {
Tcl_AppendResult(interp, "List too large to be processed", NULL);
}
return TCL_ERROR;
}
*(int *)lengthPtr = (int)n;
}
return result;
}
int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr,
void *sizePtr) {
Tcl_Size n = TCL_INDEX_NONE;
int result = Tcl_DictObjSize(interp, dictPtr, &n);
if (sizePtr) {
if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
if (interp) {
Tcl_AppendResult(interp, "Dict too large to be processed", NULL);
}
return TCL_ERROR;
}
*(int *)sizePtr = (int)n;
}
return result;
}
int TclSplitList(Tcl_Interp *interp, const char *listStr, void *argcPtr,
const char ***argvPtr) {
Tcl_Size n = TCL_INDEX_NONE;
int result = Tcl_SplitList(interp, listStr, &n, argvPtr);
if (argcPtr) {
if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
if (interp) {
Tcl_AppendResult(interp, "List too large to be processed", NULL);
}
Tcl_Free((void *)*argvPtr);
return TCL_ERROR;
}
*(int *)argcPtr = (int)n;
}
return result;
}
void TclSplitPath(const char *path, void *argcPtr, const char ***argvPtr) {
Tcl_Size n = TCL_INDEX_NONE;
Tcl_SplitPath(path, &n, argvPtr);
if (argcPtr) {
if ((sizeof(int) != sizeof(size_t)) && (n > INT_MAX)) {
n = TCL_INDEX_NONE; /* No other way to return an error-situation */
Tcl_Free((void *)*argvPtr);
*argvPtr = NULL;
}
*(int *)argcPtr = (int)n;
}
}
Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, void *lenPtr) {
Tcl_Size n = TCL_INDEX_NONE;
Tcl_Obj *result = Tcl_FSSplitPath(pathPtr, &n);
if (lenPtr) {
if ((sizeof(int) != sizeof(size_t)) && result && (n > INT_MAX)) {
Tcl_DecrRefCount(result);
return NULL;
}
*(int *)lenPtr = (int)n;
}
return result;
}
int TclParseArgsObjv(Tcl_Interp *interp,
const Tcl_ArgvInfo *argTable, void *objcPtr, Tcl_Obj *const *objv,
Tcl_Obj ***remObjv) {
Tcl_Size n = (*(int *)objcPtr < 0) ? TCL_INDEX_NONE: (Tcl_Size)*(int *)objcPtr ;
int result = Tcl_ParseArgsObjv(interp, argTable, &n, objv, remObjv);
*(int *)objcPtr = (int)n;
return result;
}
#endif /* !defined(TCL_NO_DEPRECATED) */
#define TclBN_mp_add mp_add
#define TclBN_mp_add_d mp_add_d
+7 -21
View File
@@ -515,9 +515,6 @@ static const char version[] = TCL_PATCH_LEVEL "+" STRINGIFY(TCL_VERSION_UUID)
#ifdef STATIC_BUILD
".static"
#endif
#if TCL_UTF_MAX < 4
".utf-16"
#endif
;
int
@@ -546,12 +543,10 @@ Tcltest_Init(
}
if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
#if TCL_MAJOR_VERSION > 8
if (info.isNativeObjectProc == 2) {
Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
info.objProc2, (void *)version, NULL);
} else
#endif
Tcl_CreateObjCommand(interp, "::tcl::test::build-info",
info.objProc, (void *)version, NULL);
}
@@ -732,6 +727,12 @@ Tcltest_Init(
if (TclObjTest_Init(interp) != TCL_OK) {
return TCL_ERROR;
}
if (TcltestObjectInterfaceInit(interp) != TCL_OK) {
return TCL_ERROR;
}
if (TcltestObjectInterfaceListIntegerInit(interp) != TCL_OK) {
return TCL_ERROR;
}
if (Procbodytest_Init(interp) != TCL_OK) {
return TCL_ERROR;
}
@@ -741,10 +742,6 @@ Tcltest_Init(
}
#endif
if (Tcl_ABSListTest_Init(interp) != TCL_OK) {
return TCL_ERROR;
}
/*
* Check for special options used in ../tests/main.test
*/
@@ -814,12 +811,10 @@ Tcltest_SafeInit(
return TCL_ERROR;
}
if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
#if TCL_MAJOR_VERSION > 8
if (info.isNativeObjectProc == 2) {
Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
info.objProc2, (void *)version, NULL);
} else
#endif
Tcl_CreateObjCommand(interp, "::tcl::test::build-info",
info.objProc, (void *)version, NULL);
}
@@ -5762,17 +5757,7 @@ TestbytestringObjCmd(
Tcl_Obj *const objv[]) /* The argument objects. */
{
struct {
#if !defined(TCL_NO_DEPRECATED)
# if defined(_MSC_VER) && !defined(NDEBUG)
# pragma warning(disable:4133)
# elif defined(__clang__)
# pragma clang diagnostic push
# pragma clang diagnostic ignored "-Wincompatible-pointer-types"
# endif
int n; /* On purpose, not Tcl_Size, in order to demonstrate what happens */
#else
Tcl_Size n;
#endif
int m; /* This variable should not be overwritten */
} x = {0, 1};
const char *p;
@@ -8806,3 +8791,4 @@ vamoose:
* indent-tabs-mode: nil
* End:
*/
File diff suppressed because it is too large Load Diff
+14 -69
View File
@@ -891,7 +891,6 @@ TestlistobjCmd(
"replace",
"indexmemcheck",
"getelementsmemcheck",
"index",
NULL
};
enum listobjCmdIndex {
@@ -900,7 +899,6 @@ TestlistobjCmd(
LISTOBJ_REPLACE,
LISTOBJ_INDEXMEMCHECK,
LISTOBJ_GETELEMENTSMEMCHECK,
LISTOBJ_INDEX,
} cmdIndex;
Tcl_Size varIndex; /* Variable number converted to binary */
@@ -976,13 +974,16 @@ TestlistobjCmd(
!= TCL_OK) {
return TCL_ERROR;
}
if (objP->refCount < 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"Tcl_ListObjIndex returned object with ref count < 0",
TCL_INDEX_NONE));
/* Keep looping since we are also looping for leaks */
}
Tcl_BounceRefCount(objP);
Tcl_IncrRefCount(objP);
Tcl_DecrRefCount(objP);
TCL_COMMENT(
if (objP->refCount <= 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"Tcl_ListObjIndex returned object with ref count <= 0",
TCL_INDEX_NONE));
/* Keep looping since we are also looping for leaks */
}
)
}
break;
@@ -1009,26 +1010,6 @@ TestlistobjCmd(
}
}
break;
case LISTOBJ_INDEX:
/*
* Tcl_ListObjIndex semantics differ from lindex for out of bounds.
* Hence this explicit test.
*/
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv,
"varIndex listIndex");
return TCL_ERROR;
}
if (Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &first) != TCL_OK) {
return TCL_ERROR;
} else {
Tcl_Obj *objP;
if (Tcl_ListObjIndex(interp, varPtr[varIndex], first, &objP) != TCL_OK) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, objP ? objP : Tcl_NewStringObj("null", -1));
}
break;
}
return TCL_OK;
}
@@ -1050,33 +1031,6 @@ TestlistobjCmd(
*----------------------------------------------------------------------
*/
static Tcl_Size V1TestListObjLength(TCL_UNUSED(Tcl_Obj *)) {
return 100;
}
static int V1TestListObjIndex(
TCL_UNUSED(Tcl_Interp *),
TCL_UNUSED(Tcl_Obj *),
TCL_UNUSED(Tcl_Size),
Tcl_Obj **objPtr)
{
*objPtr = Tcl_NewStringObj("This indexProc should never be accessed (bug: e58d7e19e9)", -1);
return TCL_OK;
}
static const Tcl_ObjType v1TestListType = {
"testlist", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
offsetof(Tcl_ObjType, indexProc), /* This is a V1 objType, which doesn't have an indexProc */
V1TestListObjLength, /* always return 100, doesn't really matter */
V1TestListObjIndex, /* should never be accessed, because this objType = V1*/
NULL, NULL, NULL, NULL, NULL, NULL
};
static int
TestobjCmd(
TCL_UNUSED(void *),
@@ -1089,15 +1043,15 @@ TestobjCmd(
const Tcl_ObjType *targetType;
Tcl_Obj **varPtr;
const char *subcommands[] = {
"freeallvars", "bug3598580", "buge58d7e19e9",
"types", "objtype", "newobj", "set",
"freeallvars", "bug3598580", "types",
"objtype", "newobj", "set",
"assign", "convert", "duplicate",
"invalidateStringRep", "refcount", "type",
NULL
};
enum testobjCmdIndex {
TESTOBJ_FREEALLVARS, TESTOBJ_BUG3598580, TESTOBJ_BUGE58D7E19E9,
TESTOBJ_TYPES, TESTOBJ_OBJTYPE, TESTOBJ_NEWOBJ, TESTOBJ_SET,
TESTOBJ_FREEALLVARS, TESTOBJ_BUG3598580, TESTOBJ_TYPES,
TESTOBJ_OBJTYPE, TESTOBJ_NEWOBJ, TESTOBJ_SET,
TESTOBJ_ASSIGN, TESTOBJ_CONVERT, TESTOBJ_DUPLICATE,
TESTOBJ_INVALIDATESTRINGREP, TESTOBJ_REFCOUNT, TESTOBJ_TYPE,
} cmdIndex;
@@ -1139,15 +1093,6 @@ TestobjCmd(
Tcl_SetObjResult(interp, listObjPtr);
}
return TCL_OK;
case TESTOBJ_BUGE58D7E19E9:
if (objc != 3) {
goto wrongNumArgs;
} else {
Tcl_Obj *listObjPtr = Tcl_NewStringObj(Tcl_GetString(objv[2]), -1);
listObjPtr->typePtr = &v1TestListType;
Tcl_SetObjResult(interp, listObjPtr);
}
return TCL_OK;
case TESTOBJ_TYPES:
if (objc != 2) {
goto wrongNumArgs;
+530
View File
@@ -0,0 +1,530 @@
/*
* tclTestObjInterface.c --
*
* This file contains C command functions for the additional Tcl commands
* that are used for testing implementations of the Tcl object types.
* These commands are not normally included in Tcl applications; they're
* only used for testing.
*
* Copyright © 2021 Nathan Coulter
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tcl.h"
#include "tclInt.h"
/*
* Prototypes for functions defined later in this file:
*/
typedef struct indexHex {
int refCount;
Tcl_Size offset;
} indexHex;
int TcltestObjectInterfaceInit(Tcl_Interp *interp);
int NewTestIndexHex (
ClientData, Tcl_Interp *interp, Tcl_Size argc, Tcl_Obj *const objv[]);
static void DupTestIndexHexInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void FreeTestIndexHexInternalRep(Tcl_Obj *objPtr);
static int SetTestIndexHexFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void UpdateStringOfTestIndexHex(Tcl_Obj *listPtr);
static int indexHexListStringIndex (tclObjTypeInterfaceArgsStringIndex);
static int indexHexListStringIndexEnd(tclObjTypeInterfaceArgsStringIndexEnd);
static Tcl_Size indexHexListStringLength(tclObjTypeInterfaceArgsStringLength);
static int indexHexStringListIndexFromStringIndex(
Tcl_Size *index, Tcl_Size *itemchars, Tcl_Size *totalitems);
static Tcl_Obj* indexHexListStringRange(tclObjTypeInterfaceArgsStringRange);
static Tcl_Obj* indexHexListStringRangeEnd(tclObjTypeInterfaceArgsStringRangeEnd);
static int indexHexListObjGetElements (tclObjTypeInterfaceArgsListAll);
static int indexHexListObjAppendElement (tclObjTypeInterfaceArgsListAppend);
static int indexHexListObjAppendList (tclObjTypeInterfaceArgsListAppendList);
static int indexHexListObjIndex (tclObjTypeInterfaceArgsListIndex);
static int indexHexListObjIndexEnd (tclObjTypeInterfaceArgsListIndexEnd);
static int indexHexListObjIsSorted(tclObjTypeInterfaceArgsListIsSorted);
static int indexHexListObjLength (tclObjTypeInterfaceArgsListLength);
static Tcl_Obj* indexHexListObjRange (tclObjTypeInterfaceArgsListRange);
static Tcl_Obj* indexHexListObjRangeEnd (tclObjTypeInterfaceArgsListRangeEnd);
static int indexHexListObjReplace (tclObjTypeInterfaceArgsListReplace);
static int indexHexListObjSetElement (tclObjTypeInterfaceArgsListSet);
static Tcl_Obj * indexHexLsetFlat (tclObjTypeInterfaceArgsListSetList);
static int indexHexListErrorIndeterminate (Tcl_Interp *interp);
static int indexHexListErrorReadOnly (Tcl_Interp *interp);
ObjInterface IndexHexInterface = {
1,
{
&indexHexListStringIndex,
&indexHexListStringIndexEnd,
&indexHexListStringLength,
&indexHexListStringRange,
&indexHexListStringRangeEnd
},
{
&indexHexListObjGetElements,
&indexHexListObjAppendElement,
&indexHexListObjAppendList,
&indexHexListObjIndex,
&indexHexListObjIndexEnd,
&indexHexListObjIsSorted,
&indexHexListObjLength,
&indexHexListObjRange,
&indexHexListObjRangeEnd,
&indexHexListObjReplace,
NULL,
NULL,
&indexHexListObjSetElement,
&indexHexLsetFlat
}
};
const ObjectType testIndexHexType = {
"testindexHex",
FreeTestIndexHexInternalRep, /* freeIntRepProc */
DupTestIndexHexInternalRep, /* dupIntRepProc */
UpdateStringOfTestIndexHex, /* updateStringProc */
SetTestIndexHexFromAny, /* setFromAnyProc */
2,
(Tcl_ObjInterface *)&IndexHexInterface
};
const Tcl_ObjType *testIndexHexTypePtr = (Tcl_ObjType *)&testIndexHexType;
int TcltestObjectInterfaceInit(Tcl_Interp *interp) {
Tcl_CreateObjCommand2(interp, "testindexhex", NewTestIndexHex, NULL, NULL);
return TCL_OK;
}
int NewTestIndexHex (
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size argc,
Tcl_Obj *const objv[])
{
Tcl_WideInt offset;
Tcl_ObjInternalRep intrep;
if (argc > 2) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("too many arguments", -1));
return TCL_ERROR;
}
}
if (argc == 2) {
if (Tcl_GetWideIntFromObj(interp, objv[1], &offset) != TCL_OK) {
return TCL_ERROR;
}
if (offset < 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("bad offset", -1));
return TCL_ERROR;
}
} else {
offset = 0;
}
Tcl_Obj *objPtr = Tcl_NewObj();
Tcl_InvalidateStringRep(objPtr);
indexHex *indexHexPtr = (indexHex *)Tcl_Alloc(sizeof(indexHex));
indexHexPtr->refCount = 1;
indexHexPtr->offset = offset;
intrep.twoPtrValue.ptr1 = indexHexPtr;
Tcl_StoreInternalRep(objPtr, testIndexHexTypePtr, &intrep);
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
}
static void
DupTestIndexHexInternalRep(
TCL_UNUSED(Tcl_Obj *),
TCL_UNUSED(Tcl_Obj *))
{
return;
}
static void
FreeTestIndexHexInternalRep(Tcl_Obj *objPtr)
{
indexHex *indexHexPtr = (indexHex *)objPtr->internalRep.twoPtrValue.ptr1;
if (--indexHexPtr->refCount == 0) {
Tcl_Free(indexHexPtr);
}
return;
}
static int
SetTestIndexHexFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr)
{
if (TclHasInternalRep(objPtr, testIndexHexTypePtr)) {
return TCL_OK;
} else {
if (interp != NULL) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("can not set an existing value to this type", -1));
}
return TCL_ERROR;
}
}
static void
UpdateStringOfTestIndexHex(
TCL_UNUSED(Tcl_Obj *))
{
return;
}
static int indexHexListStringIndex(tclObjTypeInterfaceArgsStringIndex) {
Tcl_Obj *hexPtr;
int status;
Tcl_Size itemchars, totalitems;
status = indexHexStringListIndexFromStringIndex(
&index, &itemchars, &totalitems);
if (status != TCL_OK) {
return TCL_ERROR;
}
status = indexHexListObjIndex(interp, objPtr, totalitems, &hexPtr);
if (status != TCL_OK) {
return TCL_ERROR;
}
if (index == itemchars - 1) {
/* index refers to the space delimiter after the item. */
*objPtrPtr = Tcl_NewStringObj(" ", -1);
} else {
*objPtrPtr = Tcl_GetRange(hexPtr, index, index);
}
Tcl_DecrRefCount(hexPtr);
return status;
}
static int indexHexListErrorIndeterminate (Tcl_Interp *interp) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("list length indeterminate", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "INDETERMINATE", NULL);
return TCL_ERROR;
}
static int indexHexListErrorReadOnly (Tcl_Interp *interp) {
if (interp != NULL) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("list length indeterminate", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "INTERFACE",
"READONLY", NULL);
}
return TCL_ERROR;
}
static int indexHexStringListIndexFromStringIndex(
Tcl_Size *indexPtr, Tcl_Size *itemcharsPtr, Tcl_Size *totalitemsPtr)
{
Tcl_Size itemoffset, last = 0, power = 1, lasttotalchars = 0, newitems,
top, totalchars = 0;
/* add 1 for the space after the item */
*itemcharsPtr = power + 1;
*totalitemsPtr = 0;
/* Count the number of characters in the items that contain fewer
* characters than the item containing the requested index. */
while (1) {
top = 1u << (4 * power);
if (top < 1u << (4 * (power - 1))) {
/* operation wrapped around */
power -= 1;
break;
}
newitems = top - last;
lasttotalchars = totalchars;
totalchars += newitems * *itemcharsPtr;
last = top;
if (*indexPtr < totalchars) {
break;
}
power += 1;
*itemcharsPtr += 1;
*totalitemsPtr += newitems;
}
*indexPtr -= lasttotalchars;
/* Determine how many items containing the same number of characters
* precede the requested item. */
itemoffset = *indexPtr / *itemcharsPtr ;
*indexPtr = *indexPtr % *itemcharsPtr;
/* Add the number of new characters. */
*totalitemsPtr += itemoffset;
return TCL_OK;
}
static int indexHexListStringIndexEnd(
Tcl_Interp *interp,
TCL_UNUSED(Tcl_Obj *),
TCL_UNUSED(Tcl_Size),
TCL_UNUSED(Tcl_Obj **)
) {
return indexHexListErrorIndeterminate(interp);
}
static Tcl_Size indexHexListStringLength(
TCL_UNUSED(Tcl_Obj *);
) {
return TCL_INDEX_NONE;
}
static Tcl_Obj* indexHexListStringRange(tclObjTypeInterfaceArgsStringRange) {
Tcl_Obj *itemPtr, *item2Ptr, *resPtr;
Tcl_Size index = first, status;
Tcl_Size itemchars, needed, rangeLength, newStringLength,
stringLength, totalitems;
if (last < first) {
return Tcl_NewStringObj("", -1);
}
status = indexHexStringListIndexFromStringIndex(
&index, &itemchars, &totalitems);
if (status != TCL_OK) {
return NULL;
}
status = indexHexListObjIndex(NULL, objPtr, totalitems, &itemPtr);
if (status != TCL_OK) {
return NULL;
}
rangeLength = last - first + 1;
resPtr = Tcl_GetRange(itemPtr, index, index + rangeLength - 1);
Tcl_DecrRefCount(itemPtr);
stringLength = Tcl_GetCharLength(resPtr);
if (stringLength < rangeLength) {
needed = rangeLength - stringLength;
while (needed > 0) {
totalitems++;
status = indexHexListObjIndex(NULL, objPtr, totalitems, &itemPtr);
if (status != TCL_OK) {
return NULL;
}
Tcl_AppendToObj(resPtr, " ", 1);
stringLength += newStringLength;
needed -= 1;
if (needed > 0) {
newStringLength = Tcl_GetCharLength(itemPtr);
if (newStringLength >= needed) {
item2Ptr = Tcl_GetRange(itemPtr, 0, needed-1);
newStringLength = Tcl_GetCharLength(item2Ptr);
Tcl_AppendObjToObj(resPtr, item2Ptr);
Tcl_DecrRefCount(item2Ptr);
} else {
Tcl_AppendObjToObj(resPtr, itemPtr);
}
stringLength += newStringLength;
needed -= newStringLength;
}
Tcl_DecrRefCount(itemPtr);
}
}
return resPtr;
}
static Tcl_Obj* indexHexListStringRangeEnd(
TCL_UNUSED(Tcl_Obj *),/* The Tcl object to find the range of. */
TCL_UNUSED(Tcl_Size),/* First index of the range. */
TCL_UNUSED(Tcl_Size) /* Last index of the range. */
) {
return NULL;
}
static int
indexHexListObjGetElements(
Tcl_Interp *interp, /* Used to report errors if not NULL. */
TCL_UNUSED(Tcl_Obj *),/* List object for which an element array
* is to be returned. */
TCL_UNUSED(Tcl_Size *),/* Where to store the count of objects
* referenced by objv. */
TCL_UNUSED(Tcl_Obj ***)/* Where to store the pointer to an
* array of */
)
{
if (interp != NULL) {
Tcl_SetObjResult(interp,Tcl_NewStringObj("infinite list", -1));
}
return TCL_ERROR;
}
static int
indexHexListObjAppendElement(
Tcl_Interp *interp, /* Used to report errors if not NULL. */
TCL_UNUSED(Tcl_Obj *),/* List object to append objPtr to. */
TCL_UNUSED(Tcl_Obj *)/* Object to append to listPtr's list. */
)
{
indexHexListErrorReadOnly(interp);
return TCL_ERROR;
}
static int
indexHexListObjAppendList(
Tcl_Interp *interp, /* Used to report errors if not NULL. */
TCL_UNUSED(Tcl_Obj *), /* List object to append elements to. */
TCL_UNUSED(Tcl_Obj *) /* List obj with elements to append. */
)
{
indexHexListErrorReadOnly(interp);
return TCL_ERROR;
}
static int
indexHexListObjIndex(
TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
TCL_UNUSED(Tcl_Obj *), /* List object to index into. */ \
Tcl_Size index, /* Index of element to return. */ \
Tcl_Obj **objPtrPtr /* The resulting Tcl_Obj* is stored here. */
)
{
Tcl_Obj *resPtr;
resPtr = Tcl_ObjPrintf("%" TCL_T_MODIFIER "x", index);
*objPtrPtr = resPtr;
return TCL_OK;
}
static int
indexHexListObjIndexEnd(
Tcl_Interp * interp,/* Used to report errors if not NULL. */ \
TCL_UNUSED(Tcl_Obj *),/* List object to index into. */ \
TCL_UNUSED(Tcl_Size),/* Index of element to return. */ \
TCL_UNUSED(Tcl_Obj **)/* The resulting Tcl_Obj* is stored here. */
)
{
return indexHexListErrorIndeterminate(interp);
}
static int indexHexListObjIsSorted(
TCL_UNUSED(Tcl_Interp *), /* Used to report errors */
TCL_UNUSED(Tcl_Obj *), /* The list in question */
TCL_UNUSED(size_t) /* flags */
)
{
return 1;
}
static int
indexHexListObjLength(
TCL_UNUSED(Tcl_Interp *), /* Used to report errors if not NULL. */
TCL_UNUSED(Tcl_Obj *), /* List object whose #elements to return. */
Tcl_Size *lenPtr /* The resulting length is stored here. */
)
{
*lenPtr = -1;
return TCL_OK;
}
static Tcl_Obj*
indexHexListObjRange(tclObjTypeInterfaceArgsListRange)
{
Tcl_Obj *itemPtr, *resPtr;
Tcl_Size length;
int status;
resPtr = Tcl_NewListObj(0, NULL);
status = Tcl_ListObjLength(interp, listObj, &length);
if (!status) {
return NULL;
}
while (rangeStart <= length && rangeStart <= rangeEnd) {
indexHexListObjIndex(interp, listObj, rangeStart, &itemPtr);
if (
Tcl_ListObjAppendElement(interp, resPtr, itemPtr) != TCL_OK
) {
Tcl_DecrRefCount(resPtr);
return NULL;
}
rangeStart++;
}
return resPtr;
}
static Tcl_Obj*
indexHexListObjRangeEnd(tclObjTypeInterfaceArgsListRangeEnd) {
if (fromAnchor == 1 || toAnchor == 1) {
indexHexListErrorIndeterminate(interp);
return NULL;
}
return indexHexListObjRange(interp, listPtr, fromIdx, toIdx);
}
static int
indexHexListObjReplace(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */ \
TCL_UNUSED(Tcl_Obj *), /* List object whose elements to replace. */ \
TCL_UNUSED(Tcl_Size), /* Index of first element to replace. */ \
TCL_UNUSED(Tcl_Size), /* Number of elements to replace. */ \
TCL_UNUSED(Tcl_Size), /* Number of objects to insert. */ \
/* An array of objc pointers to Tcl \
* objects to insert. */ \
TCL_UNUSEDVAR(Tcl_Obj *const insertObjs[])
)
{
indexHexListErrorReadOnly(interp);
return TCL_ERROR;
}
static int
indexHexListObjSetElement(
Tcl_Interp *interp, /* Tcl interpreter; used for error reporting
* if not NULL. */
TCL_UNUSED(Tcl_Obj *), /* List object in which element should be
* stored. */
TCL_UNUSED(Tcl_Size), /* Index of element to store. */
TCL_UNUSED(Tcl_Obj *)/* Tcl object to store in the designated list
* element. */
)
{
indexHexListErrorReadOnly(interp);
return TCL_ERROR;
}
static Tcl_Obj * indexHexLsetFlat (
Tcl_Interp *interp, /* Tcl interpreter. */ \
TCL_UNUSED(Tcl_Obj *), /* Pointer to the list being modified. */ \
TCL_UNUSED(Tcl_Size), /* Number of index args. */ \
TCL_UNUSEDVAR(Tcl_Obj *const indexArray[]), /* Index args. */ \
TCL_UNUSED(Tcl_Obj *) /* Value arg to 'lset' or NULL to 'lpop'. */
)
{
indexHexListErrorReadOnly(interp);
return NULL;
}
+683
View File
@@ -0,0 +1,683 @@
/*
* tclTestObjInterfce.c --
*
* This file contains C command functions for the additional Tcl commands
* that are used for testing implementations of the Tcl object types.
* These commands are not normally included in Tcl applications; they're
* only used for testing.
*
* Copyright © 2021 Nathan Coulter
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tcl.h"
#include "tclInt.h"
/*
* Prototypes for functions defined later in this file:
*/
int TestListInteger (
ClientData, Tcl_Interp *interp, Tcl_Size argc, Tcl_Obj *const objv[]);
static Tcl_Obj* NewTestListInteger();
static void DupTestListIntegerInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void FreeTestListIntegerInternalRep(Tcl_Obj *objPtr);
static int SetTestListIntegerFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void UpdateStringOfTestListInteger(Tcl_Obj *listPtr);
static int ListIntegerListStringIndex (tclObjTypeInterfaceArgsStringIndex);
static int ListIntegerListStringIndexEnd(tclObjTypeInterfaceArgsStringIndexEnd);
static Tcl_Size ListIntegerListStringLength(tclObjTypeInterfaceArgsStringLength);
/*
static int ListIntegerStringListIndexFromStringIndex(
Tcl_Size *index, Tcl_Size *itemchars, Tcl_Size *totalitems);
*/
static Tcl_Obj* ListIntegerListStringRange(tclObjTypeInterfaceArgsStringRange);
static Tcl_Obj* ListIntegerListStringRangeEnd(tclObjTypeInterfaceArgsStringRangeEnd);
static int ListIntegerListObjGetElements(tclObjTypeInterfaceArgsListAll);
static int ListIntegerListObjAppendElement(tclObjTypeInterfaceArgsListAppend);
static int ListIntegerListObjAppendList(tclObjTypeInterfaceArgsListAppendList);
static int ListIntegerListObjIndex(tclObjTypeInterfaceArgsListIndex);
static int ListIntegerListObjIndexEnd (tclObjTypeInterfaceArgsListIndexEnd);
static int ListIntegerListObjIsSorted(tclObjTypeInterfaceArgsListIsSorted);
static int ListIntegerListObjLength(tclObjTypeInterfaceArgsListLength);
static Tcl_Obj* ListIntegerListObjRange(tclObjTypeInterfaceArgsListRange);
static Tcl_Obj* ListIntegerListObjRangeEnd(tclObjTypeInterfaceArgsListRangeEnd);
static int ListIntegerListObjReplace(tclObjTypeInterfaceArgsListReplace);
static int ListIntegerListObjReplaceList(tclObjTypeInterfaceArgsListReplaceList);
static int ListIntegerListObjSetElement(tclObjTypeInterfaceArgsListSet);
static Tcl_Obj * ListIntegerLsetFlat(tclObjTypeInterfaceArgsListSetList);
static int ErrorMaxElementsExceeded(Tcl_Interp *interp);
ObjInterface ListIntegerInterface = {
1,
{
&ListIntegerListStringIndex,
&ListIntegerListStringIndexEnd,
&ListIntegerListStringLength,
&ListIntegerListStringRange,
&ListIntegerListStringRangeEnd
},
{
&ListIntegerListObjGetElements,
&ListIntegerListObjAppendElement,
&ListIntegerListObjAppendList,
&ListIntegerListObjIndex,
&ListIntegerListObjIndexEnd,
&ListIntegerListObjIsSorted,
&ListIntegerListObjLength,
&ListIntegerListObjRange,
&ListIntegerListObjRangeEnd,
&ListIntegerListObjReplace,
&ListIntegerListObjReplaceList,
NULL,
&ListIntegerListObjSetElement,
&ListIntegerLsetFlat
}
};
typedef struct ListInteger {
int refCount;
int ownstring;
int size;
int used;
int values[1];
} ListInteger;
static ListInteger* NewTestListIntegerIntrep();
static ListInteger* ListGetInternalRep(Tcl_Obj *listPtr);
static void ListIntegerDecrRefCount(ListInteger *listIntegerPtr);
const ObjectType testListIntegerType = {
"testListInteger",
FreeTestListIntegerInternalRep, /* freeIntRepProc */
DupTestListIntegerInternalRep, /* dupIntRepProc */
UpdateStringOfTestListInteger, /* updateStringProc */
SetTestListIntegerFromAny, /* setFromAnyProc */
2,
(Tcl_ObjInterface *)&ListIntegerInterface
};
const Tcl_ObjType *testListIntegerTypePtr = (Tcl_ObjType *)&testListIntegerType;
int TcltestObjectInterfaceListIntegerInit(Tcl_Interp *interp) {
Tcl_CreateObjCommand2(interp, "testlistinteger", TestListInteger, NULL, NULL);
return TCL_OK;
}
int TestListInteger(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size argc,
Tcl_Obj *const objv[])
{
int status;
if (argc != 2) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # arguments", -1));
}
return TCL_ERROR;
}
status = Tcl_ConvertToType(interp, objv[1], testListIntegerTypePtr);
Tcl_SetObjResult(interp, objv[1]);
return status;
}
Tcl_Obj*
NewTestListInteger() {
Tcl_ObjInternalRep intrep;
Tcl_Obj *listPtr = Tcl_NewObj();
Tcl_InvalidateStringRep(listPtr);
ListInteger *listIntegerPtr = NewTestListIntegerIntrep();
intrep.twoPtrValue.ptr1 = listIntegerPtr;
Tcl_StoreInternalRep(listPtr, testListIntegerTypePtr, &intrep);
return listPtr;
}
ListInteger*
NewTestListIntegerIntrep() {
ListInteger *listIntegerPtr = (ListInteger *)Tcl_Alloc(sizeof(ListInteger));
listIntegerPtr->refCount = 1;
listIntegerPtr->ownstring = 0;
listIntegerPtr->size = 1;
listIntegerPtr->used = 0;
return listIntegerPtr;
}
static ListInteger* ListGetInternalRep(Tcl_Obj *listPtr) {
return (ListInteger *)listPtr->internalRep.twoPtrValue.ptr1;
}
static void DupTestListIntegerInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) {
Tcl_ObjInternalRep intrep;
ListInteger *listRepPtr = ListGetInternalRep(srcPtr);
listRepPtr->refCount++;
intrep.twoPtrValue.ptr1 = listRepPtr;
Tcl_StoreInternalRep(copyPtr, testListIntegerTypePtr, &intrep);
return;
}
static void FreeTestListIntegerInternalRep(Tcl_Obj *listPtr) {
ListInteger *listRepPtr = ListGetInternalRep(listPtr);
ListIntegerDecrRefCount(listRepPtr);
return;
}
static int SetTestListIntegerFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) {
int status;
Tcl_Size i, length;
Tcl_Obj *itemPtr, *listPtr;
Tcl_ObjInternalRep intrep;
ListInteger *listRepPtr;
if (TclHasInternalRep(objPtr, testListIntegerTypePtr)) {
return TCL_OK;
} else {
status = Tcl_ListObjLength(interp, objPtr, &length);
if (status != TCL_OK) {
return TCL_ERROR;
}
listPtr = NewTestListInteger();
for (i = 0; i < length; i++) {
status = Tcl_ListObjIndex(interp, objPtr, i, &itemPtr);
if (status != TCL_OK) {
Tcl_DecrRefCount(listPtr);
return status;
}
status = ListIntegerListObjReplace(interp, listPtr, i, 0, 1, &itemPtr);
if (status != TCL_OK) {
Tcl_DecrRefCount(listPtr);
return status;
}
}
listRepPtr = ListGetInternalRep(listPtr);
intrep.twoPtrValue.ptr1 = listRepPtr;
listRepPtr->refCount++;
Tcl_StoreInternalRep(objPtr, testListIntegerTypePtr, &intrep);
Tcl_DecrRefCount(listPtr);
return TCL_OK;
}
}
static void UpdateStringOfTestListInteger(Tcl_Obj *listPtr) {
ListInteger *listRepPtr = ListGetInternalRep(listPtr);
int i, num, used = listRepPtr->used;
Tcl_Obj *strPtr, *numObjPtr;
if (used > 0) {
strPtr = Tcl_NewObj();
Tcl_IncrRefCount(strPtr);
num = listRepPtr->values[0];
numObjPtr = Tcl_NewIntObj(num);
Tcl_IncrRefCount(numObjPtr);
Tcl_AppendFormatToObj(NULL, strPtr, "%d", 1, &numObjPtr);
Tcl_DecrRefCount(numObjPtr);
for (i = 1; i < used; i++) {
num = listRepPtr->values[i];
numObjPtr = Tcl_NewIntObj(num);
Tcl_IncrRefCount(numObjPtr);
Tcl_AppendFormatToObj(NULL, strPtr, " %d", 1, &numObjPtr);
Tcl_DecrRefCount(numObjPtr);
}
listPtr->bytes = strPtr->bytes;
listPtr->length = strPtr->length;
strPtr->bytes = 0;
strPtr->length = 0;
Tcl_DecrRefCount(strPtr);
} else {
Tcl_InitStringRep(listPtr, NULL, 0);
}
listRepPtr->ownstring = 1;
return;
}
static void ListIntegerDecrRefCount(ListInteger *listIntegerPtr) {
if (--listIntegerPtr->refCount <= 0) {
Tcl_Free(listIntegerPtr);
}
return;
}
static int ListIntegerListStringIndex (
TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
TCL_UNUSED(Tcl_Obj *), /* List object to index into. */ \
TCL_UNUSED(Tcl_Size), /* Index of element to return. */ \
TCL_UNUSED(Tcl_Obj **)/* The resulting Tcl_Obj* is stored here. */
)
{
return TCL_ERROR;
}
static int ListIntegerListStringIndexEnd(
TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
TCL_UNUSED(Tcl_Obj *),/* List object to index into. */ \
TCL_UNUSED(Tcl_Size),/* Index of element to return. */ \
TCL_UNUSED(Tcl_Obj **)/* The resulting Tcl_Obj* is stored here. */
) {
return TCL_ERROR;
}
static Tcl_Size ListIntegerListStringLength(
TCL_UNUSED(Tcl_Obj *);
) {
return TCL_ERROR;
}
/*
static int ListIntegerStringListIndexFromStringIndex(
TCL_UNUSEDVAR(Tcl_Size *index),
TCL_UNUSEDVAR(Tcl_Size *itemchars),
TCL_UNUSEDVAR(Tcl_Size *totalitems)
) {
return TCL_ERROR;
}
*/
static Tcl_Obj* ListIntegerListStringRange(
TCL_UNUSEDVAR(Tcl_Obj *objPtr), /* The Tcl object to find the range of. */
TCL_UNUSEDVAR(Tcl_Size first), /* First index of the range. */
TCL_UNUSEDVAR(Tcl_Size last) /* Last index of the range. */
) {
return NULL;
}
static Tcl_Obj* ListIntegerListStringRangeEnd(
TCL_UNUSED(Tcl_Obj *),/* The Tcl object to find the range of. */
TCL_UNUSED(Tcl_Size),/* First index of the range. */
TCL_UNUSED(Tcl_Size) /* Last index of the range. */
) {
return NULL;
}
static int ListIntegerListObjGetElements(
TCL_UNUSEDVAR(Tcl_Interp *interp), /* Used to report errors if not NULL. */
TCL_UNUSEDVAR(Tcl_Obj *listPtr), /* List object for which an element array
* is to be returned. */
TCL_UNUSEDVAR(Tcl_Size *objcPtr), /* Where to store the count of objects
* referenced by objv. */
TCL_UNUSEDVAR(Tcl_Obj ***objvPtr) /* Where to store the pointer to an
* array of */
) {
ListInteger *listRepPtr;
listRepPtr = ListGetInternalRep(listPtr);
*objcPtr = listRepPtr->used;
*objvPtr = listRepPtr->values;
return TCL_OK;
}
static int ListIntegerListObjAppendElement(tclObjTypeInterfaceArgsListAppend) {
int status;
Tcl_Size length;
status = Tcl_ListObjLength(interp, listPtr, &length);
if (status != TCL_OK) {
return TCL_ERROR;
}
return ListIntegerListObjReplace(interp, listPtr, length, 0, 1, &objPtr);
}
static int ListIntegerListObjAppendList(
TCL_UNUSEDVAR(Tcl_Interp *interp), /* Used to report errors if not NULL. */ \
TCL_UNUSEDVAR(Tcl_Obj *listPtr), /* List object to append elements to. */ \
TCL_UNUSEDVAR(Tcl_Obj *elemListPtr) /* List obj with elements to append. */
) {
return TCL_ERROR;
}
static int ListIntegerListObjIndex(
TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
Tcl_Obj * listObj,/* List object to index into. */ \
Tcl_Size index, /* Index of element to return. */ \
Tcl_Obj **objPtrPtr /* The resulting Tcl_Obj* is stored here. */
) {
ListInteger *listRepPtr = ListGetInternalRep(listObj);
Tcl_Size num;
if (index >= 0 && index < listRepPtr->used) {
num = listRepPtr->values[index];
*objPtrPtr = Tcl_NewLongObj(num);
} else {
*objPtrPtr = NULL;
}
return TCL_OK;
}
static int ListIntegerListObjIndexEnd(
TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
TCL_UNUSED(Tcl_Obj *),/* List object to index into. */ \
TCL_UNUSED(Tcl_Size),/* Index of element to return. */ \
TCL_UNUSED(Tcl_Obj **)/* The resulting Tcl_Obj* is stored here. */
) {
return TCL_ERROR;
}
static int ListIntegerListObjIsSorted(
TCL_UNUSED(Tcl_Interp *), /* Used to report errors */
TCL_UNUSED(Tcl_Obj *), /* The list in question */
TCL_UNUSED(size_t) /* flags */
) {
return TCL_ERROR;
}
static int ListIntegerListObjLength(
TCL_UNUSED(Tcl_Interp *), /* Used to report errors if not NULL. */
Tcl_Obj * listObj, /* List object whose #elements to return. */
Tcl_Size *lenPtr /* The resulting length is stored here. */
) {
ListInteger *listRepPtr = ListGetInternalRep(listObj);
*lenPtr = listRepPtr->used;
return TCL_OK;
}
static Tcl_Obj* ListIntegerListObjRange(tclObjTypeInterfaceArgsListRange) {
ListInteger *listRepPtr = ListGetInternalRep(listObj);
Tcl_Size i, j, num, used = listRepPtr->used;
Tcl_Obj *numObjPtr, *resPtr;
if ((rangeStart == 0 && rangeEnd >= used - 1) || used == 0) {
return listObj;
}
if (Tcl_IsShared(listObj) ||
((listRepPtr->refCount > 1))) {
if (rangeStart >= used || rangeEnd < rangeStart) {
return Tcl_NewObj();
} else {
resPtr = NewTestListInteger();
for (i = rangeStart, j = 0; i <= rangeEnd; i++, j++) {
num = listRepPtr->values[i];
numObjPtr = Tcl_NewIntObj(num);
Tcl_IncrRefCount(numObjPtr);
if (ListIntegerListObjReplace(
interp, resPtr, j , 0 , 1 ,&numObjPtr) != TCL_OK) {
Tcl_DecrRefCount(resPtr);
Tcl_DecrRefCount(numObjPtr);
return NULL;
}
Tcl_DecrRefCount(numObjPtr);
}
return resPtr;
}
}
return NULL;
}
static Tcl_Obj* ListIntegerListObjRangeEnd(
TCL_UNUSEDVAR(Tcl_Interp * interp), /* Used to report errors */ \
TCL_UNUSEDVAR(Tcl_Obj *listPtr), /* List object to take a range from. */ \
TCL_UNUSEDVAR(Tcl_Size fromAnchor),/* 0 for start and 1 for end */ \
TCL_UNUSEDVAR(Tcl_Size fromIdx), /* Index of first element to include. */ \
TCL_UNUSEDVAR(Tcl_Size toAnchor), /* 0 for start and 1 for end */ \
TCL_UNUSEDVAR(Tcl_Size toIdx) /* Index of last element to include. */
) {
return NULL;
}
static int ListIntegerListObjReplace(tclObjTypeInterfaceArgsListReplace) {
int i, status;
Tcl_Obj *tmpListPtr = Tcl_NewObj();
Tcl_IncrRefCount(tmpListPtr);
for (i = 0; i < numToInsert; i++) {
status = Tcl_ListObjAppendElement(interp, tmpListPtr, insertObjs[i]);
if (status != TCL_OK) {
Tcl_DecrRefCount(tmpListPtr);
return status;
}
}
status = ListIntegerListObjReplaceList(
interp, listObj, first, numToDelete, tmpListPtr);
Tcl_DecrRefCount(tmpListPtr);
return status;
}
static int ListIntegerListObjReplaceList(tclObjTypeInterfaceArgsListReplaceList) {
ListInteger *listRepPtr = ListGetInternalRep(listPtr);
ListInteger *newListRepPtr;
int changed = 0, itemInt, status;
Tcl_Size i, index, newmemsize, itemsLength, j, newsize,
newtailindex, newused, size, newtailend, tailindex, tailsize,
used;
Tcl_Obj *itemPtr;
size = listRepPtr->size;
used = listRepPtr->used;
if (first < used) {
tailsize = used - first;
} else {
tailsize = 0;
}
status = Tcl_ListObjLength(interp, newItemsPtr, &itemsLength);
if (status != TCL_OK) {
return TCL_ERROR;
}
/* Currently this duplicates checks found in of Tcl_ListObjReplace, but
* maybe in the future Tcl remove those checks
*/
if (first >= used) {
first = used;
} else if (first < 0) {
first = 0;
}
if (count > tailsize) {
count = tailsize;
}
/* If count == 0 and itemsLength == 0 this routine is logically a no-op,
* but any non-canonical string representation must still be invalidated.
*/
/* to do:
* Recode this routine to work with incoming of unbounded length
*/
if (used > 0) {
tailindex = first + count;
newtailindex = first + itemsLength;
if (INT_MAX - tailsize - 1 < newtailindex) {
return ErrorMaxElementsExceeded(interp);
}
newused = newtailindex + tailsize;
if (itemsLength > 0 && INT_MAX - itemsLength < newused) {
return ErrorMaxElementsExceeded(interp);
}
} else {
tailindex = 0;
newtailindex = 0;
newused = itemsLength;
}
if (newused > size && newused > 1) {
newsize = (newused + newused / 5 + 1);
if (newsize < size) {
return ErrorMaxElementsExceeded(interp);
}
} else {
newsize = size;
}
if (!listRepPtr->ownstring) {
/* schedule canonicalization of the string rep */
Tcl_InvalidateStringRep(listPtr);
listRepPtr->ownstring = 1;
}
if (newused < used) {
Tcl_InvalidateStringRep(listPtr);
}
newmemsize = sizeof(ListInteger) + newsize * sizeof(int) - sizeof(int);
if (listRepPtr->refCount > 1) {
Tcl_ObjInternalRep intrep;
/* copy only the structure and the head of the old array */
int movsize = sizeof(ListInteger)
+ ((first + 1) * sizeof(int) - sizeof(int));
newListRepPtr = (ListInteger *)Tcl_Alloc(newmemsize);
memmove(newListRepPtr, listRepPtr, movsize);
newListRepPtr->size = newsize;
newListRepPtr->refCount = 1;
/* move the tail to its new location to make room for the new additions
*/
memmove(newListRepPtr->values + newtailindex,
listRepPtr->values + tailindex, tailsize * sizeof(int));
intrep.twoPtrValue.ptr1 = newListRepPtr;
Tcl_StoreInternalRep(listPtr, testListIntegerTypePtr, &intrep);
} else {
if (newsize > size && newused > 1) {
newListRepPtr = (ListInteger *)Tcl_Realloc(listRepPtr, newmemsize);
} else {
newListRepPtr = listRepPtr;
}
newListRepPtr->size = newsize;
if (tailsize > 0 && tailindex != newtailindex) {
/* move the tail to its new location to make room for the new
* additions */
memmove(newListRepPtr->values + newtailindex,
newListRepPtr->values + tailindex, tailsize);
}
listPtr->internalRep.twoPtrValue.ptr1 = newListRepPtr;
}
i = -1;
while (1) {
i++;
index = first + i;
status = Tcl_ListObjIndex(interp, newItemsPtr, i, &itemPtr);
if (status != TCL_OK) {
return status;
}
if (itemPtr == NULL) {
break;
}
if (Tcl_GetIntFromObj(interp, itemPtr, &itemInt)
== TCL_OK) {
if (newListRepPtr->values[index] != itemInt) {
changed = 1;
newListRepPtr->values[index] = itemInt;
}
newListRepPtr->values[index] = itemInt;
} else {
Tcl_Obj *realListPtr;
/* Fall back to normal list */
realListPtr = Tcl_NewListObj(newsize, NULL);
Tcl_IncrRefCount(realListPtr);
for (j = 0; j < index; j++) {
itemPtr = Tcl_NewIntObj(newListRepPtr->values[j]);
status = Tcl_ListObjAppendElement(
interp, realListPtr, itemPtr);
if (status != TCL_OK) {
Tcl_DecrRefCount(realListPtr);
return status;
}
}
while (1) {
if (itemsLength == TCL_LENGTH_NONE) {
status = Tcl_ListObjLength(interp, newItemsPtr, &itemsLength);
if (status != TCL_OK) {
Tcl_DecrRefCount(realListPtr);
return status;
}
}
if (itemsLength != TCL_LENGTH_NONE && i >= itemsLength) {
break;
}
status = Tcl_ListObjIndex(interp, newItemsPtr, i, &itemPtr);
if (status != TCL_OK) {
Tcl_DecrRefCount(realListPtr);
return status;
}
if (itemPtr == NULL) {
break;
}
status = Tcl_ListObjAppendElement(
interp, realListPtr, itemPtr);
if (status != TCL_OK) {
Tcl_DecrRefCount(realListPtr);
return status;
}
i++;
}
newtailend = newtailindex + tailsize;
for (i = newtailindex; i < newtailend; i++) {
itemPtr = Tcl_NewIntObj(newListRepPtr->values[i]);
Tcl_ListObjAppendElement(interp, realListPtr, itemPtr);
if (status != TCL_OK) {
Tcl_DecrRefCount(realListPtr);
return status;
}
}
ListIntegerDecrRefCount(newListRepPtr);
listPtr->internalRep = realListPtr->internalRep;
listPtr->typePtr = realListPtr->typePtr;
realListPtr->typePtr = NULL;
Tcl_DecrRefCount(realListPtr);
/* this might not always be necessary, but probably the best that
* can be done in this case */
Tcl_InvalidateStringRep(listPtr);
return TCL_OK;
}
}
if (changed) {
Tcl_InvalidateStringRep(listPtr);
}
/* To make the operation transactional, update "used" only after all
* elemnts have been succesfully added.
*/
newListRepPtr->used = newused;
return TCL_OK;
}
static int ListIntegerListObjSetElement(
TCL_UNUSED(Tcl_Interp *), /* Tcl interpreter; used for error reporting
* if not NULL. */
TCL_UNUSED(Tcl_Obj *), /* List object in which element should be
* stored. */
TCL_UNUSED(Tcl_Size), /* Index of element to store. */
TCL_UNUSED(Tcl_Obj *) /* Tcl object to store in the designated list
* element. */
) {
return TCL_ERROR;
}
static Tcl_Obj * ListIntegerLsetFlat(
TCL_UNUSED(Tcl_Interp *), /* Tcl interpreter. */ \
TCL_UNUSED(Tcl_Obj *), /* Pointer to the list being modified. */ \
TCL_UNUSED(Tcl_Size), /* Number of index args. */ \
TCL_UNUSEDVAR(Tcl_Obj *const indexArray[]), /* Index args. */ \
TCL_UNUSED(Tcl_Obj *)/* Value arg to 'lset' or NULL to 'lpop'. */
) {
return NULL;
}
static int ErrorMaxElementsExceeded(Tcl_Interp *interp) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"max length of a Tcl list (%" TCL_T_MODIFIER "d elements) exceeded",
LIST_MAX));
}
return TCL_ERROR;
}
+7 -1
View File
@@ -1,7 +1,13 @@
#ifndef BN_TCL_H_
#define BN_TCL_H_
#include <stdint.h>
#ifdef MP_NO_STDINT
# ifdef HAVE_STDINT_H
# include <stdint.h>
# else
# include "../compat/stdint.h"
# endif
#endif
#if defined(TCL_NO_TOMMATH_H)
typedef size_t mp_digit;
typedef int mp_sign;
+2 -16
View File
@@ -195,7 +195,6 @@ static const unsigned short pageMap[] = {
1344, 1344, 1344, 10112, 10144, 1344, 10176, 1344, 10208, 10240, 10272,
10304, 10336, 10368, 1344, 1344, 1344, 10400, 10432, 64, 10464, 10496,
10528, 4736, 10560, 10592
#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
,10624, 10656, 10688, 3296, 1344, 1344, 1344, 10720, 10752, 10784,
10816, 10848, 10880, 10912, 10944, 10976, 3296, 3296, 3296, 3296, 9216,
1344, 11008, 11040, 1344, 11072, 11104, 11136, 11168, 1344, 11200,
@@ -568,8 +567,6 @@ static const unsigned short pageMap[] = {
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 15520
#endif /* TCL_UTF_MAX > 3 */
};
/*
@@ -1180,7 +1177,6 @@ static const unsigned char groupMap[] = {
15, 15, 15, 0, 0, 15, 15, 15, 0, 0, 0, 4, 4, 7, 11, 14, 4, 4, 0, 14,
7, 7, 7, 7, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 14, 14,
0, 0
#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
,15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
@@ -1653,8 +1649,6 @@ static const unsigned char groupMap[] = {
15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
#endif /* TCL_UTF_MAX > 3 */
};
/*
@@ -1702,11 +1696,7 @@ static const int groups[] = {
18, 17, 10305, 10370, 10049, 10114, 8769, 8834
};
#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= 0x323C0)
#else
# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1F0000) != 0)
#endif
# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= 0x323C0)
/*
* The following constants are used to determine the category of a
@@ -1761,8 +1751,4 @@ enum {
* Unicode character tables.
*/
#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
# define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0x1FFFFF) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
#else
# define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0xFFFF) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
#endif
# define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0x1FFFFF) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
+12 -172
View File
@@ -215,9 +215,7 @@ Tcl_UniCharToUtf(
* character (at most 4 bytes).
*/
{
#if TCL_UTF_MAX > 3
int flags = ch;
#endif
if (ch >= TCL_COMBINE) {
ch &= (TCL_COMBINE - 1);
@@ -234,9 +232,7 @@ Tcl_UniCharToUtf(
}
if (ch <= 0xFFFF) {
if (
#if TCL_UTF_MAX > 3
(flags & TCL_COMBINE) &&
#endif
((ch & 0xF800) == 0xD800)) {
if (ch & 0x0400) {
/* Low surrogate */
@@ -349,15 +345,6 @@ Tcl_UniCharToUtfDString(
p = string;
wEnd = uniStr + uniLength;
#if TCL_UTF_MAX < 4
/* Initialize the buffer so that some random data doesn't trick
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
* Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
* prior non-stateful nature, this call to memset can also be removed.
*/
memset(p, 0xff, Tcl_DStringLength(dsPtr) - oldLength);
#endif
for (w = uniStr; w < wEnd; ) {
p += Tcl_UniCharToUtf(*w, p);
w++;
@@ -402,15 +389,6 @@ Tcl_Char16ToUtfDString(
p = string;
wEnd = uniStr + uniLength;
#if TCL_UTF_MAX < 4
/* Initialize the buffer so that some random data doesn't trick
* Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
* Because TCL_COMBINE is used here, memset() is required even when
* TCL_UTF_MAX == 4.
*/
memset(p, 0xff, Tcl_DStringLength(dsPtr) - oldLength);
#endif
for (w = uniStr; w < wEnd; ) {
if (!len && ((*w & 0xFC00) != 0xDC00)) {
/* Special case for handling high surrogates. */
@@ -447,15 +425,6 @@ Tcl_Char16ToUtfDString(
* Tcl_UtfCharComplete() before calling this routine to ensure that
* enough bytes remain in the string.
*
* If TCL_UTF_MAX < 4, special handling of Surrogate pairs is done:
* For any UTF-8 string containing a character outside of the BMP, the
* first call to this function will fill *chPtr with the high surrogate
* and generate a return value of 1. Calling Tcl_UtfToUniChar again
* will produce the low surrogate and a return value of 3. Because *chPtr
* is used to remember whether the high surrogate is already produced, it
* is recommended to initialize the variable it points to as 0 before
* the first call to Tcl_UtfToUniChar is done.
*
* Results:
* *chPtr is filled with the Tcl_UniChar, and the return value is the
* number of bytes from the UTF-8 string that were consumed.
@@ -715,11 +684,11 @@ Tcl_UtfToUniCharDString(
endPtr = src + length;
optPtr = endPtr - 4;
while (p <= optPtr) {
p += TclUtfToUCS4(p, &ch);
p += Tcl_UtfToUniChar(p, &ch);
*w++ = ch;
}
while ((p < endPtr) && Tcl_UtfCharComplete(p, endPtr-p)) {
p += TclUtfToUCS4(p, &ch);
p += Tcl_UtfToUniChar(p, &ch);
*w++ = ch;
}
while (p < endPtr) {
@@ -965,7 +934,7 @@ Tcl_UtfFindFirst(
int ch) /* The Unicode character to search for. */
{
while (1) {
int find, len = TclUtfToUCS4(src, &find);
int find, len = Tcl_UtfToUniChar(src, &find);
if (find == ch) {
return src;
@@ -1004,7 +973,7 @@ Tcl_UtfFindLast(
const char *last = NULL;
while (1) {
int find, len = TclUtfToUCS4(src, &find);
int find, len = Tcl_UtfToUniChar(src, &find);
if (find == ch) {
last = src;
@@ -1227,13 +1196,7 @@ Tcl_UniCharAtIndex(
i = TclUtfToUniChar(src, &ch);
src += i;
}
#if TCL_UTF_MAX < 4
if ((ch >= 0xD800) && (i < 3)) {
/* Index points at character following high Surrogate */
return -1;
}
#endif
TclUtfToUCS4(src, &i);
Tcl_UtfToUniChar(src, &i);
return i;
}
@@ -1242,10 +1205,8 @@ Tcl_UniCharAtIndex(
*
* Tcl_UtfAtIndex --
*
* Returns a pointer to the specified character (not byte) position in
* the UTF-8 string. If TCL_UTF_MAX < 4, characters > U+FFFF count as
* 2 positions, but then the pointer should never be placed between
* the two positions.
* Returns a pointer to the specified character (not byte) position in the
* UTF-8 string.
*
* Results:
* As above.
@@ -1377,7 +1338,7 @@ Tcl_UtfToUpper(
src = dst = str;
while (*src) {
len = TclUtfToUCS4(src, &ch);
len = Tcl_UtfToUniChar(src, &ch);
upChar = Tcl_UniCharToUpper(ch);
/*
@@ -1430,7 +1391,7 @@ Tcl_UtfToLower(
src = dst = str;
while (*src) {
len = TclUtfToUCS4(src, &ch);
len = Tcl_UtfToUniChar(src, &ch);
lowChar = Tcl_UniCharToLower(ch);
/*
@@ -1486,7 +1447,7 @@ Tcl_UtfToTitle(
src = dst = str;
if (*src) {
len = TclUtfToUCS4(src, &ch);
len = Tcl_UtfToUniChar(src, &ch);
titleChar = Tcl_UniCharToTitle(ch);
if (len < TclUtfCount(titleChar)) {
@@ -1498,7 +1459,7 @@ Tcl_UtfToTitle(
src += len;
}
while (*src) {
len = TclUtfToUCS4(src, &ch);
len = Tcl_UtfToUniChar(src, &ch);
lowChar = ch;
/* Special exception for Georgian Asomtavruli chars, no titlecase. */
if ((unsigned)(lowChar - 0x1C90) >= 0x30) {
@@ -1605,16 +1566,6 @@ Tcl_UtfNcmp(
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
#if TCL_UTF_MAX < 4
/* Surrogates always report higher than non-surrogates */
if (((ch1 & 0xFC00) == 0xD800)) {
if ((ch2 & 0xFC00) != 0xD800) {
return ch1;
}
} else if ((ch2 & 0xFC00) == 0xD800) {
return -ch2;
}
#endif
return (ch1 - ch2);
}
}
@@ -1656,16 +1607,6 @@ Tcl_UtfNcasecmp(
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
#if TCL_UTF_MAX < 4
/* Surrogates always report higher than non-surrogates */
if (((ch1 & 0xFC00) == 0xD800)) {
if ((ch2 & 0xFC00) != 0xD800) {
return ch1;
}
} else if ((ch2 & 0xFC00) == 0xD800) {
return -ch2;
}
#endif
ch1 = Tcl_UniCharToLower(ch1);
ch2 = Tcl_UniCharToLower(ch2);
if (ch1 != ch2) {
@@ -1705,16 +1646,6 @@ TclUtfCmp(
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
#if TCL_UTF_MAX < 4
/* Surrogates always report higher than non-surrogates */
if (((ch1 & 0xFC00) == 0xD800)) {
if ((ch2 & 0xFC00) != 0xD800) {
return ch1;
}
} else if ((ch2 & 0xFC00) == 0xD800) {
return -ch2;
}
#endif
return ch1 - ch2;
}
}
@@ -1751,16 +1682,6 @@ TclUtfCasecmp(
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
#if TCL_UTF_MAX < 4
/* Surrogates always report higher than non-surrogates */
if (((ch1 & 0xFC00) == 0xD800)) {
if ((ch2 & 0xFC00) != 0xD800) {
return ch1;
}
} else if ((ch2 & 0xFC00) == 0xD800) {
return -ch2;
}
#endif
ch1 = Tcl_UniCharToLower(ch1);
ch2 = Tcl_UniCharToLower(ch2);
if (ch1 != ch2) {
@@ -1959,7 +1880,7 @@ TclUniCharNcmp(
const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */
size_t numChars) /* Number of unichars to compare. */
{
#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
#if defined(WORDS_BIGENDIAN)
/*
* We are definitely on a big-endian machine; memcmp() is safe
*/
@@ -1973,14 +1894,6 @@ TclUniCharNcmp(
for ( ; numChars != 0; ucs++, uct++, numChars--) {
if (*ucs != *uct) {
#if TCL_UTF_MAX < 4
/* special case for handling upper surrogates */
if (((*ucs & 0xFC00) == 0xD800) && ((*uct & 0xFC00) != 0xD800)) {
return 1;
} else if (((*uct & 0xFC00) == 0xD800)) {
return -1;
}
#endif
return (*ucs - *uct);
}
}
@@ -2018,14 +1931,6 @@ TclUniCharNcasecmp(
Tcl_UniChar lct = Tcl_UniCharToLower(*uct);
if (lcs != lct) {
#if TCL_UTF_MAX < 4
/* special case for handling upper surrogates */
if (((lcs & 0xFC00) == 0xD800) && ((lct & 0xFC00) != 0xD800)) {
return 1;
} else if (((lct & 0xFC00) == 0xD800)) {
return -1;
}
#endif
return (lcs - lct);
}
}
@@ -2752,71 +2657,6 @@ TclUniCharMatch(
}
}
/*
*---------------------------------------------------------------------------
*
* TclUtfToUCS4 --
*
* Extracts the 4-byte codepoint from the leading bytes of the
* Modified UTF-8 string "src". This is a utility routine to
* contain the surrogate gymnastics in one place.
*
* The caller must ensure that the source buffer is long enough that this
* routine does not run off the end and dereference non-existent memory
* looking for trail bytes. If the source buffer is known to be '\0'
* terminated, this cannot happen. Otherwise, the caller should call
* Tcl_UtfCharComplete() before calling this routine to ensure that
* enough bytes remain in the string.
*
* Results:
* Fills *usc4Ptr with the UCS4 code point and returns the number of bytes
* consumed from the source string.
*
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
#if TCL_UTF_MAX < 4
int
TclUtfToUCS4(
const char *src, /* The UTF-8 string. */
int *ucs4Ptr) /* Filled with the UCS4 codepoint represented
* by the UTF-8 string. */
{
/* Make use of the #undef Tcl_UtfToUniChar above, which already handles UCS4. */
return Tcl_UtfToUniChar(src, ucs4Ptr);
}
int
TclUniCharToUCS4(
const Tcl_UniChar *src, /* The Tcl_UniChar string. */
int *ucs4Ptr) /* Filled with the UCS4 codepoint represented
* by the Tcl_UniChar string. */
{
if (((src[0] & 0xFC00) == 0xD800) && ((src[1] & 0xFC00) == 0xDC00)) {
*ucs4Ptr = (((src[0] & 0x3FF) << 10) | (src[1] & 0x3FF)) + 0x10000;
return 2;
}
*ucs4Ptr = src[0];
return 1;
}
const Tcl_UniChar *TclUCS4Prev(const Tcl_UniChar *src, const Tcl_UniChar *ptr) {
if (src <= ptr + 1) {
return ptr;
}
if (((src[-1] & 0xFC00) == 0xDC00) && ((src[-2] & 0xFC00) == 0xD800)) {
return src - 2;
}
return src - 1;
}
#endif
/*
* Local Variables:
* mode: c
+75 -61
View File
@@ -129,16 +129,10 @@ static const Tcl_ObjType endOffsetType = {
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
TCL_OBJTYPE_V1(TclLengthOne)
0
};
Tcl_Size
TclLengthOne(
TCL_UNUSED(Tcl_Obj *))
{
return 1;
}
/*
* * STRING REPRESENTATION OF LISTS * * *
*
@@ -1572,8 +1566,7 @@ Tcl_Merge(
{
#define LOCAL_SIZE 64
char localFlags[LOCAL_SIZE], *flagPtr = NULL;
Tcl_Size i;
size_t bytesNeeded = 0;
Tcl_Size i, bytesNeeded = 0;
char *result, *dst;
/*
@@ -1582,9 +1575,6 @@ Tcl_Merge(
*/
if (argc <= 0) {
if (argc < 0) {
Tcl_Panic("Tcl_Merge called with negative argc (%" TCL_SIZE_MODIFIER "d)", argc);
}
result = (char *)Tcl_Alloc(1);
result[0] = '\0';
return result;
@@ -1672,7 +1662,7 @@ TclTrimRight(
pp = Tcl_UtfPrev(p, bytes);
do {
pp += pInc;
pInc = TclUtfToUCS4(pp, &ch1);
pInc = Tcl_UtfToUniChar(pp, &ch1);
} while (pp + pInc < p);
/*
@@ -1680,7 +1670,7 @@ TclTrimRight(
*/
do {
pInc = TclUtfToUCS4(q, &ch2);
pInc = Tcl_UtfToUniChar(q, &ch2);
if (ch1 == ch2) {
break;
@@ -1745,7 +1735,7 @@ TclTrimLeft(
*/
do {
Tcl_Size pInc = TclUtfToUCS4(p, &ch1);
Tcl_Size pInc = Tcl_UtfToUniChar(p, &ch1);
const char *q = trim;
Tcl_Size bytesLeft = numTrim;
@@ -1754,7 +1744,7 @@ TclTrimLeft(
*/
do {
Tcl_Size qInc = TclUtfToUCS4(q, &ch2);
Tcl_Size qInc = Tcl_UtfToUniChar(q, &ch2);
if (ch1 == ch2) {
break;
@@ -1821,7 +1811,7 @@ TclTrim(
if (numBytes > 0) {
int ch;
const char *first = bytes + trimLeft;
bytes += TclUtfToUCS4(first, &ch);
bytes += Tcl_UtfToUniChar(first, &ch);
numBytes -= (bytes - first);
if (numBytes > 0) {
@@ -1977,8 +1967,7 @@ Tcl_ConcatObj(
Tcl_Size length;
objPtr = objv[i];
if (TclListObjIsCanonical(objPtr) ||
TclObjTypeHasProc(objPtr,indexProc)) {
if (TclListObjIsCanonical(objPtr)) {
continue;
}
(void)Tcl_GetStringFromObj(objPtr, &length);
@@ -1990,8 +1979,7 @@ Tcl_ConcatObj(
resPtr = NULL;
for (i = 0; i < objc; i++) {
objPtr = objv[i];
if (!TclListObjIsCanonical(objPtr) &&
!TclObjTypeHasProc(objPtr,indexProc)) {
if (!TclListObjIsCanonical(objPtr)) {
continue;
}
if (resPtr) {
@@ -2005,12 +1993,14 @@ Tcl_ConcatObj(
!= Tcl_ListObjAppendList(NULL, resPtr, objPtr)) {
/* Abandon ship! */
Tcl_DecrRefCount(resPtr);
Tcl_BounceRefCount(elemPtr); // could be an abstract list element
goto slow;
}
Tcl_BounceRefCount(elemPtr); // could be an an abstract list element
} else {
resPtr = TclListObjCopy(NULL, objPtr);
resPtr = TclDuplicatePureObj(
NULL, objPtr, tclListType);
if (!resPtr) {
return NULL;
}
}
}
if (!resPtr) {
@@ -2151,7 +2141,7 @@ Tcl_StringCaseMatch(
ch2 = (int)
(nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
} else {
TclUtfToUCS4(pattern, &ch2);
Tcl_UtfToUniChar(pattern, &ch2);
if (nocase) {
ch2 = Tcl_UniCharToLower(ch2);
}
@@ -2167,7 +2157,7 @@ Tcl_StringCaseMatch(
if ((p != '[') && (p != '?') && (p != '\\')) {
if (nocase) {
while (*str) {
charLen = TclUtfToUCS4(str, &ch1);
charLen = Tcl_UtfToUniChar(str, &ch1);
if (ch2==ch1 || ch2==Tcl_UniCharToLower(ch1)) {
break;
}
@@ -2181,7 +2171,7 @@ Tcl_StringCaseMatch(
*/
while (*str) {
charLen = TclUtfToUCS4(str, &ch1);
charLen = Tcl_UtfToUniChar(str, &ch1);
if (ch2 == ch1) {
break;
}
@@ -2195,7 +2185,7 @@ Tcl_StringCaseMatch(
if (*str == '\0') {
return 0;
}
str += TclUtfToUCS4(str, &ch1);
str += Tcl_UtfToUniChar(str, &ch1);
}
}
@@ -2206,7 +2196,7 @@ Tcl_StringCaseMatch(
if (p == '?') {
pattern++;
str += TclUtfToUCS4(str, &ch1);
str += Tcl_UtfToUniChar(str, &ch1);
continue;
}
@@ -2225,7 +2215,7 @@ Tcl_StringCaseMatch(
(nocase ? tolower(UCHAR(*str)) : UCHAR(*str));
str++;
} else {
str += TclUtfToUCS4(str, &ch1);
str += Tcl_UtfToUniChar(str, &ch1);
if (nocase) {
ch1 = Tcl_UniCharToLower(ch1);
}
@@ -2239,7 +2229,7 @@ Tcl_StringCaseMatch(
? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
pattern++;
} else {
pattern += TclUtfToUCS4(pattern, &startChar);
pattern += Tcl_UtfToUniChar(pattern, &startChar);
if (nocase) {
startChar = Tcl_UniCharToLower(startChar);
}
@@ -2254,7 +2244,7 @@ Tcl_StringCaseMatch(
? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
pattern++;
} else {
pattern += TclUtfToUCS4(pattern, &endChar);
pattern += Tcl_UtfToUniChar(pattern, &endChar);
if (nocase) {
endChar = Tcl_UniCharToLower(endChar);
}
@@ -2302,8 +2292,8 @@ Tcl_StringCaseMatch(
* each string match.
*/
str += TclUtfToUCS4(str, &ch1);
pattern += TclUtfToUCS4(pattern, &ch2);
str += Tcl_UtfToUniChar(str, &ch1);
pattern += Tcl_UtfToUniChar(pattern, &ch2);
if (nocase) {
if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) {
return 0;
@@ -2751,7 +2741,8 @@ Tcl_DStringAppendElement(
newSize += 1; /* For terminating nul */
if (newSize > dsPtr->spaceAvl) {
if (dsPtr->string == dsPtr->staticSpace) {
char *newString = (char *) TclAllocEx(newSize, &dsPtr->spaceAvl);
char *newString;
newString = (char *) TclAllocEx(newSize, &dsPtr->spaceAvl);
memcpy(newString, dsPtr->string, dsPtr->length);
dsPtr->string = newString;
} else {
@@ -2764,7 +2755,7 @@ Tcl_DStringAppendElement(
offset = element - dsPtr->string;
}
dsPtr->string =
(char *)TclReallocEx(dsPtr->string, newSize, &dsPtr->spaceAvl);
(char *)TclReallocEx(dsPtr->string, newSize, &dsPtr->spaceAvl);
if (offset >= 0) {
element = dsPtr->string + offset;
}
@@ -2937,7 +2928,7 @@ Tcl_DStringGetResult(
* of interp. */
{
Tcl_Obj *obj = Tcl_GetObjResult(interp);
const char *bytes = TclGetString(obj);
char *bytes = TclGetString(obj);
Tcl_DStringFree(dsPtr);
Tcl_DStringAppend(dsPtr, bytes, obj->length);
@@ -3378,9 +3369,6 @@ GetWideForIndex(
if (numType == TCL_NUMBER_INT) {
/* objPtr holds an integer in the signed wide range */
*widePtr = *(Tcl_WideInt *)cd;
if ((*widePtr < 0)) {
*widePtr = (endValue == -1) ? WIDE_MIN : -1;
}
return TCL_OK;
}
if (numType == TCL_NUMBER_BIG) {
@@ -3449,15 +3437,11 @@ Tcl_GetIntForIndex(
if (indexPtr != NULL) {
/* Note: check against TCL_SIZE_MAX needed for 32-bit builds */
if (wide >= 0 && wide <= TCL_SIZE_MAX) {
*indexPtr = (Tcl_Size)wide; /* A valid index */
*indexPtr = (Tcl_Size)wide;
} else if (wide > TCL_SIZE_MAX) {
*indexPtr = TCL_SIZE_MAX; /* Beyond max possible index */
} else if (wide < -1-TCL_SIZE_MAX) {
*indexPtr = -1-TCL_SIZE_MAX; /* Below most negative index */
} else if ((wide < 0) && (endValue >= 0)) {
*indexPtr = TCL_INDEX_NONE; /* No clue why this special case */
} else {
*indexPtr = (Tcl_Size) wide;
*indexPtr = TCL_SIZE_MAX;
} else {
*indexPtr = TCL_INDEX_NONE;
}
}
return TCL_OK;
@@ -3517,13 +3501,10 @@ GetEndOffsetFromObj(
/* Value doesn't start with "e" */
/* If we reach here, the string rep of objPtr exists. */
/*
* The valid index syntax does not include any value that is
* a list of more than one element. This is necessary so that
* lists of index values can be reliably distinguished from any
* single index value.
* So that lists of index values can be reliably distinguished from
* any single index value, the valid index syntax does not include
* any value that is a list of more than one element.
*/
/*
@@ -3641,6 +3622,7 @@ GetEndOffsetFromObj(
/* Doesn't start with "end" */
goto parseError;
}
if (length > 4) {
int t;
@@ -3698,15 +3680,14 @@ GetEndOffsetFromObj(
if (offset == WIDE_MAX) {
/*
* Encodes end+1. This is distinguished from end+n as noted
* in function header.
* Encodes end+1. This is distinguished from end+n as noted above
* NOTE: this may wrap around if the caller passes (as lset does)
* listLen-1 as endValue and and listLen is 0. The -1 will be
* interpreted as FF...FF and adding 1 will result in 0 which
* is what we want. Callers like lset which pass in listLen-1 == -1
* as endValue will have to adjust accordingly.
* is what we want. 2's complements shenanigans but it is what
* it is ...
*/
*widePtr = (endValue == -1) ? WIDE_MAX : endValue + 1;
*widePtr = endValue + 1;
} else if (offset == WIDE_MIN) {
/* -1 - position before first */
*widePtr = -1;
@@ -3749,7 +3730,7 @@ GetEndOffsetFromObj(
*
* Parse objPtr to determine if it is an index value. Two cases
* are possible. The value objPtr might be parsed as an absolute
* index value in the Tcl_Size range. Note that this includes
* index value in the Tcl_Size range. This includes
* index values that are integers as presented and it includes index
* arithmetic expressions.
*
@@ -3965,6 +3946,39 @@ TclIndexDecode(
return TCL_INDEX_NONE;
}
int TclIndexIsFromEnd(Tcl_Size index) {
return index <= 0;
}
/*
*----------------------------------------------------------------------
*
* TclIndexLast --
*
* Determine the last index for an array of length "length", where -1 means N is
* not bounded.
*
*----------------------------------------------------------------------
*/
Tcl_Size
TclIndexLast (Tcl_Size length) {
return Tcl_LengthIsFinite(length) ? length - 1 : TCL_INDEX_NONE;
}
/*
*----------------------------------------------------------------------
*
* Tcl_LengthIsFinite --
*
* True if length is Finite.
*
*----------------------------------------------------------------------
*/
int
Tcl_LengthIsFinite(Tcl_Size length) {
return length != TCL_LENGTH_NONE;
}
/*
*------------------------------------------------------------------------
*
+11 -12
View File
@@ -245,8 +245,7 @@ static Tcl_DupInternalRepProc DupParsedVarName;
static const Tcl_ObjType localVarNameType = {
"localVarName",
FreeLocalVarName, DupLocalVarName, NULL, NULL,
TCL_OBJTYPE_V0
FreeLocalVarName, DupLocalVarName, NULL, NULL, TCL_OBJTYPE_V0
};
#define LocalSetInternalRep(objPtr, index, namePtr) \
@@ -269,8 +268,7 @@ static const Tcl_ObjType localVarNameType = {
static const Tcl_ObjType parsedVarNameType = {
"parsedVarName",
FreeParsedVarName, DupParsedVarName, NULL, NULL,
TCL_OBJTYPE_V0
FreeParsedVarName, DupParsedVarName, NULL, NULL, TCL_OBJTYPE_V0
};
#define ParsedSetInternalRep(objPtr, arrayPtr, elem) \
@@ -378,7 +376,7 @@ CleanupVar(
{
if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr)
&& !TclIsVarTraced(varPtr)
&& (VarHashRefCount(varPtr) == (Tcl_Size)
&& (VarHashRefCount(varPtr) == (unsigned)
!TclIsVarDeadHash(varPtr))) {
if (VarHashRefCount(varPtr) == 0) {
Tcl_Free(varPtr);
@@ -388,7 +386,7 @@ CleanupVar(
}
if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) &&
TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
(VarHashRefCount(arrayPtr) == (Tcl_Size)
(VarHashRefCount(arrayPtr) == (unsigned)
!TclIsVarDeadHash(arrayPtr))) {
if (VarHashRefCount(arrayPtr) == 0) {
Tcl_Free(arrayPtr);
@@ -843,8 +841,8 @@ TclLookupSimpleVar(
* the variable. */
Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
ResolverScheme *resPtr;
int isNew, result;
Tcl_Size i, varLen;
int isNew, i, result;
Tcl_Size varLen;
const char *varName = Tcl_GetStringFromObj(varNamePtr, &varLen);
varPtr = NULL;
@@ -969,7 +967,7 @@ TclLookupSimpleVar(
}
}
} else { /* Local var: look in frame varFramePtr. */
Tcl_Size localCt = varFramePtr->numCompiledLocals;
int localCt = varFramePtr->numCompiledLocals;
if (localCt > 0) {
Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
@@ -3099,7 +3097,7 @@ ArrayForNRCmd(
* loop) don't vanish.
*/
varListObj = TclListObjCopy(NULL, objv[1]);
varListObj = TclDuplicatePureObj(interp, objv[1], tclListType);
if (!varListObj) {
return TCL_ERROR;
}
@@ -4075,7 +4073,8 @@ ArraySetCmd(
* the loop and return an error.
*/
copyListObj = TclListObjCopy(NULL, arrayElemObj);
copyListObj =
TclDuplicatePureObj(interp, arrayElemObj, tclListType);
if (!copyListObj) {
return TCL_ERROR;
}
@@ -5422,7 +5421,7 @@ TclDeleteCompiledLocalVars(
* assigned local variables to delete. */
{
Var *varPtr;
Tcl_Size numLocals, i;
size_t numLocals, i;
Tcl_Obj **namePtrPtr;
numLocals = framePtr->numCompiledLocals;
+9 -4
View File
@@ -273,11 +273,15 @@ static struct {
* they are believed to not be UTF-8; only
* written to from Tcl code in a trusted
* interpreter, so not protected by mutex. */
Tcl_Encoding utf8; /* The UTF-8 encoding that we prefer to use
* for the strings (especially filenames)
* embedded in a ZIP. Other encodings are used
* dynamically. */
int idCount; /* Counter for channel names */
Tcl_HashTable fileHash; /* File name to ZipEntry mapping */
Tcl_HashTable zipHash; /* Mount to ZipFile mapping */
} ZipFS = {
0, 0, 0, DEFAULT_WRITE_MAX_SIZE, NULL, 0,
0, 0, 0, DEFAULT_WRITE_MAX_SIZE, NULL, NULL, 0,
{0,{0,0,0,0},0,0,0,0,0,0,0,0,0},
{0,{0,0,0,0},0,0,0,0,0,0,0,0,0}
};
@@ -739,7 +743,7 @@ DecodeZipEntryText(
while (1) {
int srcRead, dstWrote;
int result = Tcl_ExternalToUtf(NULL, tclUtf8Encoding, src, srcLen, flags,
int result = Tcl_ExternalToUtf(NULL, ZipFS.utf8, src, srcLen, flags,
&state, dst, dstLen, &srcRead, &dstWrote, NULL);
int soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
@@ -1856,6 +1860,7 @@ ZipfsSetup(void)
ZipFS.fallbackEntryEncoding = (char *)
Tcl_Alloc(strlen(ZIPFS_FALLBACK_ENCODING) + 1);
strcpy(ZipFS.fallbackEntryEncoding, ZIPFS_FALLBACK_ENCODING);
ZipFS.utf8 = Tcl_GetEncoding(NULL, "utf-8");
ZipFS.initialized = 1;
Tcl_CreateExitHandler(ZipfsExitHandler, NULL);
}
@@ -2536,7 +2541,7 @@ ZipAddFile(
* crazy enough to embed NULs in filenames, they deserve what they get!
*/
zpathExt = Tcl_UtfToExternalDString(tclUtf8Encoding, zpathTcl, -1, &zpathDs);
zpathExt = Tcl_UtfToExternalDString(ZipFS.utf8, zpathTcl, -1, &zpathDs);
zpathlen = strlen(zpathExt);
if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -3205,7 +3210,7 @@ ZipFSMkZipOrImg(
}
z = (ZipEntry *) Tcl_GetHashValue(hPtr);
name = Tcl_UtfToExternalDString(tclUtf8Encoding, z->name, TCL_INDEX_NONE, &ds);
name = Tcl_UtfToExternalDString(ZipFS.utf8, z->name, TCL_INDEX_NONE, &ds);
len = Tcl_DStringLength(&ds);
SerializeCentralDirectoryEntry(start, end, (unsigned char *) buf,
z, len);
+3 -24
View File
@@ -1746,9 +1746,6 @@ proc http::OpenSocket {token DoLater} {
}
fconfigure $sock -translation {auto crlf} \
-buffersize $state(-blocksize)
if {[package vsatisfies [package provide Tcl] 9.0-]} {
fconfigure $sock -profile tcl8
}
##Log socket opened, DONE fconfigure - token $token
}
@@ -2167,9 +2164,6 @@ proc http::Connected {token proto phost srvurl} {
lassign [fconfigure $sock -translation] trRead trWrite
fconfigure $sock -translation [list $trRead crlf] \
-buffersize $state(-blocksize)
if {[package vsatisfies [package provide Tcl] 9.0-]} {
fconfigure $sock -profile tcl8
}
# The following is disallowed in safe interpreters, but the socket is
# already in non-blocking mode in that case.
@@ -2560,9 +2554,6 @@ proc http::ReceiveResponse {token} {
lassign [fconfigure $sock -translation] trRead trWrite
fconfigure $sock -translation [list auto $trWrite] \
-buffersize $state(-blocksize)
if {[package vsatisfies [package provide Tcl] 9.0-]} {
fconfigure $sock -profile tcl8
}
Log ^D$tk begin receiving response - token $token
coroutine ${token}--EventCoroutine http::Event $sock $token
@@ -4554,11 +4545,7 @@ proc http::Eot {token {reason {}}} {
set enc [CharsetToEncoding $state(charset)]
if {$enc ne "binary"} {
if {[package vsatisfies [package provide Tcl] 9.0-]} {
set state(body) [encoding convertfrom -profile tcl8 $enc $state(body)]
} else {
set state(body) [encoding convertfrom $enc $state(body)]
}
set state(body) [encoding convertfrom $enc $state(body)]
}
# Translate text line endings.
@@ -4641,11 +4628,7 @@ proc http::GuessType {token} {
if {$enc eq "binary"} {
return 0
}
if {[package vsatisfies [package provide Tcl] 9.0-]} {
set state(body) [encoding convertfrom -profile tcl8 $enc $state(body)]
} else {
set state(body) [encoding convertfrom $enc $state(body)]
}
set state(body) [encoding convertfrom $enc $state(body)]
set state(body) [string map {\r\n \n \r \n} $state(body)]
set state(type) application/xml
set state(binary) 0
@@ -4726,11 +4709,7 @@ proc http::quoteString {string} {
# a pre-computed map and [string map] to do the conversion (much faster
# than [regsub]/[subst]). [Bug 1020491]
if {[package vsatisfies [package provide Tcl] 9.0-]} {
set string [encoding convertto -profile tcl8 $http(-urlencoding) $string]
} else {
set string [encoding convertto $http(-urlencoding) $string]
}
set string [encoding convertto $http(-urlencoding) $string]
return [string map $formMap $string]
}
+14 -19
View File
@@ -29,7 +29,6 @@ namespace eval tcltest {
# yourself. You don't need tcltest to wrap it for you.
variable version [package provide Tcl]
variable patchLevel [info patchlevel]
variable fullutf [package vsatisfies $version 8.7-]
##### Export the public tcltest procs; several categories
#
@@ -401,7 +400,7 @@ namespace eval tcltest {
default {
set outputChannel [open $filename a]
if {[package vsatisfies [package provide Tcl] 8.7-]} {
fconfigure $outputChannel -profile tcl8 -encoding utf-8
fconfigure $outputChannel -encoding utf-8
}
set ChannelsWeOpened($outputChannel) 1
@@ -448,7 +447,7 @@ namespace eval tcltest {
default {
set errorChannel [open $filename a]
if {[package vsatisfies [package provide Tcl] 8.7-]} {
fconfigure $errorChannel -profile tcl8 -encoding utf-8
fconfigure $errorChannel -encoding utf-8
}
set ChannelsWeOpened($errorChannel) 1
@@ -793,7 +792,7 @@ namespace eval tcltest {
if {$Option(-loadfile) eq {}} {return}
set tmp [open $Option(-loadfile) r]
if {[package vsatisfies [package provide Tcl] 8.7-]} {
fconfigure $tmp -profile tcl8 -encoding utf-8
fconfigure $tmp -encoding utf-8
}
loadScript [read $tmp]
close $tmp
@@ -1135,6 +1134,7 @@ proc tcltest::SafeFetch {n1 n2 op} {
}
}
# tcltest::Asciify --
#
# Transforms the passed string to contain only printable ascii characters.
@@ -1151,17 +1151,16 @@ proc tcltest::SafeFetch {n1 n2 op} {
# None.
proc tcltest::Asciify {s} {
variable fullutf
set print ""
foreach c [split $s ""] {
if {[string is print $c] && (($c <= "\x7E") || ($c == "\n"))} {
append print $c
} elseif {$c < "\u0100"} {
} elseif {$c <= "\xFF"} {
append print \\x[format %02X [scan $c %c]]
} elseif {$fullutf && ($c >= "\U10000")} {
append print \\U[format %08X [scan $c %c]]
} else {
} elseif {$c <= "\xFFFF"} {
append print \\u[format %04X [scan $c %c]]
} else {
append print \\U[format %08X [scan $c %c]]
}
}
return $print
@@ -1373,7 +1372,7 @@ proc tcltest::DefineConstraintInitializers {} {
set code 0
if {![catch {set f [open "|[list [interpreter]]" w]}]} {
if {[package vsatisfies [package provide Tcl] 8.7-]} {
fconfigure $f -profile tcl8 -encoding utf-8
fconfigure $f -encoding utf-8
}
if {![catch {puts $f exit}]} {
if {![catch {close $f}]} {
@@ -2223,7 +2222,7 @@ proc tcltest::test {name description args} {
if {[file readable $testFile]} {
set testFd [open $testFile r]
if {[package vsatisfies [package provide Tcl] 8.7-]} {
fconfigure $testFd -profile tcl8 -encoding utf-8
fconfigure $testFd -encoding utf-8
}
set testLine [expr {[lsearch -regexp \
[split [read $testFd] "\n"] \
@@ -2254,11 +2253,7 @@ proc tcltest::test {name description args} {
if {$scriptCompare} {
puts [outputChannel] "---- Error testing result: $scriptMatch"
} else {
if {[catch {
puts [outputChannel] "---- Result was:\n[Asciify $actualAnswer]"
} errMsg]} {
puts [outputChannel] "\n---- Result was:\n<error printing result: $errMsg>"
}
puts [outputChannel] "---- Result was:\n[Asciify $actualAnswer]"
puts [outputChannel] "---- Result should have been\
($match matching):\n[Asciify $result]"
}
@@ -2938,7 +2933,7 @@ proc tcltest::runAllTests { {shell ""} } {
incr numTestFiles
set pipeFd [open $cmd "r"]
if {[package vsatisfies [package provide Tcl] 8.7-]} {
fconfigure $pipeFd -profile tcl8 -encoding utf-8
fconfigure $pipeFd -encoding utf-8
}
while {[gets $pipeFd line] >= 0} {
if {[regexp [join {
@@ -3138,7 +3133,7 @@ proc tcltest::makeFile {contents name {directory ""}} {
set fd [open $fullName w]
fconfigure $fd -translation lf
if {[package vsatisfies [package provide Tcl] 8.7-]} {
fconfigure $fd -profile tcl8 -encoding utf-8
fconfigure $fd -encoding utf-8
}
if {[string index $contents end] eq "\n"} {
puts -nonewline $fd $contents
@@ -3289,7 +3284,7 @@ proc tcltest::viewFile {name {directory ""}} {
set fullName [file join $directory $name]
set f [open $fullName]
if {[package vsatisfies [package provide Tcl] 8.7-]} {
fconfigure $f -profile tcl8 -encoding utf-8
fconfigure $f -encoding utf-8
}
set data [read -nonewline $f]
close $f
+4 -1
View File
@@ -4,7 +4,10 @@
#ifndef BN_H_
#define BN_H_
#include <stdint.h>
#if !defined(MP_NO_STDINT) && !defined(_STDINT_H) && !defined(_STDINT_H_) \
&& !defined(__CLANG_STDINT_H) && !defined(_STDINT)
# include <stdint.h>
#endif
#include <stddef.h>
#include <limits.h>
+7 -1
View File
@@ -4,7 +4,13 @@
#ifndef TOMMATH_PRIV_H_
#define TOMMATH_PRIV_H_
#include <stdint.h>
#ifdef MP_NO_STDINT
#ifdef HAVE_STDINT_H
# include <stdint.h>
#else
# include "../compat/stdint.h"
#endif
#endif
#include "tclTomMath.h"
#include "tommath_class.h"

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