Compare commits

..
279 Commits
Author SHA1 Message Date
pooryorick 95d7850d9e merge trunk 2018-05-05 11:39:20 +00:00
José Ignacio Marín b97b608974 Update TZ info to tzdata2018e. 2018-05-04 19:07:22 +00:00
oehhar 7a91dd767e Syntax error in msgcat documentation fixed. Ticket [af69c6966d] 2018-05-03 16:24:05 +00:00
jan.nijtmans 48a249a15e merge 8.7 2018-05-01 18:43:55 +00:00
jan.nijtmans 678622482a Merge 8.7 (= upgrade to Unicode 11 beta) 2018-04-29 21:15:10 +00:00
jan.nijtmans c23982e3c2 Now really fix [9f3c253df5eec5669673d05fe3a51e4afcf99418|9f3c253df5] : Tcl build broken on Win. (tested on Visual Studio 2017) 2018-04-29 20:02:48 +00:00
jan.nijtmans a85834a18e Merge 8.7 2018-04-26 08:33:30 +00:00
jan.nijtmans 36aca800d0 Fix MSVC build [9f3c253df5] 2018-04-25 21:57:27 +00:00
dgp a14cef18c0 merge 8.7 2018-04-25 11:49:20 +00:00
andy b104b5ce6e Merge fork 2018-04-24 23:00:56 +00:00
dgp a794e440ae Merge 8.7 2018-04-24 13:51:12 +00:00
jan.nijtmans 1905291fed merge 8.7 2018-04-23 15:07:29 +00:00
dgp 09a6e8adca merge 8.7 2018-04-23 13:53:04 +00:00
dgp d513bef710 merge 8.7 2018-04-22 13:28:42 +00:00
dgp 751fe9de93 merge 8.7 2018-04-20 16:55:30 +00:00
jan.nijtmans 0569fc46c8 merge 8.7 2018-04-20 10:18:29 +00:00
dgp 697d8c5398 merge 8.7 2018-04-19 02:51:50 +00:00
dgp bdc679352c merge 8.7 2018-04-17 14:39:42 +00:00
dgp e42804a0c2 merge 8.7 2018-04-16 13:41:14 +00:00
jan.nijtmans 368acc3d50 Fix [9f3c253df5eec5669673d05fe3a51e4afcf99418|9f3c253df5]: Tcl build broken on Win. Re-introduce TCL_NORETURN1, apparently still needed on MSVC. 2018-04-15 23:06:00 +00:00
andy 4f69e81ae0 Fix documentation typo 2018-04-12 01:58:52 +00:00
dgp 50698aacbf merge 8.7 2018-04-05 17:59:28 +00:00
dgp b86f569b11 merge 8.7 2018-04-05 15:38:14 +00:00
dgp 754c5a5fe1 merge 8.7 2018-04-05 13:36:34 +00:00
dgp 4cc60d34fb merge 8.7 2018-03-30 20:08:10 +00:00
jan.nijtmans e1e6b685fd merge 8.7 2018-03-25 19:21:11 +00:00
jan.nijtmans cc19135f2e merge 8.7 2018-03-25 17:43:52 +00:00
José Ignacio Marín 2cf7904bd2 Update TZ info to tzdata2018d. 2018-03-24 10:22:06 +00:00
dgp 84fe9556f1 merge 8.7 2018-03-20 19:58:27 +00:00
jan.nijtmans c20405e576 Merge-mark (here makefile.vc still had the correct CRLF line-endings) 2018-03-15 21:02:00 +00:00
dgp 795355ee43 merge 8.7 2018-03-15 11:11:33 +00:00
dgp 2977f2ab44 merge 8.7 2018-03-15 00:01:37 +00:00
dgp 8ecdd7277d merege 8.7 2018-03-14 18:09:20 +00:00
dgp 93e9d2457c merge 8.7 2018-03-14 17:21:29 +00:00
dgp 3f7e1dc18f merge 8.7 2018-03-14 16:17:48 +00:00
dgp 6111cf68fe merge 8.7 2018-03-14 05:51:18 +00:00
dgp f8081ac245 merge 8.7 2018-03-13 17:30:00 +00:00
dgp a14ab9eecb merge 8.7 2018-03-12 16:00:11 +00:00
dgp ccb7c3b60b merge 8.7 2018-03-12 14:49:44 +00:00
dgp c5ae3a0a2d merge 8.7 2018-03-11 21:42:22 +00:00
dgp c7e8d507d9 merge 8.7 2018-03-11 12:33:16 +00:00
jan.nijtmans cb242c0d50 Merge 8.7 2018-03-07 21:41:00 +00:00
dgp 24c4a4cc6e Remove all the code supporting legacy opcodes.
Restructure to pave the way for re-ordering the opcode table, if we can
agree that some other order is better.
2018-03-06 13:37:22 +00:00
dgp 683e97521e merge 8.7 2018-03-06 13:21:10 +00:00
dgp e5f3c1495b Compiler warning in a --enable-symbols=compile build 2018-03-06 12:10:45 +00:00
dgp 057d325d35 Remove disabled code and reformat. 2018-03-06 12:02:11 +00:00
dgp 54654ae7e4 Convert macros to enums - constrained by need for matching table. 2018-03-06 05:27:21 +00:00
dgp a6dd04e6da experiment 2018-03-06 04:08:54 +00:00
dgp 14a3439dd8 Remove all code supporting legacy instructions. 2018-03-05 22:16:03 +00:00
dgp 695856b85c unbreak 2018-03-05 20:58:32 +00:00
dgp d07756fc70 WIP removing bytecode instructions that are no longer issued. 2018-03-05 20:30:38 +00:00
dgp 79c79df0e1 merge 8.7 2018-03-05 20:05:45 +00:00
dgp 2e1e641d75 merge 8.7 2018-03-05 17:16:50 +00:00
jan.nijtmans aef69d0b0f Merge 8.7 2018-03-01 22:37:00 +00:00
jan.nijtmans bfb19782c9 Merge 8.7 2018-03-01 21:06:20 +00:00
jan.nijtmans b31a3b3d70 Merge 8.7 2018-02-27 21:12:00 +00:00
dgp fa036d2b99 merge 8.7 2018-02-23 18:10:09 +00:00
jan.nijtmans f5bf130f05 merge core-8-branch 2018-02-22 20:09:33 +00:00
jan.nijtmans 701d9dbe89 Use internalRep.wideValue as internal representation for booleans. This simplifies the handling of "int" resp "boolean", sharing its internal representation. 2018-02-15 19:54:00 +00:00
dgp 64ef84994a merge 8.7 2018-02-15 18:30:34 +00:00
jan.nijtmans 494a47ee6e Merge core-8-branch 2018-02-14 22:42:00 +00:00
jan.nijtmans f9a0feeb4b fix test-cases, account for differences between Tcl 8.7 and 9.0 2018-02-14 20:59:37 +00:00
jan.nijtmans fcfee868a9 merge core-8-branch 2018-02-14 20:43:51 +00:00
dgp e4364f45cc merge 8.7 2018-02-14 14:50:24 +00:00
dgp 967136cc0f merge 8.7 2018-02-09 18:52:04 +00:00
jan.nijtmans 5335ab79e5 remove unused stub entries (now that those are macros)
Moved checkin off trunk onto dev branch jn-unused-stubs
because it causes many test suite segfaults, apparently
releated to Tcl_Channels.

Moved back onto trunk. segfaults came from a prior install
of the Thread package that became imcompatible with this
change in the stubs table.  Will followup on TCLCORE.
2018-02-06 22:43:00 +00:00
jan.nijtmans 6ce7eb980b merge core-8-branch 2018-02-06 20:54:35 +00:00
José Ignacio Marín 6bd80d67e4 Update TZ info to tzdata2018c. 2018-02-02 09:21:35 +00:00
apnadkarni e905a75c0f Fix INCLUDE_INSTALL_DIR def when building against Tcl source. Bump rules.vc to 1.2 2018-02-02 06:18:24 +00:00
jan.nijtmans ee2574ddce merge core-8-branch 2018-01-29 15:04:33 +00:00
jan.nijtmans e543dbc09c merge core-8-branch 2018-01-26 10:26:06 +00:00
jan.nijtmans 32aa419154 merge core-8-branch 2018-01-24 10:01:29 +00:00
jan.nijtmans 010f610a80 Don't register oldBooleanType any more. And rename "booleanString" to "boolean" in tclBooleanType. 2018-01-23 15:02:28 +00:00
dgp 102d58a165 merge mark 2018-01-22 13:43:05 +00:00
jan.nijtmans 3c6933efc0 merge core-8-branch. Declare CONST86 as deprecated in Tcl 9.0 2018-01-20 16:08:21 +00:00
jan.nijtmans a43cab006e No longer use (the undocumented) CONST86 anywhere, just keep the define in tcl.h. 2018-01-19 16:08:02 +00:00
jan.nijtmans 93fa41f6c7 Now really remove Tcl_EvalTokens/Tcl_Backslash as promised in the TIP.
And remove library/tzdata/SystemV/* which contains non-standard timezones. See: [d3c5f2eb2ff63f10] They were originally gone since the tzdata2014f update, but it's unwise to do that in a patch release.
Some documentation updates.
2018-01-19 15:17:45 +00:00
stu eb5da6ae82 OpenBSD now has AI_ADDRCONFIG. 2018-01-17 19:01:03 +00:00
jan.nijtmans 4786f9814b clean-up some more remainings of the Itcl hack. Taken over from "novem". 2018-01-17 16:01:42 +00:00
jan.nijtmans d695e02d2f Remove obsolete documentation (belonging to now-removed functions). Remove obsolete 8.4 bytecodes. And a few other (internal) macro's which are no longer in use. 2018-01-17 14:17:21 +00:00
jan.nijtmans 1c58e29da2 Remove Tcl_CaseObjCmd from tclInt.h as well (was missing in previous commit) 2018-01-17 12:56:22 +00:00
jan.nijtmans ed6aa022a6 TIP #485 implementation, Tcl 9.0 part: Realy remove code which was declared deprecated in 8.7 2018-01-17 12:45:01 +00:00
jan.nijtmans 0019582fd2 merge core-8-branch 2018-01-12 11:18:48 +00:00
jan.nijtmans d34c6b6526 merge core-8-branch 2018-01-10 14:33:54 +00:00
pooryorick b40ed15606 Rearrange a few lines TclRenameCommand to reduce operations. 2018-01-08 17:36:00 +00:00
dgp 904582dd30 merge 8.7 2018-01-04 02:40:00 +00:00
jan.nijtmans d08f08a24d merge core-8-branch 2017-12-28 21:16:13 +00:00
jan.nijtmans 7172ae9071 merge core-8-branch 2017-12-28 18:53:23 +00:00
pooryorick 63224df965 TclOO: Remove unneeded name manipulation from TclOOCopyObjectCmd. 2017-12-26 12:54:00 +00:00
apnadkarni b067895cc4 Merged core-8-branch: replace ifdef TCLDIR with compare against empty string 2017-12-26 03:33:35 +00:00
jan.nijtmans e754f70125 merge core-8-branch 2017-12-23 18:41:29 +00:00
apnadkarni 2a5955ee50 Merge nmake rules 1.1 2017-12-23 08:05:02 +00:00
jan.nijtmans 264c508ca4 merge core-8-branch 2017-12-22 15:48:07 +00:00
jan.nijtmans 7fdcf0c76d merge-mark 2017-12-21 07:51:08 +00:00
pooryorick 7835ba29c7 Further fix for issue [ba1419303b4c]: Delete a namespace for an ensemble having a
deletion trace deletes its namespace: segmentation fault.
2017-12-20 18:22:59 +00:00
jan.nijtmans a15b801bfb Remove the Tcl_FindHashEntry/Tcl_CreateHashEntry stub entries, as those are actually macro's. 2017-12-20 12:30:23 +00:00
jan.nijtmans 1b40a62611 Change hash/index/mask fields to type "unsigned int", because that's how hash values are generally stored. This eliminates the need for PTR2UINT/UINT2PTR in various places. 2017-12-20 12:02:34 +00:00
pooryorick 2bfe68441a Fix for issue [ba1419303b4c]: Delete a namespace for an ensemble having a deletion
trace deletes its namespace: segmentation fault.
2017-12-20 09:19:59 +00:00
dgp 82512215ff [586e71dce4] Exeception handling at level #0 by EvalObjv 2017-12-19 21:00:55 +00:00
jan.nijtmans a430544f4a merge core-8-branch. Also change some internal refCount's from int to size_t. 2017-12-19 12:23:19 +00:00
jan.nijtmans 0a2389d0ab merge core-8-branch 2017-12-18 11:48:35 +00:00
jan.nijtmans 4a98f5042e merge-mark 2017-12-15 21:28:35 +00:00
dgp 62545de5ce merge mark 2017-12-15 17:04:26 +00:00
jan.nijtmans ab6e69444f Merge TIP #488 implementation.
Some clean-up in tommath implementation (remove internal stub entries which are no longer needed)
2017-12-15 15:02:42 +00:00
apnadkarni 8bc8d823bb core-8-branch merge: Use nmakehlp -L to locate directories 2017-12-13 10:34:58 +00:00
apnadkarni 0ebe3d394d Add -L option to nmakehlp to locate directories 2017-12-12 17:34:13 +00:00
apnadkarni 5501e78098 Merge from core-8-branch - install stubs and headers where present 2017-12-11 16:42:41 +00:00
jan.nijtmans 5de1c8c6a5 merge core-8-branch 2017-12-10 14:39:00 +00:00
pooryorick e58661a87e Ensure that an automatically-named TclOO object has the same name as its
namespace.
2017-12-10 00:01:01 +00:00
jan.nijtmans 5b605792cb merge core-8-branch.
Remove stub entry for TclWinGetPlatformId(), as it is no longer needed. Is a macro now.
2017-12-09 16:13:58 +00:00
apnadkarni 5724764152 TIP477 merge: reformed nmake build system 2017-12-08 16:54:18 +00:00
jan.nijtmans ae26eec096 merge 8.7 2017-12-07 12:36:16 +00:00
dgp 2623503549 merge 8.7 2017-12-06 20:48:49 +00:00
dgp a7bb7b19d6 merge 8.7 2017-12-06 20:03:07 +00:00
dgp 1e64c9f8b2 Adapt the bytearray accommodation of Tcl_CharLength() for 8.7+. 2017-12-06 13:28:48 +00:00
dgp b68bab17c0 [ce3a211dcb] Failed file normalize when tail is empty string. 2017-12-06 13:07:23 +00:00
dgp b6b032fc3b [4f6a1ebd64] Stop crash when same value passed to the -map and -subcommands options of ensemble configuration. 2017-12-05 15:59:09 +00:00
jan.nijtmans 200910b9c1 merge core-8-branch. Various cleanup: unused structure names, unused #defines. Change some "epoch"-related fields from int to size_t. Nothing functional. 2017-12-01 13:53:51 +00:00
jan.nijtmans 0bd09c4106 remove many test-cases related to tcl_precision 2017-12-01 12:24:25 +00:00
jan.nijtmans ff91f80124 TIP 488: Remove tcl_precision 2017-12-01 11:55:28 +00:00
jan.nijtmans e802927981 Remove stub entries for Tcl_EvalObj()/Tcl_GlobalEvalObj(). Since those functions are actually macro's translating to Tcl_EvalObjEx(), those stub entries don't serve any purpose any more. 2017-12-01 11:03:43 +00:00
dgp 9d4d161834 merge 8.7 2017-11-30 17:29:55 +00:00
jan.nijtmans 111f52def6 merge-mark 2017-11-30 15:27:45 +00:00
jan.nijtmans 9dd792a540 8.[67] -> 9.0 in a few more places 2017-11-30 14:48:03 +00:00
jan.nijtmans 20bbe0a790 merge core-8-branch 2017-11-30 14:38:32 +00:00
jan.nijtmans 94b624f11c merge core-8-branch 2017-11-30 13:23:10 +00:00
dgp 5a9014a650 Follow header file conventions. 2017-11-29 15:19:04 +00:00
jan.nijtmans a6a61c4ca6 merge core-8-branch 2017-11-29 12:32:38 +00:00
pspjuth 121654ecd8 merge core-8-branch 2017-11-21 22:47:44 +00:00
jan.nijtmans d0e9170c39 Remove TclCopyChannelOld() function. Should have been part of [b03c4194f001be0b|this] earlier commit. 2017-11-20 12:13:29 +00:00
jan.nijtmans 75a121d773 merge core-8-branch 2017-11-20 10:23:13 +00:00
jan.nijtmans adc8a8bbdf merge core-8-branch 2017-11-20 09:28:02 +00:00
jan.nijtmans 466e0f29c3 TIP #422, Tcl 9.0 part: Don't Use stdarg.h/va_list in Public API 2017-11-17 10:50:02 +00:00
jan.nijtmans de0ff2272e merge core-8-branch 2017-11-15 10:01:18 +00:00
jan.nijtmans b9216a9c1f merge core-8-branch 2017-11-15 08:56:25 +00:00
dgp 43f411afeb [5d6de65036] [package require] with [package prefer stable] was not choosing available stable package. 2017-11-14 17:24:00 +00:00
jan.nijtmans a35ad3e794 Remove extra.unused2 field from struct Interp. It really is unused ... 2017-11-14 10:00:58 +00:00
jan.nijtmans cd80622d5e merge core-8-branch 2017-11-13 11:17:23 +00:00
jan.nijtmans 26c5e61700 merge tcl-9-cleanup (and also a minor bug-fix from core-8-branch). 2017-11-13 08:59:59 +00:00
dgp de9a7da4ba merge trunk 2017-11-09 14:40:30 +00:00
jan.nijtmans c1f627b31e Fogot to remove the TclWinSetInterfaces() implementation. 2017-11-09 09:02:44 +00:00
dgp 4ed027b7bc merge trunk 2017-11-08 18:58:31 +00:00
dgp 258b9f4333 Also remove panicVA(). 2017-11-08 18:52:33 +00:00
jan.nijtmans a31c699833 Forgot TclpGetTime() 2017-11-08 16:12:29 +00:00
jan.nijtmans 9c9ce91ef5 Tcl-9 huge cleanup: Remove many unused internal functions which do nothing more than occupy the internal stub table. 2017-11-08 15:50:06 +00:00
jan.nijtmans c38755a732 Re-base TIP #422 implementation to trunk. Remove Tcl_VarEvalVA() as well. TIP #422 is adapted accordingly. 2017-11-07 09:33:56 +00:00
dgp 9c75e1c5f8 TIP 422 implementation (rebase of branch novem-remove-va to trunk). 2017-11-01 14:46:28 +00:00
jan.nijtmans 8a090098fe merge trunk 2017-02-01 15:03:59 +00:00
pooryorick 547a4781df merge trunk 2016-10-03 16:55:56 +00:00
pooryorick 77140c23d4 Fix improper use of TclCheckEmptySTring. 2016-08-22 07:58:55 +00:00
pooryorick 382ff46e71 Remove unnecessary macro. Use an enum for result values. 2016-07-11 09:16:15 +00:00
pooryorick 0af0a4ef07 Change TclIsEmpty to TclCheckEmptyString. Check length instead of first char of
bytes.
2016-07-11 08:09:33 +00:00
pooryorick ee2b083ea7 Add missing "break". 2016-07-11 00:01:58 +00:00
pooryorick 2c4866bd92 Avoid generating string representation for comparisons against empty string. 2016-07-10 23:07:47 +00:00
jan.nijtmans 08553f531f merge novem 2013-03-06 13:41:23 +00:00
jan.nijtmans 7e7ec63c2c merge trunk 2013-03-06 13:16:42 +00:00
jan.nijtmans e354aa0e3d merge trunk.
Implement Tcl_VarTraceInfo and Tcl_UpVar as macro.
2013-02-27 12:06:40 +00:00
jan.nijtmans 0957b2c850 merge trunk.
Unicode 6.3 does not have that many spaces.....
2013-02-25 16:05:27 +00:00
jan.nijtmans 57665b295c merge trunk.
Update all unicode tables to current state of Unicode 6.3 (not released yet)
2013-02-25 13:52:05 +00:00
jan.nijtmans dfff588886 merge trunk 2013-02-23 10:54:37 +00:00
jan.nijtmans ca7c7ce1b7 Merge trunk.
Convert Tcl_UntraceVar to macro, calling Tcl_UntraceVar2 in stead. No change of functionality.
2013-02-22 09:41:15 +00:00
jan.nijtmans 4349c08e31 Merge trunk.
Convert Tcl_SetVar/Tcl_UnsetVar/Tcl_GetVar/Tcl_TraceVar to macros, calling the *2 variants of the function. No change of functionality.
2013-02-20 14:51:48 +00:00
jan.nijtmans bb71951f1a Merge trunk.
Tranform Tcl_SaveResult/Tcl_RestoreResult/Tcl_DiscardResult to macros, and remove them from the stub table
2013-02-19 13:21:53 +00:00
jan.nijtmans 4f37f05a9c merge trunk 2013-02-15 16:21:49 +00:00
jan.nijtmans abc5015131 more Tcl_NewIntObj/Tcl_NewBooleanObj -> Tcl_NewLongObj conversions 2013-02-11 10:25:04 +00:00
jan.nijtmans f50166e4fc Merge trunk.
Various Tcl_NewIntObj/Tcl_NewBooleanObj  -> Tcl_NewLongObj modifications
2013-02-11 09:38:07 +00:00
jan.nijtmans 2c163978e7 Merge trunk.
Eliminate all usage of internal macros: TclNewIntObj, TclNewBooleanObj, TclSetIntObj, TclSetBooleanObj. 
Change various function to macros: Tcl_NewIntObj, Tcl_SetIntObj, Tcl_NewBooleanObj, Tcl_DbNewBooleanObj, Tcl_SetBooleanObj, Tcl_AddErrorInfo, Tcl_AddObjErrorInfo.
2013-02-08 13:28:06 +00:00
jan.nijtmans 4acf174468 put braces around all macro parameters 2013-02-07 14:22:16 +00:00
jan.nijtmans e8b3de6a75 merge trunk 2013-02-07 13:57:01 +00:00
jan.nijtmans 6fa4858662 merge trunk 2013-02-07 10:15:07 +00:00
jan.nijtmans dd7709baa2 merge trunk 2013-02-04 22:56:43 +00:00
jan.nijtmans c67bfbf1a4 merge trunk 2013-02-04 14:15:14 +00:00
jan.nijtmans b0bf6914f1 merge trunk 2013-02-03 16:05:31 +00:00
jan.nijtmans 330e115d11 merge trunk 2013-01-29 08:14:41 +00:00
jan.nijtmans 03c4df2e30 merge trunk 2013-01-25 13:14:48 +00:00
jan.nijtmans ff878198ef merge trunk
Add -Wwrite-strings to compiler options, so we can guarantee correct "const" usage.
2013-01-25 12:58:20 +00:00
jan.nijtmans 84707cf702 Merge trunk
Rename TclInitStubs back to Tcl_InitStubs, for easier compatibility with Tcl 8.
2013-01-25 09:12:32 +00:00
jan.nijtmans d8b1866404 Convert Tcl_GetIndexFromObj implementation to macro 2013-01-24 10:37:30 +00:00
jan.nijtmans 45c9d1dc2c merge trunk 2013-01-23 14:11:12 +00:00
jan.nijtmans a3100689bc merge-mark 2013-01-21 13:52:52 +00:00
jan.nijtmans 014e7b1951 merge trunk 2013-01-19 18:28:03 +00:00
jan.nijtmans ad5f7e5464 Convert Tcl_Eval and Tcl_GlobalEval to a macro 2013-01-17 22:28:38 +00:00
dgp 3b0f6c1c31 merge trunk 2013-01-17 16:32:50 +00:00
jan.nijtmans 4198cbe8cd merge trunk
Remove various double-defined (both in public and private stub tables) functions from private stub table
2013-01-12 22:23:29 +00:00
jan.nijtmans 3e3a85339f Remove TclWinNToHS, it is not used anywhere any more. 2013-01-10 11:45:08 +00:00
jan.nijtmans adf3bedc0c merge trunk 2013-01-10 10:04:13 +00:00
jan.nijtmans c260fedf0c Turn Tcl_PkgPresent/Tcl_PkgRequire into a macro.
Make sure that extensions which are compiled using Tcl version 9.0 alpha/beta headers only run with the exact same Tcl version (9.0a0), so they cannot accidently be used in production. Idea 'stolen' from iTcl 4.0, which did that during alpha/beta
Dde/Registry: eliminate usage of some older API, which might be removed/deprecated in the future.
2013-01-10 09:55:55 +00:00
jan.nijtmans 1c58938f2c Restore panic check at and of the loop. Thanks! Don for noticing this. 2013-01-09 15:37:27 +00:00
jan.nijtmans 051f9006ef Restore API compatibility with public Tcl_*Scan and Tcl_*Convert functions (changes in private functions are OK)
Increase LOCAL_SIZE to 64, and remove two Panic's which cannot occur any more as a result of the improvements.
2013-01-09 12:33:45 +00:00
jan.nijtmans 361141a857 remove some unused static functions/variables 2013-01-08 21:42:23 +00:00
dgp 75194c3206 The Tcl*(Scan|Convert)*Element() routines only need chars, not ints, to
hold their flags.  Reduce waste now that interface freedom permits it.
2013-01-08 17:10:04 +00:00
jan.nijtmans 04a740f5c6 Don't depend on Spencer-specific regexp syntax (/u and /U) any more.
Bump http package to 2.8.6.
2013-01-06 21:09:17 +00:00
jan.nijtmans 6aa85ad35f merge trunk 2013-01-05 00:42:34 +00:00
jan.nijtmans 6797693d1b merge trunk 2013-01-02 14:56:58 +00:00
jan.nijtmans aef36bf11d two more places where refCount was assumed to be a signed value. In Tcl9 that will probably be not true any more. 2012-12-29 18:12:45 +00:00
jan.nijtmans 0dc45b9fe3 fix tm.tcl to include tcl8 locations, and fix corresponding test-cases 2012-12-29 15:24:24 +00:00
jan.nijtmans e65b021050 merge trunk 2012-12-29 09:24:59 +00:00
jan.nijtmans b5100ee98f merge trunk 2012-12-27 15:05:28 +00:00
jan.nijtmans 2951fec86b remove unnecessary struct names, which only pollute the "struct" namespace for the compiler. 2012-12-21 10:13:37 +00:00
jan.nijtmans d07793f49c merge trunk 2012-12-21 09:42:57 +00:00
jan.nijtmans 2acbdb0493 Remove all VA functions Tcl_AppendResultVA, Tcl_AppendStringsToObjVA, Tcl_SetErrorCodeVA, Tcl_PanicVA, and dependancy of tcl.h on <stdarg.h>. TIP required. 2012-12-18 13:47:08 +00:00
jan.nijtmans e00ad288cc remove deprecated functions Tcl_VarEval and Tcl_VarEvalVA 2012-12-17 12:45:19 +00:00
jan.nijtmans 5b8ce14566 Merge trunk.
Add more clarity why refCount should be decremented AFTER checking for <2. 
Protect 8.x extensions for being loadable in "novem", by changing Tcl_PkgProvide into a macro.
2012-12-14 09:40:56 +00:00
jan.nijtmans facce70703 merge trunk 2012-12-13 13:01:49 +00:00
jan.nijtmans 26f4ba76ca allow novem to use installed Tcl8 .tm packages, such as tcltest and msgcat
remove some dead code (already planned to be removed in Tcl9)
2012-12-12 10:21:55 +00:00
jan.nijtmans aaf8665696 merge trunk 2012-12-10 20:54:49 +00:00
jan.nijtmans e4dd07e735 merge trunk 2012-12-07 22:16:45 +00:00
dgp e98a68549d merge trunk 2012-12-07 17:05:09 +00:00
jan.nijtmans 1fc4f8eaa3 merge trunk 2012-12-07 16:12:37 +00:00
jan.nijtmans 70bccae334 merge trunk
turn pkgb.so into a Tcl8 interoperability test
library: Whatever Tcl9 looks like, loading pkgb.so in Tcl 8 should
either result in an error-message, either succeed, but never crash.
2012-12-07 10:11:47 +00:00
jan.nijtmans 052f5d50c9 merge trunk 2012-12-05 13:41:51 +00:00
jan.nijtmans 5815a325af merge trunk 2012-12-04 13:40:58 +00:00
jan.nijtmans 3ff398393a Remove obsolete functions Tcl_GetDefaultEncodingDir and Tcl_SetDefaultEncodingDir 2012-12-03 13:02:08 +00:00
jan.nijtmans ef0bb68bcb Initialize legacyFreeProc with invalid value: This will result in
a crash immediately, when an extention tries to call it, in stead
of crashing some time later....
Remove some more legacy regarding accessing interp->result
2012-12-03 10:01:20 +00:00
dgp 382a840e23 Remove all maintenance of a string result in the Interp. 2012-11-30 17:00:16 +00:00
dgp 1e6fd4531c Re-fix failing load-3.2 test. The right way this time. 2012-11-30 16:14:11 +00:00
dgp 21e80b3a25 Stop [glob] complaining about empty list result. Continue support for
a no-op -nocomplain option, but don't document it.  Old script support only.
2012-11-30 16:10:20 +00:00
jan.nijtmans 8e6efd7026 After a Tcl_SetObjResult, don't do a Tcl_TransferResult to the same interpreter 2012-11-30 15:55:03 +00:00
jan.nijtmans 39365ed3c0 merge (modified) novem-review.
unbreak windows build
2012-11-30 15:42:56 +00:00
dgp f52f05c3b1 No string result -> no more need for TCL_RESULT_SIZE 2012-11-29 21:34:22 +00:00
dgp 388741b7d0 Bug fix. Stop load-3.2 test failure. 2012-11-29 21:28:24 +00:00
dgp b2ca802381 Purge remnants of support for compilers ignorant of C keyword 'inline'. 2012-11-29 21:25:52 +00:00
dgp b05600e60a Stop defining VOID. Demand C compilers that know the void keyword. 2012-11-29 21:03:06 +00:00
dgp 98a8b3604f Destroy all the TCL_STORAGE_CLASS and associated nonsense. 2012-11-29 20:32:16 +00:00
dgp 905d1e5d03 Remove STRINGIFY and JOIN utility macros. Tcl doesn't use them.
And Tcl doesn't need to be in the utility macro supply business.
If an extension needs these, let them define them.
2012-11-29 17:45:20 +00:00
dgp cb7c84c310 Proposed rollback of the TCL_STUB_MAGIC change on novem branch. 2012-11-29 17:25:59 +00:00
dgp 03bdf41de2 missed bit of merge 2012-11-29 17:03:17 +00:00
dgp 206428d2cf Get the updated error message 2012-11-29 16:52:45 +00:00
dgp bc0d613154 Merge bug-3588687 2012-11-29 16:26:14 +00:00
dgp 1d6f003314 merge novem 2012-11-29 16:03:21 +00:00
dgp e81a4abd60 merge trunk 2012-11-29 15:58:38 +00:00
dgp 06ebe62a5e Revise TclInitStubs() so that it checks for consistent values of both
TCL_MAJOR_VERSION and TCL_STUB_MAGIC between an extension and the stub library.
2012-11-29 15:24:50 +00:00
dgp 0d78d389e1 3588687 Added cross checks so that [load]ed extension, [load]ing interp, and
linked stubs library all agree on their versions in the ways that matter.
2012-11-27 21:09:20 +00:00
dgp eea64f8d90 Merge (selected bits of) novem 2012-11-26 22:37:01 +00:00
dgp 4c5cc88bdf Stop segfaults in test suite. 2012-11-26 22:23:43 +00:00
dgp a1cee7cd20 merge (some of) novem 2012-11-26 21:49:46 +00:00
dgp 3327979282 Merge use of [load] to find and nicely report error when incompatible stubs
mechanisms between [load]ing interp and [load]ed extension are detected.
2012-11-26 21:43:18 +00:00
dgp 8c19725a30 ...and here's the lines left behind in the editor. 2012-11-26 21:30:13 +00:00
dgp 0a224ddfc8 Comments and renamings around the legacy fields for string results. 2012-11-26 21:25:26 +00:00
jan.nijtmans 9a7c011683 merge trunk 2012-11-26 15:37:24 +00:00
jan.nijtmans 44427fccaa unbreak UNIX build 2012-11-26 15:33:47 +00:00
jan.nijtmans c4cf77f310 Removed functions marked deprecated or obsolete for a long time: Tcl_Backslash, Tcl_EvalFile, Tcl_GlobalEvalObj, Tcl_GlobalEval, Tcl_EvalTokens.
Remove Tcl_FindExecutable from stub table: It is needed by embedders, not extenders. 
Remove TclpGetDate, TclpGmtime, TclpLocaltime: it isn't use anywhere since the new clock implementation. 
Remove TclWinConvertWSAError, it's the same as TclWinConvertError.
2012-11-26 14:29:58 +00:00
jan.nijtmans 9b00a63b22 merge trunk 2012-11-22 09:18:51 +00:00
jan.nijtmans 91d9bd02c0 merge trunk 2012-11-20 10:01:00 +00:00
jan.nijtmans 56b69c4e9a It might be that iPtr->result points to an empty string but that iPtr->objResult contains the real error-message. So, handle that too. 2012-11-20 09:01:46 +00:00
jan.nijtmans d2b1e66352 ... make it more portable 2012-11-20 08:42:36 +00:00
jan.nijtmans d29d888dc6 Add checks for the assumtions made in tclStubLib.c, making sure that those
assumtions are maintained for Tcl 9! If not, extensions compiled for Tcl9
but loaded in Tcl8 (with an incompatible stub table) cannot produce
a nice error-message any more.
<p>This is probably not the best place to do the check, maybe it's better
to do this in tclTest.c, as part of the test suite.
<p>Feedback welcome!
2012-11-20 08:40:56 +00:00
jan.nijtmans f4ed4079b7 make windde and winreg load again 2012-11-19 22:34:32 +00:00
jan.nijtmans dde5a2565e Single stub library can now handle Tcl8 and Tcl9 with different MAGIC values 2012-11-19 21:46:51 +00:00
jan.nijtmans e59a1e0b14 eliminate unused variable 2012-11-19 21:45:34 +00:00
jan.nijtmans c4b5bfbd50 Remove some undocumented - obsolete - function from the API with 'Old' in the name. 2012-11-19 11:17:58 +00:00
jan.nijtmans 44869c9e35 Better solution for handling errors from Tcl 8.x compiled extensions. Works for existing ones. 2012-11-19 08:30:11 +00:00
jan.nijtmans e5463e8ec8 change stub library to detect - and generate a nice error-message -
when a shared library compiled for Tcl 9.x is attempted to be
loaded in Tcl 8.x. Change MAGIC value in stub tables for 64-bit
builds (those surely will be incomatible!)
2012-11-18 17:24:05 +00:00
jan.nijtmans bddf737714 <i>on-hold at Don Porter's request</i>
change stub library to detect - and generate a nice error-message - 
when a shared library compiled for Tcl 8.x is attempted to be
loaded in Tcl 9.x: Tcl 9 will not have the iPtr->result field
so we cannot use that any more.
2012-11-18 17:12:35 +00:00
jan.nijtmans ef0fd808de <i>On hold at Don Porter's request</i>
hange stub library to detect - and generate a nice error-message - 
when a shared library compiled for Tcl 8.x is attempted to be
loaded in Tcl 9.x: Tcl 9 will not have the iPtr->result field
so we cannot use that any more.
2012-11-18 17:04:38 +00:00
jan.nijtmans f4fb1d1752 <i>On-hold at Don Porter's request.</i>
change stub library to detect - and generate a nice error-message - 
when a shared library compiled for Tcl 8.x is attempted to be
loaded in Tcl 9.x: Tcl 9 will not have the iPtr->result field
so we cannot use that any more.
2012-11-18 16:54:16 +00:00
dgp 59ea8cb145 WIP removing the maintenance of a string result in the Interp.
Still some head-scratching on what to do with tclStubLib.c.
2012-11-17 00:25:23 +00:00
dgp e9cf99c212 merge trunk 2012-11-16 22:51:18 +00:00
dgp 80630f4ec9 Burn the bridge back to obsolete [puts] syntax. (Tcl 6?!) 2012-11-16 21:17:29 +00:00
dgp e63dcc2677 Burn the octal bridges. We're not goin' back. 2012-11-16 19:17:21 +00:00
dgp 9bbc90b227 Tcl_Value is now a synonym for Tcl_Obj ! 2012-11-16 17:57:38 +00:00
dgp 8e5dbc8a27 Remove pre-8.5 interface for custom expr functions. 2012-11-16 17:52:55 +00:00
dgp 29c6b72a83 merge trunk 2012-11-16 16:37:07 +00:00
jan.nijtmans fd5b3bb085 eliminate CONST/CONST84/CONST86 2012-11-16 12:02:11 +00:00
jan.nijtmans 2fda7e49a0 Doc fix in TCL_MEM_DEBUG.3 2012-11-16 10:22:58 +00:00
jan.nijtmans 27256fcd71 Merge trunk
<p>Fix Windows build 
<p>Now usable with Thread's "novem" branch (3.0a1)
<p>Remove some more deprecated stuff
2012-11-16 10:12:05 +00:00
dgp e702454abe Abandon support for pre-8.5 bytecode. 2012-11-15 22:17:24 +00:00
dgp 9423df2491 Goodbye to [case]. 2012-11-15 21:04:23 +00:00
dgp 05b1764f74 Octal death documentation impacts. 2012-11-15 05:12:38 +00:00
dgp bff7817ec0 Kill Octal; bump to 9.0a0; make test suite work again. 2012-11-15 04:09:25 +00:00
jan.nijtmans 13bc69a8a4 unnecessary hook struct definitions 2012-08-21 08:07:40 +00:00
jan.nijtmans 9aa711e8e0 remove unnecessary struct names, which only pollute the "struct" namespace for te compiler. 2012-08-20 06:49:25 +00:00
dgp b339d4bf03 merge trunk 2012-07-19 15:08:23 +00:00
dgp 1e58e8e42d Implement Tcl_DStringResult with call to TclDStringToObj. 2012-04-25 21:03:58 +00:00
dgp 91af7f6f90 merge trunk 2012-04-25 21:02:42 +00:00
dgp 68191ded75 To preserve the ability of [load] to bring in mistmatched stubs-enabled
modules and react with an error rather than a crash, HasStubSupport() has
to keep fiddling with the same fields as always.
2012-04-19 12:57:45 +00:00
dkf ac3d0b69d3 Clean version of changes; ifdef-free 2012-04-19 12:41:06 +00:00
dkf 96f611f896 merge trunk 2012-04-19 12:20:49 +00:00
dgp ec9c29c80d Experimental branch where the interp->result field and related are removed
and all simplifications that makes possible are done.  Seems this can at best
be a Tcl 9 reform.
2012-04-18 18:42:54 +00:00
205 changed files with 4040 additions and 12547 deletions
+1 -1
View File
@@ -1,6 +1,6 @@
<?xml version="1.0" encoding="UTF-8"?>
<projectDescription>
<name>tcl8</name>
<name>tcl9</name>
<comment></comment>
<projects>
</projects>
+4 -4
View File
@@ -1,5 +1,5 @@
README: Tcl
This is the Tcl 8.7a2 source distribution.
This is the Tcl 9.0a0 source distribution.
http://sourceforge.net/projects/tcl/files/Tcl/
You can get any source release of Tcl from the URL above.
@@ -49,7 +49,7 @@ and selling it either in whole or in part. See the file
Extensive documentation is available at our website.
The home page for this release, including new features, is
http://www.tcl.tk/software/tcltk/8.7.html
http://www.tcl.tk/software/tcltk/9.0.html
Detailed release notes can be found at the file distributions page
by clicking on the relevant version.
@@ -61,9 +61,9 @@ Information about Tcl itself can be found at
There have been many Tcl books on the market. Many are mentioned in the Wiki:
http://wiki.tcl.tk/_/ref?N=25206
To view the complete set of reference manual entries for Tcl 8.7 online,
To view the complete set of reference manual entries for Tcl 9.0 online,
visit the URL:
http://www.tcl.tk/man/tcl8.7/
http://www.tcl.tk/man/tcl9.0/
2a. Unix Documentation
----------------------
+1 -6
View File
@@ -9,7 +9,7 @@
.so man.macros
.BS
.SH NAME
Tcl_GetReturnOptions, Tcl_SetReturnOptions, Tcl_AddErrorInfo, Tcl_AppendObjToErrorInfo, Tcl_AddObjErrorInfo, Tcl_SetObjErrorCode, Tcl_SetErrorCode, Tcl_SetErrorCodeVA, Tcl_SetErrorLine, Tcl_GetErrorLine, Tcl_PosixError, Tcl_LogCommandInfo \- retrieve or record information about errors and other return options
Tcl_GetReturnOptions, Tcl_SetReturnOptions, Tcl_AddErrorInfo, Tcl_AppendObjToErrorInfo, Tcl_AddObjErrorInfo, Tcl_SetObjErrorCode, Tcl_SetErrorCode, Tcl_SetErrorLine, Tcl_GetErrorLine, Tcl_PosixError, Tcl_LogCommandInfo \- retrieve or record information about errors and other return options
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -30,8 +30,6 @@ int
.sp
\fBTcl_SetErrorCode\fR(\fIinterp, element, element, ... \fB(char *) NULL\fR)
.sp
\fBTcl_SetErrorCodeVA\fR(\fIinterp, argList\fR)
.sp
\fBTcl_GetErrorLine\fR(\fIinterp\fR)
.sp
\fBTcl_SetErrorLine\fR(\fIinterp, lineNum\fR)
@@ -245,9 +243,6 @@ The procedure \fBTcl_SetErrorCode\fR is also used to set the
record instead of a value. Otherwise, it is similar to
\fBTcl_SetObjErrorCode\fR in behavior.
.PP
\fBTcl_SetErrorCodeVA\fR is the same as \fBTcl_SetErrorCode\fR except that
instead of taking a variable number of arguments it takes an argument list.
.PP
The procedure \fBTcl_GetErrorLine\fR is used to read the integer value
of the \fB\-errorline\fR return option without the overhead of a full
call to \fBTcl_GetReturnOptions\fR. Likewise, \fBTcl_SetErrorLine\fR
+1 -2
View File
@@ -30,8 +30,7 @@ or \fBTCL_RETURN\fR, then Tcl normally converts this into a \fBTCL_ERROR\fR
return with an appropriate message. The particular script
evaluation procedures of Tcl that act in the manner are
\fBTcl_EvalObjEx\fR, \fBTcl_EvalObjv\fR, \fBTcl_Eval\fR, \fBTcl_EvalEx\fR,
\fBTcl_GlobalEval\fR, \fBTcl_GlobalEvalObj\fR, \fBTcl_VarEval\fR and
\fBTcl_VarEvalVA\fR.
\fBTcl_GlobalEval\fR, \fBTcl_GlobalEvalObj\fR and \fBTcl_VarEval\fR.
.PP
However, if \fBTcl_AllowExceptions\fR is invoked immediately before
calling one of those a procedures, then arbitrary completion
-47
View File
@@ -1,47 +0,0 @@
'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_Backslash 3 "8.1" Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Backslash \- parse a backslash sequence
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
char
\fBTcl_Backslash\fR(\fIsrc, countPtr\fR)
.SH ARGUMENTS
.AS char *countPtr out
.AP char *src in
Pointer to a string starting with a backslash.
.AP int *countPtr out
If \fIcountPtr\fR is not NULL, \fI*countPtr\fR gets filled
in with number of characters in the backslash sequence, including
the backslash character.
.BE
.SH DESCRIPTION
.PP
The use of \fBTcl_Backslash\fR is deprecated in favor of
\fBTcl_UtfBackslash\fR.
.PP
This is a utility procedure provided for backwards compatibility with
non-internationalized Tcl extensions. It parses a backslash sequence and
returns the low byte of the Unicode character corresponding to the sequence.
\fBTcl_Backslash\fR modifies \fI*countPtr\fR to contain the number of
characters in the backslash sequence.
.PP
See the Tcl manual entry for information on the valid backslash sequences.
All of the sequences described in the Tcl manual entry are supported by
\fBTcl_Backslash\fR.
.SH "SEE ALSO"
Tcl(n), Tcl_UtfBackslash(3)
.SH KEYWORDS
backslash, parse
-162
View File
@@ -1,162 +0,0 @@
'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_CreateMathFunc 3 8.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_CreateMathFunc, Tcl_GetMathFuncInfo, Tcl_ListMathFuncs \- Define, query and enumerate math functions for expressions
.SH "NOTICE OF EVENTUAL DEPRECATION"
.PP
The \fBTcl_CreateMathFunc\fR and \fBTcl_GetMathFuncInfo\fR functions
are rendered somewhat obsolete by the ability to create functions for
expressions by placing commands in the \fBtcl::mathfunc\fR namespace,
as described in the \fBmathfunc\fR manual page; the API described on
this page is not expected to be maintained indefinitely.
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
void
\fBTcl_CreateMathFunc\fR(\fIinterp, name, numArgs, argTypes, proc, clientData\fR)
.sp
int
\fBTcl_GetMathFuncInfo\fR(\fIinterp, name, numArgsPtr, argTypesPtr, procPtr,
clientDataPtr\fR)
.sp
Tcl_Obj *
\fBTcl_ListMathFuncs\fR(\fIinterp, pattern\fR)
.SH ARGUMENTS
.AS Tcl_ValueType *clientDataPtr out
.AP Tcl_Interp *interp in
Interpreter in which new function will be defined.
.AP "const char" *name in
Name for new function.
.AP int numArgs in
Number of arguments to new function; also gives size of \fIargTypes\fR array.
.AP Tcl_ValueType *argTypes in
Points to an array giving the permissible types for each argument to
function.
.AP Tcl_MathProc *proc in
Procedure that implements the function.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR when it is invoked.
.AP int *numArgsPtr out
Points to a variable that will be set to contain the number of
arguments to the function.
.AP Tcl_ValueType **argTypesPtr out
Points to a variable that will be set to contain a pointer to an array
giving the permissible types for each argument to the function which
will need to be freed up using \fITcl_Free\fR.
.AP Tcl_MathProc **procPtr out
Points to a variable that will be set to contain a pointer to the
implementation code for the function (or NULL if the function is
implemented directly in bytecode).
.AP ClientData *clientDataPtr out
Points to a variable that will be set to contain the clientData
argument passed to \fITcl_CreateMathFunc\fR when the function was
created if the function is not implemented directly in bytecode.
.AP "const char" *pattern in
Pattern to match against function names so as to filter them (by
passing to \fITcl_StringMatch\fR), or NULL to not apply any filter.
.BE
.SH DESCRIPTION
.PP
Tcl allows a number of mathematical functions to be used in
expressions, such as \fBsin\fR, \fBcos\fR, and \fBhypot\fR.
These functions are represented by commands in the namespace,
\fBtcl::mathfunc\fR. The \fBTcl_CreateMathFunc\fR function is
an obsolete way for applications to add additional functions
to those already provided by Tcl or to replace existing functions.
It should not be used by new applications, which should create
math functions using \fBTcl_CreateObjCommand\fR to create a command
in the \fBtcl::mathfunc\fR namespace.
.PP
In the \fBTcl_CreateMathFunc\fR interface,
\fIName\fR is the name of the function as it will appear in expressions.
If \fIname\fR does not already exist in the \fB::tcl::mathfunc\fR
namespace, then a new command is created in that namespace.
If \fIname\fR does exist, then the existing function is replaced.
\fINumArgs\fR and \fIargTypes\fR describe the arguments to the function.
Each entry in the \fIargTypes\fR array must be
one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR, \fBTCL_WIDE_INT\fR,
or \fBTCL_EITHER\fR to indicate whether the corresponding argument must be an
integer, a double-precision floating value, a wide (64-bit) integer,
or any, respectively.
.PP
Whenever the function is invoked in an expression Tcl will invoke
\fIproc\fR. \fIProc\fR should have arguments and result that match
the type \fBTcl_MathProc\fR:
.PP
.CS
typedef int \fBTcl_MathProc\fR(
ClientData \fIclientData\fR,
Tcl_Interp *\fIinterp\fR,
Tcl_Value *\fIargs\fR,
Tcl_Value *\fIresultPtr\fR);
.CE
.PP
When \fIproc\fR is invoked the \fIclientData\fR and \fIinterp\fR
arguments will be the same as those passed to \fBTcl_CreateMathFunc\fR.
\fIArgs\fR will point to an array of \fInumArgs\fR Tcl_Value structures,
which describe the actual arguments to the function:
.PP
.CS
typedef struct Tcl_Value {
Tcl_ValueType \fItype\fR;
long \fIintValue\fR;
double \fIdoubleValue\fR;
Tcl_WideInt \fIwideValue\fR;
} \fBTcl_Value\fR;
.CE
.PP
The \fItype\fR field indicates the type of the argument and is
one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR.
It will match the \fIargTypes\fR value specified for the function unless
the \fIargTypes\fR value was \fBTCL_EITHER\fR. Tcl converts
the argument supplied in the expression to the type requested in
\fIargTypes\fR, if that is necessary.
Depending on the value of the \fItype\fR field, the \fIintValue\fR,
\fIdoubleValue\fR or \fIwideValue\fR
field will contain the actual value of the argument.
.PP
\fIProc\fR should compute its result and store it either as an integer
in \fIresultPtr->intValue\fR or as a floating value in
\fIresultPtr->doubleValue\fR.
It should set also \fIresultPtr->type\fR to one of
\fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR
to indicate which value was set.
Under normal circumstances \fIproc\fR should return \fBTCL_OK\fR.
If an error occurs while executing the function, \fIproc\fR should
return \fBTCL_ERROR\fR and leave an error message in the interpreter's result.
.PP
\fBTcl_GetMathFuncInfo\fR retrieves the values associated with
function \fIname\fR that were passed to a preceding
\fBTcl_CreateMathFunc\fR call. Normally, the return code is
\fBTCL_OK\fR but if the named function does not exist, \fBTCL_ERROR\fR
is returned and an error message is placed in the interpreter's
result.
.PP
If an error did not occur, the array reference placed in the variable
pointed to by \fIargTypesPtr\fR is newly allocated, and should be
released by passing it to \fBTcl_Free\fR. Some functions (the
standard set implemented in the core, and those defined by placing
commands in the \fBtcl::mathfunc\fR namespace) do not have
argument type information; attempting to retrieve values for
them causes a NULL to be stored in the variable pointed to by
\fIprocPtr\fR and the variable pointed to by \fIclientDataPtr\fR
will not be modified. The variable pointed to by \fInumArgsPointer\fR
will contain -1, and no argument types will be stored in the variable
pointed to by \fIargTypesPointer\fR.
.PP
\fBTcl_ListMathFuncs\fR returns a Tcl value containing a list of all
the math functions defined in the interpreter whose name matches
\fIpattern\fR. The returned value has a reference count of zero.
.SH "SEE ALSO"
expr(n), info(n), Tcl_CreateObjCommand(3), Tcl_Free(3), Tcl_NewListObj(3)
.SH KEYWORDS
expression, mathematical function
+1 -7
View File
@@ -9,7 +9,7 @@
.so man.macros
.BS
.SH NAME
Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringTrunc, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings
Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -34,8 +34,6 @@ char *
.sp
\fBTcl_DStringSetLength\fR(\fIdsPtr, newLength\fR)
.sp
\fBTcl_DStringTrunc\fR(\fIdsPtr, newLength\fR)
.sp
\fBTcl_DStringFree\fR(\fIdsPtr\fR)
.sp
\fBTcl_DStringResult\fR(\fIinterp, dsPtr\fR)
@@ -128,10 +126,6 @@ caller to fill in the new space.
even if the string is truncated to zero length, so \fBTcl_DStringFree\fR
will still need to be called.
.PP
\fBTcl_DStringTrunc\fR changes the length of a dynamic string.
This procedure is now deprecated. \fBTcl_DStringSetLength\fR should
be used instead.
.PP
\fBTcl_DStringFree\fR should be called when you are finished using
the string. It frees up any memory that was allocated for the string
and reinitializes the string's value to an empty string.
+2 -17
View File
@@ -8,7 +8,7 @@
.so man.macros
.BS
.SH NAME
Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_WinTCharToUtf, Tcl_WinUtfToTChar, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath, Tcl_GetDefaultEncodingDir, Tcl_SetDefaultEncodingDir \- procedures for creating and using encodings
Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_WinTCharToUtf, Tcl_WinUtfToTChar, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath \- procedures for creating and using encodings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -62,12 +62,6 @@ Tcl_Obj *
.sp
int
\fBTcl_SetEncodingSearchPath\fR(\fIsearchPath\fR)
.sp
const char *
\fBTcl_GetDefaultEncodingDir\fR(\fIvoid\fR)
.sp
void
\fBTcl_SetDefaultEncodingDir\fR(\fIpath\fR)
.SH ARGUMENTS
.AS "const Tcl_EncodingType" *dstWrotePtr in/out
.AP Tcl_Interp *interp in
@@ -287,7 +281,7 @@ the encoding name to it. The \fBTcl_DStringValue\fR is returned.
\fBTcl_GetEncodingNames\fR sets the \fIinterp\fR result to a list
consisting of the names of all the encodings that are currently defined
or can be dynamically loaded, searching the encoding path specified by
\fBTcl_SetDefaultEncodingDir\fR. This procedure does not ensure that the
\fBTcl_SetEncodingSearchPath\fR. This procedure does not ensure that the
dynamically-loadable encoding files contain valid data, but merely that they
exist.
.PP
@@ -402,15 +396,6 @@ are not verified as existing readable filesystem directories. When
searching for encoding data files takes place, and non-existent or
non-readable filesystem directories on the \fIsearchPath\fR are silently
ignored.
.PP
\fBTcl_GetDefaultEncodingDir\fR and \fBTcl_SetDefaultEncodingDir\fR
are obsolete interfaces best replaced with calls to
\fBTcl_GetEncodingSearchPath\fR and \fBTcl_SetEncodingSearchPath\fR.
They are called to access and set the first element of the \fIsearchPath\fR
list. Since Tcl searches \fIsearchPath\fR for encoding data files in
list order, these routines establish the
.QW default
directory in which to find encoding data files.
.SH "ENCODING FILES"
Space would prohibit precompiling into Tcl every possible encoding
algorithm, so many encodings are stored on disk as dynamically-loadable
+3 -19
View File
@@ -10,7 +10,7 @@
.so man.macros
.BS
.SH NAME
Tcl_EvalObjEx, Tcl_EvalFile, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx, Tcl_GlobalEval, Tcl_GlobalEvalObj, Tcl_VarEval, Tcl_VarEvalVA \- execute Tcl scripts
Tcl_EvalObjEx, Tcl_EvalFile, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx, Tcl_GlobalEval, Tcl_GlobalEvalObj, Tcl_VarEval \- execute Tcl scripts
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -38,9 +38,6 @@ int
.sp
int
\fBTcl_VarEval\fR(\fIinterp, part, part, ... \fB(char *) NULL\fR)
.sp
int
\fBTcl_VarEvalVA\fR(\fIinterp, argList\fR)
.SH ARGUMENTS
.AS Tcl_Interp **termPtr
.AP Tcl_Interp *interp in
@@ -67,9 +64,6 @@ first null byte are used.
Points to first byte of script to execute (null-terminated and UTF-8).
.AP char *part in
String forming part of a Tcl script.
.AP va_list argList in
An argument list which must have been initialized using
\fBva_start\fR, and cleared using \fBva_end\fR.
.BE
.SH DESCRIPTION
@@ -128,16 +122,10 @@ might be a UTF-8 special code. The string is parsed and executed directly
bytecodes. In situations where it is known that the script will never be
executed again, \fBTcl_Eval\fR may be faster than \fBTcl_EvalObjEx\fR.
\fBTcl_Eval\fR returns a completion code and result just like
\fBTcl_EvalObjEx\fR. Note: for backward compatibility with versions before
Tcl 8.0, \fBTcl_Eval\fR copies the value result in \fIinterp\fR to
\fIinterp->result\fR (use is deprecated) where it can be accessed directly.
This makes \fBTcl_Eval\fR somewhat slower than \fBTcl_EvalEx\fR, which
does not do the copy.
\fBTcl_EvalObjEx\fR.
.PP
\fBTcl_EvalEx\fR is an extended version of \fBTcl_Eval\fR that takes
additional arguments \fInumBytes\fR and \fIflags\fR. For the
efficiency reason given above, \fBTcl_EvalEx\fR is generally preferred
over \fBTcl_Eval\fR.
additional arguments \fInumBytes\fR and \fIflags\fR.
.PP
\fBTcl_GlobalEval\fR and \fBTcl_GlobalEvalObj\fR are older procedures
that are now deprecated. They are similar to \fBTcl_EvalEx\fR and
@@ -153,10 +141,6 @@ It returns the result of the command and also modifies
\fIinterp->result\fR in the same way as \fBTcl_Eval\fR.
The last argument to \fBTcl_VarEval\fR must be NULL to indicate the end
of arguments. \fBTcl_VarEval\fR is now deprecated.
.PP
\fBTcl_VarEvalVA\fR is the same as \fBTcl_VarEval\fR except that
instead of taking a variable number of arguments it takes an argument
list. Like \fBTcl_VarEval\fR, \fBTcl_VarEvalVA\fR is deprecated.
.SH "FLAG BITS"
.PP
+2 -5
View File
@@ -64,12 +64,9 @@ if the first such characters are
then \fIsrc\fR is expected to be in octal form; otherwise,
if the first such characters are
.QW \fB0b\fR
then \fIsrc\fR is expected to be in binary form; otherwise,
if the first such character is
.QW \fB0\fR
then \fIsrc\fR
is expected to be in octal form; otherwise, \fIsrc\fR
is expected to be in decimal form.
is expected to be in binary form; otherwise, \fIsrc\fR is
expected to be in decimal form.
.PP
\fBTcl_GetDouble\fR expects \fIsrc\fR to consist of a floating-point
number, which is: white space; a sign; a sequence of digits; a
+3 -3
View File
@@ -63,9 +63,9 @@ Define the \fBUSE_TCL_STUBS\fR symbol. Typically, you would include the
\fB\-DUSE_TCL_STUBS\fR flag when compiling the extension.
.IP 3) 5
Link the extension with the Tcl stubs library instead of the standard
Tcl library. For example, to use the Tcl 8.6 ABI on Unix platforms,
the library name is \fIlibtclstub8.6.a\fR; on Windows platforms, the
library name is \fItclstub86.lib\fR.
Tcl library. For example, to use the Tcl 9.0 ABI on Unix platforms,
the library name is \fIlibtclstub9.0.a\fR; on Windows platforms, the
library name is \fItclstub90.lib\fR.
.PP
If the extension also requires the Tk API, it must also call
\fBTk_InitStubs\fR to initialize the Tk stubs interface and link
-13
View File
@@ -33,19 +33,6 @@ the pointer as described below is no longer supported. The supported
public routines \fBTcl_SetResult\fR, \fBTcl_GetResult\fR,
\fBTcl_SetErrorLine\fR, \fBTcl_GetErrorLine\fR must be used instead.
.PP
For legacy programs and extensions no longer being maintained, compiles
against the Tcl 8.6 header files are only possible with the compiler
directives
.CS
#define USE_INTERP_RESULT
.CE
and/or
.CS
#define USE_INTERP_ERRORLINE
.CE
depending on which fields of the \fBTcl_Interp\fR struct are accessed.
These directives may be embedded in code or supplied via compiler options.
.PP
The \fIresult\fR and \fIfreeProc\fR fields are used to return
results or error messages from commands.
This information is returned by command procedures back to \fBTcl_Eval\fR,
+13 -31
View File
@@ -9,18 +9,18 @@
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
Tcl_ClassSetConstructor, Tcl_ClassSetDestructor, Tcl_MethodDeclarerClass, Tcl_MethodDeclarerObject, Tcl_MethodIsPublic, Tcl_MethodIsPrivate, Tcl_MethodIsType, Tcl_MethodName, Tcl_NewInstanceMethod, Tcl_NewMethod, Tcl_ObjectContextInvokeNext, Tcl_ObjectContextIsFiltering, Tcl_ObjectContextMethod, Tcl_ObjectContextObject, Tcl_ObjectContextSkippedArgs \- manipulate methods and method-call contexts
Tcl_ClassSetConstructor, Tcl_ClassSetDestructor, Tcl_MethodDeclarerClass, Tcl_MethodDeclarerObject, Tcl_MethodIsPublic, Tcl_MethodIsType, Tcl_MethodName, Tcl_NewInstanceMethod, Tcl_NewMethod, Tcl_ObjectContextInvokeNext, Tcl_ObjectContextIsFiltering, Tcl_ObjectContextMethod, Tcl_ObjectContextObject, Tcl_ObjectContextSkippedArgs \- manipulate methods and method-call contexts
.SH SYNOPSIS
.nf
\fB#include <tclOO.h>\fR
.sp
Tcl_Method
\fBTcl_NewMethod\fR(\fIinterp, class, nameObj, flags, methodTypePtr,
clientData\fR)
\fBTcl_NewMethod\fR(\fIinterp, class, nameObj, isPublic,
methodTypePtr, clientData\fR)
.sp
Tcl_Method
\fBTcl_NewInstanceMethod\fR(\fIinterp, object, nameObj, flags, methodTypePtr,
clientData\fR)
\fBTcl_NewInstanceMethod\fR(\fIinterp, object, nameObj, isPublic,
methodTypePtr, clientData\fR)
.sp
\fBTcl_ClassSetConstructor\fR(\fIinterp, class, method\fR)
.sp
@@ -35,13 +35,8 @@ Tcl_Object
Tcl_Obj *
\fBTcl_MethodName\fR(\fImethod\fR)
.sp
.VS TIP500
int
\fBTcl_MethodIsPublic\fR(\fImethod\fR)
.VE TIP500
.sp
int
\fBTcl_MethodIsPrivate\fR(\fImethod\fR)
.sp
int
\fBTcl_MethodIsType\fR(\fImethod, methodTypePtr, clientDataPtr\fR)
@@ -71,15 +66,10 @@ The class to create the method in.
.AP Tcl_Obj *nameObj in
The name of the method to create. Should not be NULL unless creating
constructors or destructors.
.AP int flags in
A flag saying (currently) what the visibility of the method is. The supported
public values of this flag are \fBTCL_OO_METHOD_PUBLIC\fR (which is fixed at 1
for backward compatibility) for an exported method,
\fBTCL_OO_METHOD_UNEXPORTED\fR (which is fixed at 0 for backward
compatibility) for a non-exported method,
.VS TIP500
and \fBTCL_OO_METHOD_PRIVATE\fR for a private method.
.VE TIP500
.AP int isPublic in
A flag saying what the visibility of the method is. The only supported public
values of this flag are 0 for a non-exported method, and 1 for an exported
method.
.AP Tcl_MethodType *methodTypePtr in
A description of the type of the method to create, or the type of method to
compare against.
@@ -115,12 +105,8 @@ Given a method, the entity that declared it can be found using
attached to (or NULL if the method is not attached to any class) and
\fBTcl_MethodDeclarerObject\fR which returns the object that the method is
attached to (or NULL if the method is not attached to an object). The name of
the method can be retrieved with \fBTcl_MethodName\fR, whether the method
is exported is retrieved with \fBTcl_MethodIsPublic\fR,
.VS TIP500
and whether the method is private is retrieved with \fBTcl_MethodIsPrivate\fR.
.VE TIP500
The type of the method
the method can be retrieved with \fBTcl_MethodName\fR and whether the method
is exported is retrieved with \fBTcl_MethodIsPublic\fR. The type of the method
can also be introspected upon to a limited degree; the function
\fBTcl_MethodIsType\fR returns whether a method is of a particular type,
assigning the per-method \fIclientData\fR to the variable pointed to by
@@ -131,12 +117,8 @@ Methods are created by \fBTcl_NewMethod\fR and \fBTcl_NewInstanceMethod\fR,
which
create a method attached to a class or an object respectively. In both cases,
the \fInameObj\fR argument gives the name of the method to create, the
\fIflags\fR argument states whether the method should be exported
initially
.VS TIP500
or be marked as a private method,
.VE TIP500
the \fImethodTypePtr\fR argument describes the implementation of
\fIisPublic\fR argument states whether the method should be exported
initially, the \fImethodTypePtr\fR argument describes the implementation of
the method (see the \fBMETHOD TYPES\fR section below) and the \fIclientData\fR
argument gives some implementation-specific data that is passed on to the
implementation of the method when it is called.
+1 -18
View File
@@ -7,7 +7,7 @@
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc, Tcl_ConsolePanic \- report fatal error and abort
Tcl_Panic, Tcl_SetPanicProc \- report fatal error and abort
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -16,14 +16,8 @@ void
\fBTcl_Panic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR)
.sp
void
\fBTcl_PanicVA\fR(\fIformat\fR, \fIargList\fR)
.sp
void
\fBTcl_SetPanicProc\fR(\fIpanicProc\fR)
.sp
void
\fBTcl_ConsolePanic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR)
.sp
.SH ARGUMENTS
.AS Tcl_PanicProc *panicProc
.AP "const char*" format in
@@ -57,14 +51,6 @@ message is sent to the debugger in stead. If the windows executable
does not have a stderr channel (e.g. \fBwish.exe\fR), then a
system dialog box is used to display the panic message.
.PP
If your application doesn't use \fBTcl_Main\fR or \fBTk_Main\fR
and you want to implicitly use the stderr channel of your
application's C runtime (in stead of the stderr channel of the
C runtime used by Tcl), you can call \fBTcl_SetPanicProc\fR
with \fBTcl_ConsolePanic\fR as its argument. On platforms which
only have one C runtime (almost all platforms except Windows)
\fBTcl_ConsolePanic\fR is equivalent to NULL.
.PP
\fBTcl_SetPanicProc\fR may be used to modify the behavior of
\fBTcl_Panic\fR. The \fIpanicProc\fR argument should match the
type \fBTcl_PanicProc\fR:
@@ -91,9 +77,6 @@ the Tcl library, \fBTcl_Panic\fR is a public function and may be called
by any extension or application that wishes to abort the process and
have a panic message displayed the same way that panic messages from Tcl
will be displayed.
.PP
\fBTcl_PanicVA\fR is the same as \fBTcl_Panic\fR except that instead of
taking a variable number of arguments it takes an argument list.
.SH "SEE ALSO"
abort(3), printf(3), exec(n), format(n)
.SH KEYWORDS
+5 -19
View File
@@ -8,7 +8,7 @@
.so man.macros
.BS
.SH NAME
Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokens, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions
Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -33,20 +33,16 @@ const char *
.sp
\fBTcl_FreeParse\fR(\fIusedParsePtr\fR)
.sp
Tcl_Obj *
\fBTcl_EvalTokens\fR(\fIinterp, tokenPtr, numTokens\fR)
.sp
int
\fBTcl_EvalTokensStandard\fR(\fIinterp, tokenPtr, numTokens\fR)
.SH ARGUMENTS
.AS Tcl_Interp *usedParsePtr out
.AP Tcl_Interp *interp out
For procedures other than \fBTcl_FreeParse\fR, \fBTcl_EvalTokens\fR
and \fBTcl_EvalTokensStandard\fR, used only for error reporting;
For procedures other than \fBTcl_FreeParse\fR and
\fBTcl_EvalTokensStandard\fR, used only for error reporting;
if NULL, then no error messages are left after errors.
For \fBTcl_EvalTokens\fR and \fBTcl_EvalTokensStandard\fR,
determines the context for evaluating the
script and also is used for error reporting; must not be NULL.
For \fBTcl_EvalTokensStandard\fR, determines the context for evaluating
the script and also is used for error reporting; must not be NULL.
.AP "const char" *start in
Pointer to first character in string to parse.
.AP int numBytes in
@@ -191,16 +187,6 @@ code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR,
some other integer value originating in an extension.
In addition, a result value or error message is left in \fIinterp\fR's
result; it can be retrieved using \fBTcl_GetObjResult\fR.
.PP
\fBTcl_EvalTokens\fR differs from \fBTcl_EvalTokensStandard\fR only in
the return convention used: it returns the result in a new Tcl_Obj.
The reference count of the value returned as result has been
incremented, so the caller must
invoke \fBTcl_DecrRefCount\fR when it is finished with the value.
If an error or other exception occurs while evaluating the tokens
(such as a reference to a non-existent variable) then the return value
is NULL and an error message is left in \fIinterp\fR's result. The use
of \fBTcl_EvalTokens\fR is deprecated.
.SH "TCL_PARSE STRUCTURE"
.PP
\fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR,
+2 -7
View File
@@ -18,10 +18,7 @@ Tcl_PrintDouble \- Convert floating value to string
.SH ARGUMENTS
.AS Tcl_Interp *interp out
.AP Tcl_Interp *interp in
Before Tcl 8.0, the \fBtcl_precision\fR variable in this interpreter
controlled the conversion. As of Tcl 8.0, this argument is ignored and
the conversion is controlled by the \fBtcl_precision\fR variable
that is now shared by all interpreters.
This argument is ignored.
.AP double value in
Floating-point value to be converted.
.AP char *dst out
@@ -41,9 +38,7 @@ so that it does not look like an integer. Where \fB%g\fR would
generate an integer with no decimal point, \fBTcl_PrintDouble\fR adds
.QW .0 .
.PP
If the \fBtcl_precision\fR value is non-zero, the result will have
precisely that many digits of significance. If the value is zero
(the default), the result will have the fewest digits needed to
The result will have the fewest digits needed to
represent the number in such a way that \fBTcl_NewDoubleObj\fR
will generate the same number when presented with the given string.
IEEE semantics of rounding to even apply to the conversion.
+1 -1
View File
@@ -31,7 +31,7 @@ the command at global level instead of the current stack level.
.SH DESCRIPTION
.PP
\fBTcl_RecordAndEvalObj\fR is invoked to record a command as an event
on the history list and then execute it using \fBTcl_EvalObjEx\fR
on the history list and then execute it using \fBTcl_EvalObjEx\fR.
It returns a completion code such as \fBTCL_OK\fR just like \fBTcl_EvalObjEx\fR,
as well as a result value containing additional information
(a result value or error message)
+1 -1
View File
@@ -29,7 +29,7 @@ New limit for nested calls to \fBTcl_Eval\fR for \fIinterp\fR.
.PP
At any given time Tcl enforces a limit on the number of recursive
calls that may be active for \fBTcl_Eval\fR and related procedures
such as \fBTcl_GlobalEval\fR.
such as \fBTcl_EvalEx\fR.
Any call to \fBTcl_Eval\fR that exceeds this depth is aborted with
an error.
By default the recursion limit is 1000.
+1 -19
View File
@@ -9,7 +9,7 @@
.so man.macros
.BS
.SH NAME
Tcl_SetObjResult, Tcl_GetObjResult, Tcl_SetResult, Tcl_GetStringResult, Tcl_AppendResult, Tcl_AppendResultVA, Tcl_AppendElement, Tcl_ResetResult, Tcl_TransferResult, Tcl_FreeResult \- manipulate Tcl result
Tcl_SetObjResult, Tcl_GetObjResult, Tcl_SetResult, Tcl_GetStringResult, Tcl_AppendResult, Tcl_AppendElement, Tcl_ResetResult, Tcl_TransferResult, Tcl_FreeResult \- manipulate Tcl result
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -26,8 +26,6 @@ const char *
.sp
\fBTcl_AppendResult\fR(\fIinterp, result, result, ... , \fB(char *) NULL\fR)
.sp
\fBTcl_AppendResultVA\fR(\fIinterp, argList\fR)
.sp
\fBTcl_ResetResult\fR(\fIinterp\fR)
.sp
.VS 8.6
@@ -152,9 +150,6 @@ extensions.
Any number of \fIresult\fR arguments may be passed in a single
call; the last argument in the list must be a NULL pointer.
.PP
\fBTcl_AppendResultVA\fR is the same as \fBTcl_AppendResult\fR except that
instead of taking a variable number of arguments it takes an argument list.
.PP
.VS 8.6
\fBTcl_TransferResult\fR moves a result from one interpreter to another,
optionally (dependent on the \fIresult\fR parameter) including the error
@@ -197,19 +192,6 @@ It also sets \fIinterp->freeProc\fR to zero, but does not
change \fIinterp->result\fR or clear error state.
\fBTcl_FreeResult\fR is most commonly used when a procedure
is about to replace one result value with another.
.SS "DIRECT ACCESS TO INTERP->RESULT"
.PP
It used to be legal for programs to
directly read and write \fIinterp->result\fR
to manipulate the interpreter result. The Tcl headers no longer
permit this access by default, and C code still doing this must
be updated to use supported routines \fBTcl_GetObjResult\fR,
\fBTcl_GetStringResult\fR, \fBTcl_SetObjResult\fR, and \fBTcl_SetResult\fR.
As a migration aid, access can be restored with the compiler directive
.CS
#define USE_INTERP_RESULT
.CE
but this is meant only to offer life support to otherwise dead code.
.SH "THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT"
.PP
\fBTcl_SetResult\fR's \fIfreeProc\fR argument specifies how
+1 -8
View File
@@ -8,7 +8,7 @@
.so man.macros
.BS
.SH NAME
Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendStringsToObjVA, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj \- manipulate Tcl values as strings
Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj \- manipulate Tcl values as strings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -59,9 +59,6 @@ void
\fBTcl_AppendStringsToObj\fR(\fIobjPtr, string, string, ... \fB(char *) NULL\fR)
.sp
void
\fBTcl_AppendStringsToObjVA\fR(\fIobjPtr, argList\fR)
.sp
void
\fBTcl_AppendLimitedToObj\fR(\fIobjPtr, bytes, length, limit, ellipsis\fR)
.sp
Tcl_Obj *
@@ -247,10 +244,6 @@ values may contain internal null characters). Any number of
\fIstring\fR arguments may be provided, but the last argument
must be a NULL pointer to indicate the end of the list.
.PP
\fBTcl_AppendStringsToObjVA\fR is the same as \fBTcl_AppendStringsToObj\fR
except that instead of taking a variable number of arguments it takes an
argument list.
.PP
\fBTcl_AppendLimitedToObj\fR is similar to \fBTcl_AppendToObj\fR
except that it imposes a limit on how many bytes are appended.
This can be handy when the string to be appended might be
-60
View File
@@ -1,60 +0,0 @@
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH case n 7.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
case \- Evaluate one of several scripts, depending on a given value
.SH SYNOPSIS
\fBcase\fI string \fR?\fBin\fR? \fIpatList body \fR?\fIpatList body \fR...?
.sp
\fBcase\fI string \fR?\fBin\fR? {\fIpatList body \fR?\fIpatList body \fR...?}
.BE
.SH DESCRIPTION
.PP
\fINote: the \fBcase\fI command is obsolete and is supported only
for backward compatibility. At some point in the future it may be
removed entirely. You should use the \fBswitch\fI command instead.\fR
.PP
The \fBcase\fR command matches \fIstring\fR against each of
the \fIpatList\fR arguments in order.
Each \fIpatList\fR argument is a list of one or
more patterns. If any of these patterns matches \fIstring\fR then
\fBcase\fR evaluates the following \fIbody\fR argument
by passing it recursively to the Tcl interpreter and returns the result
of that evaluation.
Each \fIpatList\fR argument consists of a single
pattern or list of patterns. Each pattern may contain any of the wild-cards
described under \fBstring match\fR. If a \fIpatList\fR
argument is \fBdefault\fR, the corresponding body will be evaluated
if no \fIpatList\fR matches \fIstring\fR. If no \fIpatList\fR argument
matches \fIstring\fR and no default is given, then the \fBcase\fR
command returns an empty string.
.PP
Two syntaxes are provided for the \fIpatList\fR and \fIbody\fR arguments.
The first uses a separate argument for each of the patterns and commands;
this form is convenient if substitutions are desired on some of the
patterns or commands.
The second form places all of the patterns and commands together into
a single argument; the argument must have proper list structure, with
the elements of the list being the patterns and commands.
The second form makes it easy to construct multi-line case commands,
since the braces around the whole list make it unnecessary to include a
backslash at the end of each line.
Since the \fIpatList\fR arguments are in braces in the second form,
no command or variable substitutions are performed on them; this makes
the behavior of the second form different than the first form in some
cases.
.SH "SEE ALSO"
switch(n)
.SH KEYWORDS
case, match, regular expression
+37 -124
View File
@@ -82,14 +82,17 @@ by a superclass; subclass exports override superclass visibility, and may in
turn be overridden by instances.
.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.
.VS
This slot (see \fBSLOTTED DEFINITIONS\fR below)
.VE
sets or updates the list of method names that are used to guard whether
method call to instances of the class may be called and what the method's
results are. Each \fImethodName\fR names a single filtering method (which may
be exposed or not exposed); it is not an error for a non-existent method to be
named since they may be defined by subclasses.
.VS
By default, this slot works by appending.
.VE
.TP
\fBforward\fI name cmdName \fR?\fIarg ...\fR?
.
@@ -102,13 +105,6 @@ fully-qualified, the command will be searched for in each object's namespace,
using the instances' namespace's path, or by looking in the global namespace.
The method will be exported if \fIname\fR starts with a lower-case letter, and
non-exported otherwise.
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this command creates private forwarded methods.
.VE TIP500
.RE
.TP
\fBmethod\fI name argList bodyScript\fR
.
@@ -121,40 +117,17 @@ be a namespace that is unique to the current object. The method will be
exported if \fIname\fR starts with a lower-case letter, and non-exported
otherwise; this behavior can be overridden via \fBexport\fR and
\fBunexport\fR.
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this command creates private procedure-like methods.
.VE TIP500
.RE
.TP
\fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
.
.VS
This slot (see \fBSLOTTED DEFINITIONS\fR below)
.VE
sets or updates the list of additional classes that are to be mixed into
all the instances of the class being defined. Each \fIclassName\fR argument
names a single class that is to be mixed in.
.VS
By default, this slot works by replacement.
.TP
\fBprivate \fIcmd arg...\fR
.TP
\fBprivate \fIscript\fR
.
.VS TIP500
This evaluates the \fIscript\fR (or the list of command and arguments given by
\fIcmd\fR and \fIarg\fRs) in a context where the definitions made on the
current class will be private definitions.
.RS
.PP
The following class definition commands are affected by \fBprivate\fR:
\fBforward\fR, \fBmethod\fR, \fBself\fR, and \fBvariable\fR. Nesting
\fBprivate\fR inside \fBprivate\fR has no cumulative effect; the innermost
definition context is just a private definition context. All other definition
commands have no difference in behavior when used in a private definition
context.
.RE
.VE TIP500
.VE
.TP
\fBrenamemethod\fI fromName toName\fR
.
@@ -186,23 +159,21 @@ operates identically to
If no arguments at all are used, this gives the name of the class currently
being configured.
.VE TIP470
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), the definitions on the class object will also be made in a private
definition context.
.VE TIP500
.RE
.TP
\fBsuperclass\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
.
.VS
This slot (see \fBSLOTTED DEFINITIONS\fR below)
.VE
allows the alteration of the superclasses of the class being defined.
Each \fIclassName\fR argument names one class that is to be a superclass of
the defined class. Note that objects must not be changed from being classes to
being non-classes or vice-versa, that an empty parent class is equivalent to
\fBoo::object\fR, and that the parent classes of \fBoo::object\fR and
\fBoo::class\fR may not be modified.
.VS
By default, this slot works by replacement.
.VE
.TP
\fBunexport\fI name \fR?\fIname ...\fR?
.
@@ -214,31 +185,18 @@ actually defined by a superclass; subclass unexports override superclass
visibility, and may be overridden by instance unexports.
.TP
\fBvariable\fR ?\fI\-slotOperation\fR? ?\fIname ...\fR?
.
.VS
This slot (see \fBSLOTTED DEFINITIONS\fR below) arranges for each of the named
variables to be automatically made
available in the methods, constructor and destructor declared by the class
being defined. Each variable name must not have any namespace
separators and must not look like an array access. All variables will be
actually present in the namespace of the instance object on which the method
is executed. Note
actually present in the instance object on which the method is executed. Note
that the variable lists declared by a superclass or subclass are completely
disjoint, as are variable lists declared by instances; the list of variable
names is just for methods (and constructors and destructors) declared by this
class. By default, this slot works by appending.
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this slot manipulates the list of private variable bindings for this
class. In a private variable binding, the name of the variable within the
instance object is different to the name given in the definition; the name
used in the definition is the name that you use to access the variable within
the methods of this class, and the name of the variable in the instance
namespace has a unique prefix that makes accidental use from other classes
extremely unlikely.
.VE TIP500
.RE
.VE
.SS "CONFIGURING OBJECTS"
.PP
The following commands are supported in the \fIdefScript\fR for
@@ -265,15 +223,18 @@ being defined. Note that the methods themselves may be actually defined by a
class or superclass; object exports override class visibility.
.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.
.VS
This slot (see \fBSLOTTED DEFINITIONS\fR below)
.VE
sets or updates the list of method names that are used to guard whether a
method call to the object may be called and what the method's results are.
Each \fImethodName\fR names a single filtering method (which may be exposed or
not exposed); it is not an error for a non-existent method to be named. Note
that the actual list of filters also depends on the filters set upon any
classes that the object is an instance of.
.VS
By default, this slot works by appending.
.VE
.TP
\fBforward\fI name cmdName \fR?\fIarg ...\fR?
.
@@ -283,13 +244,6 @@ additional arguments, \fIarg\fR etc., added before those arguments specified
by the caller of the method. Forwarded methods should be deleted using the
\fBmethod\fR subcommand. The method will be exported if \fIname\fR starts with
a lower-case letter, and non-exported otherwise.
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this command creates private forwarded methods.
.VE TIP500
.RE
.TP
\fBmethod\fI name argList bodyScript\fR
.
@@ -300,38 +254,17 @@ method will be \fIbodyScript\fR. When the body of the method is evaluated, the
current namespace of the method will be a namespace that is unique to the
object. The method will be exported if \fIname\fR starts with a lower-case
letter, and non-exported otherwise.
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this command creates private procedure-like methods.
.VE TIP500
.RE
.TP
\fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
.
.VS
This slot (see \fBSLOTTED DEFINITIONS\fR below)
.VE
sets or updates a per-object list of additional classes that are to be
mixed into the object. Each argument, \fIclassName\fR, names a single class
that is to be mixed in.
.VS
By default, this slot works by replacement.
.TP
\fBprivate \fIcmd arg...\fR
.TP
\fBprivate \fIscript\fR
.VS TIP500
This evaluates the \fIscript\fR (or the list of command and arguments given by
\fIcmd\fR and \fIarg\fRs) in a context where the definitions made on the
current object will be private definitions.
.RS
.PP
The following class definition commands are affected by \fBprivate\fR:
\fBforward\fR, \fBmethod\fR, and \fBvariable\fR. Nesting \fBprivate\fR inside
\fBprivate\fR has no cumulative effect; the innermost definition context is
just a private definition context. All other definition commands have no
difference in behavior when used in a private definition context.
.RE
.VE TIP500
.VE
.TP
\fBrenamemethod\fI fromName toName\fR
.
@@ -342,6 +275,7 @@ that the object is an instance of. Does not change the export status of the
method; if it was exported before, it will be afterwards.
.TP
\fBself \fR
.
.VS TIP470
This gives the name of the object currently being configured.
.VE TIP470
@@ -355,42 +289,15 @@ object being defined. Note that the methods themselves may be actually defined
by a class; instance unexports override class visibility.
.TP
\fBvariable\fR ?\fI\-slotOperation\fR? ?\fIname ...\fR?
.
.VS
This slot (see \fBSLOTTED DEFINITIONS\fR below) arranges for each of the named
variables to be automatically made available in the methods declared by the
object being defined. Each variable name must not have any namespace
separators and must not look like an array access. All variables will be
actually present in the namespace of the object on which the method is
executed. Note that the
actually present in the object on which the method is executed. Note that the
variable lists declared by the classes and mixins of which the object is an
instance are completely disjoint; the list of variable names is just for
methods declared by this object. By default, this slot works by appending.
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this slot manipulates the list of private variable bindings for this
object. In a private variable binding, the name of the variable within the
instance object is different to the name given in the definition; the name
used in the definition is the name that you use to access the variable within
the methods of this instance object, and the name of the variable in the
instance namespace has a unique prefix that makes accidental use from
superclass methods extremely unlikely.
.VE TIP500
.RE
.SH "PRIVATE METHODS"
.VS TIP500
When a class or instance has a private method, that private method can only be
invoked from within methods of that class or instance. Other callers of the
object's methods \fIcannot\fR invoke private methods, it is as if the private
methods do not exist. However, a private method of a class \fIcan\fR be
invoked from the class's methods when those methods are being used on another
instance object; this means that a class can use them to coordinate behaviour
between several instances of itself without interfering with how other
classes (especially either subclasses or superclasses) interact. Private
methods precede all mixed in classes in the method call order (as reported by
\fBself call\fR).
.VE TIP500
.SH "SLOTTED DEFINITIONS"
Some of the configurable definitions of a class or object are \fIslotted
definitions\fR. This means that the configuration is implemented by a slot
@@ -398,17 +305,20 @@ object, that is an instance of the class \fBoo::Slot\fR, which manages a list
of values (class names, variable names, etc.) that comprises the contents of
the slot. The class defines three operations (as methods) that may be done on
the slot:
.VE
.TP
\fIslot\fR \fB\-append\fR ?\fImember ...\fR?
.
.VS
This appends the given \fImember\fR elements to the slot definition.
.VE
.TP
\fIslot\fR \fB\-clear\fR
.
.VS
This sets the slot definition to the empty list.
.VE
.TP
\fIslot\fR \fB\-set\fR ?\fImember ...\fR?
.
.VS
This replaces the slot definition with the given \fImember\fR elements.
.PP
A consequence of this is that any use of a slot's default operation where the
@@ -421,15 +331,17 @@ which is forwarded to the default operation of the slot (thus, for the class
slot, this is forwarded to
.QW "\fBmy \-append\fR" ),
and these methods which provide the implementation interface:
.VE
.TP
\fIslot\fR \fBGet\fR
.
.VS
Returns a list that is the current contents of the slot. This method must
always be called from a stack frame created by a call to \fBoo::define\fR or
\fBoo::objdefine\fR.
.VE
.TP
\fIslot\fR \fBSet \fIelementList\fR
.
.VS
Sets the contents of the slot to the list \fIelementList\fR and returns the
empty string. This method must always be called from a stack frame created by
a call to \fBoo::define\fR or \fBoo::objdefine\fR.
@@ -440,6 +352,7 @@ an unknown method handler to tie all these pieces together, and they hide
their \fBdestroy\fR method so that it is not invoked inadvertently. It is
\fIrecommended\fR that any user changes to the slot mechanism be restricted to
defining new operations whose names start with a hyphen.
.VE
.SH EXAMPLES
This example demonstrates how to use both forms of the \fBoo::define\fR and
\fBoo::objdefine\fR commands (they work in the same way), as well as
+1 -3
View File
@@ -50,9 +50,7 @@ An integer operand may be specified in decimal (the normal case, the optional
first two characters are \fB0d\fR), binary
(the first two characters are \fB0b\fR), octal
(the first two characters are \fB0o\fR), or hexadecimal
(the first two characters are \fB0x\fR) form. For
compatibility with older Tcl releases, an operand that begins with \fB0\fR is
interpreted as an octal integer even if the second character is not \fBo\fR.
(the first two characters are \fB0x\fR) form.
A floating-point number may be specified in any of several
common decimal formats, and may use the decimal point \fB.\fR,
\fBe\fR or \fBE\fR for scientific notation, and
+98 -152
View File
@@ -35,9 +35,10 @@ Returns the body of procedure \fIprocname\fR. \fIProcname\fR must be
the name of a Tcl command procedure.
.TP
\fBinfo class\fI subcommand class\fR ?\fIarg ...\fR
.
.VS 8.6
Returns information about the class, \fIclass\fR. The \fIsubcommand\fRs are
described in \fBCLASS INTROSPECTION\fR below.
.VE 8.6
.TP
\fBinfo cmdcount\fR
.
@@ -77,10 +78,11 @@ command is not complete, the script can delay evaluating it until additional
lines have been typed to complete the command.
.TP
\fBinfo coroutine\fR
.
.VS 8.6
Returns the name of the currently executing \fBcoroutine\fR, or the empty
string if either no coroutine is currently executing, or the current coroutine
has been deleted (but has not yet returned or yielded since deletion).
.VE 8.6
.TP
\fBinfo default \fIprocname arg varname\fR
.
@@ -91,7 +93,7 @@ Otherwise it returns \fB1\fR and places the default value of \fIarg\fR
into variable \fIvarname\fR.
.TP
\fBinfo errorstack \fR?\fIinterp\fR?
.
.VS 8.6
Returns, in a form that is programmatically easy to parse, the function names
and arguments at each level from the call stack of the last error in the given
\fIinterp\fR, or in the current one if not specified.
@@ -116,6 +118,7 @@ options dictionary returned by 3-argument \fBcatch\fR; \fBinfo errorstack\fR
is a convenient way of retrieving it for uncaught errors at top-level in an
interactive \fBtclsh\fR.
.RE
.VE 8.6
.TP
\fBinfo exists \fIvarName\fR
.
@@ -326,9 +329,10 @@ was invoked. If Tcl was unable to identify the file, then an empty
string is returned.
.TP
\fBinfo object\fI subcommand object\fR ?\fIarg ...\fR
.
.VS 8.6
Returns information about the object, \fIobject\fR. The \fIsubcommand\fRs are
described in \fBOBJECT INTROSPECTION\fR below.
.VE 8.6
.TP
\fBinfo patchlevel\fR
.
@@ -395,22 +399,20 @@ Note that a currently-visible variable may not yet
if it has not
been set (e.g. a variable declared but not set by \fBvariable\fR).
.SS "CLASS INTROSPECTION"
.VS 8.6
.PP
The following \fIsubcommand\fR values are supported by \fBinfo class\fR:
.VE 8.6
.TP
\fBinfo class call\fI class method\fR
.
.VS
Returns a description of the method implementations that are used to provide a
stereotypical instance of \fIclass\fR's implementation of \fImethod\fR
(stereotypical instances being objects instantiated by a class without having
any object-specific definitions added). This consists of a list of lists of
four elements, where each sublist consists of a word that describes the
general type of method implementation (being one of \fBmethod\fR for an
ordinary method, \fBfilter\fR for an applied filter,
.VS TIP500
\fBprivate\fR for a private method,
.VE TIP500
and \fBunknown\fR for a
ordinary method, \fBfilter\fR for an applied filter, and \fBunknown\fR for a
method that is invoked as part of unknown method handling), a word giving the
name of the particular method invoked (which is always the same as
\fImethod\fR for the \fBmethod\fR type, and
@@ -421,149 +423,122 @@ implementation (see \fBinfo class methodtype\fR).
.RS
.PP
Note that there is no inspection of whether the method implementations
actually use \fBnext\fR to transfer control along the call chain,
.VS TIP500
and the call chains that this command files do not actually contain private
methods.
.VE TIP500
actually use \fBnext\fR to transfer control along the call chain.
.RE
.VE 8.6
.TP
\fBinfo class constructor\fI class\fR
.
.VS 8.6
This subcommand returns a description of the definition of the constructor of
class \fIclass\fR. The definition is described as a two element list; the first
element is the list of arguments to the constructor in a form suitable for
passing to another call to \fBproc\fR or a method definition, and the second
element is the body of the constructor. If no constructor is present, this
returns the empty list.
.VE 8.6
.TP
\fBinfo class definition\fI class method\fR
.
.VS 8.6
This subcommand returns a description of the definition of the method named
\fImethod\fR of class \fIclass\fR. The definition is described as a two element
list; the first element is the list of arguments to the method in a form
suitable for passing to another call to \fBproc\fR or a method definition, and
the second element is the body of the method.
.VE 8.6
.TP
\fBinfo class destructor\fI class\fR
.
.VS 8.6
This subcommand returns the body of the destructor of class \fIclass\fR. If no
destructor is present, this returns the empty string.
.VE 8.6
.TP
\fBinfo class filters\fI class\fR
.
.VS 8.6
This subcommand returns the list of filter methods set on the class.
.VE 8.6
.TP
\fBinfo class forward\fI class method\fR
.
.VS 8.6
This subcommand returns the argument list for the method forwarding called
\fImethod\fR that is set on the class called \fIclass\fR.
.VE 8.6
.TP
\fBinfo class instances\fI class\fR ?\fIpattern\fR?
.
.VS 8.6
This subcommand returns a list of instances of class \fIclass\fR. If the
optional \fIpattern\fR argument is present, it constrains the list of returned
instances to those that match it according to the rules of \fBstring match\fR.
.VE 8.6
.TP
\fBinfo class methods\fI class\fR ?\fIoptions...\fR?
.
.VS 8.6
This subcommand returns a list of all public (i.e. exported) methods of the
class called \fIclass\fR. Any of the following \fIoption\fRs may be
specified, controlling exactly which method names are returned:
.RS
.VE 8.6
.TP
\fB\-all\fR
.
If the \fB\-all\fR flag is given,
.VS TIP500
and the \fB\-scope\fR flag is not given,
.VE TIP500
the list of methods will include those
.VS 8.6
If the \fB\-all\fR flag is given, the list of methods will include those
methods defined not just by the class, but also by the class's superclasses
and mixins.
.VE 8.6
.TP
\fB\-private\fR
.
If the \fB\-private\fR flag is given,
.VS TIP500
and the \fB\-scope\fR flag is not given,
.VE TIP500
the list of methods will also include
the non-exported methods of the class (and superclasses and
.VS 8.6
If the \fB\-private\fR flag is given, the list of methods will also include
the private (i.e. non-exported) methods of the class (and superclasses and
mixins, if \fB\-all\fR is also given).
.VS TIP500
Note that this naming is an unfortunate clash with true private methods; this
option name is retained for backward compatibility.
.VE TIP500
.TP
\fB\-scope\fI scope\fR
.VS TIP500
Returns a list of all methods on \fIclass\fR that have the given visibility
\fIscope\fR. When this option is supplied, both the \fB\-all\fR and
\fB\-private\fR options are ignored. The valid values for \fIscope\fR are:
.RS
.IP \fBpublic\fR 3
Only methods with \fIpublic\fR scope (i.e., callable from anywhere by any instance
of this class) are to be returned.
.IP \fBunexported\fR 3
Only methods with \fIunexported\fR scope (i.e., only callable via \fBmy\fR) are to
be returned.
.IP \fBprivate\fR 3
Only methods with \fIprivate\fR scope (i.e., only callable from within this class's
methods) are to be returned.
.RE
.VE TIP500
.RE
.VE 8.6
.TP
\fBinfo class methodtype\fI class method\fR
.
.VS 8.6
This subcommand returns a description of the type of implementation used for
the method named \fImethod\fR of class \fIclass\fR. When the result is
\fBmethod\fR, further information can be discovered with \fBinfo class
definition\fR, and when the result is \fBforward\fR, further information can
be discovered with \fBinfo class forward\fR.
.VE 8.6
.TP
\fBinfo class mixins\fI class\fR
.
.VS 8.6
This subcommand returns a list of all classes that have been mixed into the
class named \fIclass\fR.
.VE 8.6
.TP
\fBinfo class subclasses\fI class\fR ?\fIpattern\fR?
.
.VS 8.6
This subcommand returns a list of direct subclasses of class \fIclass\fR. If
the optional \fIpattern\fR argument is present, it constrains the list of
returned classes to those that match it according to the rules of
\fBstring match\fR.
.VE 8.6
.TP
\fBinfo class superclasses\fI class\fR
.
.VS 8.6
This subcommand returns a list of direct superclasses of class \fIclass\fR in
inheritance precedence order.
.VE 8.6
.TP
\fBinfo class variables\fI class\fR ?\fB\-private\fR?
.
\fBinfo class variables\fI class\fR
.VS 8.6
This subcommand returns a list of all variables that have been declared for
the class named \fIclass\fR (i.e. that are automatically present in the
class's methods, constructor and destructor).
.VS TIP500
If the \fB\-private\fR option is specified, this lists the private variables
declared instead.
.VE TIP500
.SS "OBJECT INTROSPECTION"
.PP
The following \fIsubcommand\fR values are supported by \fBinfo object\fR:
.VE 8.6
.TP
\fBinfo object call\fI object method\fR
.
.VS 8.6
Returns a description of the method implementations that are used to provide
\fIobject\fR's implementation of \fImethod\fR. This consists of a list of
lists of four elements, where each sublist consists of a word that describes
the general type of method implementation (being one of \fBmethod\fR for an
ordinary method, \fBfilter\fR for an applied filter,
.VS TIP500
\fBprivate\fR for a private method,
.VE TIP500
and \fBunknown\fR for a
ordinary method, \fBfilter\fR for an applied filter, and \fBunknown\fR for a
method that is invoked as part of unknown method handling), a word giving the
name of the particular method invoked (which is always the same as
\fImethod\fR for the \fBmethod\fR type, and
@@ -575,160 +550,128 @@ implementation (see \fBinfo object methodtype\fR).
.RS
.PP
Note that there is no inspection of whether the method implementations
actually use \fBnext\fR to transfer control along the call chain,
.VS TIP500
and the call chains that this command files do not actually contain private
methods.
.VE TIP500
actually use \fBnext\fR to transfer control along the call chain.
.RE
.VE 8.6
.TP
\fBinfo object class\fI object\fR ?\fIclassName\fR?
.
.VS 8.6
If \fIclassName\fR is unspecified, this subcommand returns class of the
\fIobject\fR object. If \fIclassName\fR is present, this subcommand returns a
boolean value indicating whether the \fIobject\fR is of that class.
.TP
\fBinfo object creationid\fI object\fR
.VS TIP500
Returns the unique creation identifier for the \fIobject\fR object. This
creation identifier is unique to the object (within a Tcl interpreter) and
cannot be controlled at object creation time or altered afterwards.
.RS
.PP
\fIImplementation note:\fR the creation identifier is used to generate unique
identifiers associated with the object, especially for private variables.
.RE
.VE TIP500
.VE 8.6
.TP
\fBinfo object definition\fI object method\fR
.
.VS 8.6
This subcommand returns a description of the definition of the method named
\fImethod\fR of object \fIobject\fR. The definition is described as a two
element list; the first element is the list of arguments to the method in a
form suitable for passing to another call to \fBproc\fR or a method definition,
and the second element is the body of the method.
.VE 8.6
.TP
\fBinfo object filters\fI object\fR
.
.VS 8.6
This subcommand returns the list of filter methods set on the object.
.VE 8.6
.TP
\fBinfo object forward\fI object method\fR
.
.VS 8.6
This subcommand returns the argument list for the method forwarding called
\fImethod\fR that is set on the object called \fIobject\fR.
.VE 8.6
.TP
\fBinfo object isa\fI category object\fR ?\fIarg\fR?
.
.VS 8.6
This subcommand tests whether an object belongs to a particular category,
returning a boolean value that indicates whether the \fIobject\fR argument
meets the criteria for the category. The supported categories are:
.VE 8.6
.RS
.TP
\fBinfo object isa class\fI object\fR
.
.VS 8.6
This returns whether \fIobject\fR is a class (i.e. an instance of
\fBoo::class\fR or one of its subclasses).
.VE 8.6
.TP
\fBinfo object isa metaclass\fI object\fR
.
.VS 8.6
This returns whether \fIobject\fR is a class that can manufacture classes
(i.e. is \fBoo::class\fR or a subclass of it).
.VE 8.6
.TP
\fBinfo object isa mixin\fI object class\fR
.
.VS 8.6
This returns whether \fIclass\fR is directly mixed into \fIobject\fR.
.VE 8.6
.TP
\fBinfo object isa object\fI object\fR
.
.VS 8.6
This returns whether \fIobject\fR really is an object.
.VE 8.6
.TP
\fBinfo object isa typeof\fI object class\fR
.
.VS 8.6
This returns whether \fIclass\fR is the type of \fIobject\fR (i.e. whether
\fIobject\fR is an instance of \fIclass\fR or one of its subclasses, whether
direct or indirect).
.RE
.VE 8.6
.TP
\fBinfo object methods\fI object\fR ?\fIoption...\fR?
.
.VS 8.6
This subcommand returns a list of all public (i.e. exported) methods of the
object called \fIobject\fR. Any of the following \fIoption\fRs may be
specified, controlling exactly which method names are returned:
.RS
.VE 8.6
.TP
\fB\-all\fR
.
If the \fB\-all\fR flag is given,
.VS TIP500
and the \fB\-scope\fR flag is not given,
.VE TIP500
the list of methods will include those
.VS 8.6
If the \fB\-all\fR flag is given, the list of methods will include those
methods defined not just by the object, but also by the object's class and
mixins, plus the superclasses of those classes.
.VE 8.6
.TP
\fB\-private\fR
.
If the \fB\-private\fR flag is given,
.VS TIP500
and the \fB\-scope\fR flag is not given,
.VE TIP500
the list of methods will also include
the non-exported methods of the object (and classes, if
.VS 8.6
If the \fB\-private\fR flag is given, the list of methods will also include
the private (i.e. non-exported) methods of the object (and classes, if
\fB\-all\fR is also given).
.VS TIP500
Note that this naming is an unfortunate clash with true private methods; this
option name is retained for backward compatibility.
.VE TIP500
.TP
\fB\-scope\fI scope\fR
.VS TIP500
Returns a list of all methods on \fIobject\fR that have the given visibility
\fIscope\fR. When this option is supplied, both the \fB\-all\fR and
\fB\-private\fR options are ignored. The valid values for \fIscope\fR are:
.RS
.IP \fBpublic\fR 3
Only methods with \fIpublic\fR scope (i.e., callable from anywhere) are to be
returned.
.IP \fBunexported\fR 3
Only methods with \fIunexported\fR scope (i.e., only callable via \fBmy\fR) are to
be returned.
.IP \fBprivate\fR 3
Only methods with \fIprivate\fR scope (i.e., only callable from within this object's
instance methods) are to be returned.
.RE
.VE TIP500
.RE
.VE 8.6
.TP
\fBinfo object methodtype\fI object method\fR
.
.VS 8.6
This subcommand returns a description of the type of implementation used for
the method named \fImethod\fR of object \fIobject\fR. When the result is
\fBmethod\fR, further information can be discovered with \fBinfo object
definition\fR, and when the result is \fBforward\fR, further information can
be discovered with \fBinfo object forward\fR.
.VE 8.6
.TP
\fBinfo object mixins\fI object\fR
.
.VS 8.6
This subcommand returns a list of all classes that have been mixed into the
object named \fIobject\fR.
.VE 8.6
.TP
\fBinfo object namespace\fI object\fR
.
.VS 8.6
This subcommand returns the name of the internal namespace of the object named
\fIobject\fR.
.VE 8.6
.TP
\fBinfo object variables\fI object\fRR ?\fB\-private\fR?
.
\fBinfo object variables\fI object\fR
.VS 8.6
This subcommand returns a list of all variables that have been declared for
the object named \fIobject\fR (i.e. that are automatically present in the
object's methods).
.VS TIP500
If the \fB\-private\fR option is specified, this lists the private variables
declared instead.
.VE TIP500
.VE 8.6
.TP
\fBinfo object vars\fI object\fR ?\fIpattern\fR?
.
.VS 8.6
This subcommand returns a list of all variables in the private namespace of
the object named \fIobject\fR. If the optional \fIpattern\fR argument is
given, it is a filter (in the syntax of a \fBstring match\fR glob pattern)
@@ -737,6 +680,7 @@ from the list returned by \fBinfo object variables\fR; that can include
variables that are currently unset, whereas this can include variables that
are not automatically included by any of \fIobject\fR's methods (or those of
its class, superclasses or mixins).
.VE 8.6
.SH EXAMPLES
.PP
This command prints out a procedure suitable for saving in a Tcl
@@ -759,6 +703,7 @@ proc printProc {procName} {
}
.CE
.SS "EXAMPLES WITH OBJECTS"
.VS 8.6
.PP
Every object necessarily knows what its class is; this information is
trivially extractable through introspection:
@@ -779,10 +724,8 @@ method and get how it is defined. This procedure illustrates how:
proc getDef {obj method} {
foreach inf [\fBinfo object call\fR $obj $method] {
lassign $inf calltype name locus methodtype
# Assume no forwards or filters, and hence no $calltype
# or $methodtype checks...
if {$locus eq "object"} {
return [\fBinfo object definition\fR $obj $name]
} else {
@@ -805,9 +748,7 @@ proc getDef {obj method} {
# Assume no forwards
return [\fBinfo object definition\fR $obj $method]
}
set cls [\fBinfo object class\fR $obj]
while {$method ni [\fBinfo class methods\fR $cls]} {
# Assume the simple case
set cls [lindex [\fBinfo class superclass\fR $cls] 0]
@@ -815,17 +756,22 @@ proc getDef {obj method} {
error "no definition for $method"
}
}
# Assume no forwards
return [\fBinfo class definition\fR $cls $method]
}
.CE
.VE 8.6
.SH "SEE ALSO"
.VS 8.6
global(n), oo::class(n), oo::define(n), oo::object(n), proc(n), self(n),
.VE 8.6
tcl_library(n), tcl_patchLevel(n), tcl_version(n)
.SH KEYWORDS
command, information, interpreter, introspection, level, namespace,
object, procedure, variable
.VS 8.6
object,
.VE 8.6
procedure, variable
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
+1 -4
View File
@@ -106,10 +106,7 @@ of which work solely with floating-point numbers unless otherwise noted:
In addition to these predefined functions, applications may
define additional functions by using \fBproc\fR (or any other method,
such as \fBinterp alias\fR or \fBTcl_CreateObjCommand\fR) to define
new commands in the \fBtcl::mathfunc\fR namespace. In addition, an
obsolete interface named \fBTcl_CreateMathFunc\fR() is available to
extensions that are written in C. The latter interface is not recommended
for new implementations.
new commands in the \fBtcl::mathfunc\fR namespace.
.SS "DETAILED DEFINITIONS"
.TP
\fBabs \fIarg\fR
+6 -33
View File
@@ -19,18 +19,13 @@ package require TclOO
.BE
.SH DESCRIPTION
.PP
The \fBmy\fR command is used to allow methods of objects to invoke methods
The \fBmy\fR command is used to allow methods of objects to invoke any method
of the object (or its class). In particular, the set of valid values for
\fImethodName\fR is the set of all methods supported by an object and its
superclasses, including those that are not exported
.VS TIP500
and private methods of the object or class when used within another method
defined by that object or class.
.VE TIP500
The object upon which the method is invoked is the one that owns the namespace
that the \fBmy\fR command is contained in initially (\fBNB:\fR the link
remains if the command is renamed), which is the currently invoked object by
default.
superclasses, including those that are not exported. The object upon which the
method is invoked is always the one that is the current context of the method
(i.e. the object that is returned by \fBself object\fR) from which the
\fBmy\fR command is invoked.
.PP
Each object has its own \fBmy\fR command, contained in its instance namespace.
.SH EXAMPLES
@@ -45,38 +40,16 @@ oo::class create c {
puts [incr counter]
}
}
c create o
o count \fI\(-> prints "1"\fR
o count \fI\(-> prints "2"\fR
o count \fI\(-> prints "3"\fR
.CE
.PP
This example shows how you can use \fBmy\fR to make callbacks to private
methods from outside the object (from a \fBtrace\fR), using
\fBnamespace code\fR to enter the correct context:
.PP
.CS
oo::class create HasCallback {
method makeCallback {} {
return [namespace code {
\fBmy\fR Callback
}]
}
method Callback {args} {
puts "callback: $args"
}
}
set o [HasCallback new]
trace add variable xyz write [$o makeCallback]
set xyz "called" \fI\(-> prints "callback: xyz {} write"\fR
.CE
.SH "SEE ALSO"
next(n), oo::object(n), self(n)
.SH KEYWORDS
method, method visibility, object, private method, public method
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
-5
View File
@@ -112,7 +112,6 @@ oo::class create theSuperclass {
puts "in the superclass, args = $args"
}
}
oo::class create theSubclass {
superclass theSuperclass
method example {args} {
@@ -122,7 +121,6 @@ oo::class create theSubclass {
puts "after chaining from subclass"
}
}
theSubclass create obj
oo::objdefine obj method example args {
puts "per-object method, args = $args"
@@ -169,7 +167,6 @@ oo::class create cache {
\fI# Compute value, insert into cache, and return it\fR
return [set ValueCache($key) [\fBnext\fR {*}$args]]
}
method flushCache {} {
my variable ValueCache
unset ValueCache
@@ -181,12 +178,10 @@ oo::class create cache {
oo::object create demo
oo::objdefine demo {
mixin cache
method compute {a b c} {
after 3000 \fI;# Simulate deep thought\fR
return [expr {$a + $b * $c}]
}
method compute2 {a b c} {
after 3000 \fI;# Simulate deep thought\fR
return [expr {$a * $b + $c}]
-131
View File
@@ -1,131 +0,0 @@
'\"
'\" Copyright (c) 2017 Frederic Bonnet.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH process n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
tcl::process \- Subprocess management
.SH SYNOPSIS
\fB::tcl::process \fIoption \fR?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
This command provides a way to manage subprocesses created by the \fBopen\fR
and \fBexec\fR commands. The legal \fIoptions\fR (which may be abbreviated) are:
.TP
\fB::tcl::process list\fR
.
Returns the list of subprocess PIDs.
.TP
\fB::tcl::process status\fR ?\fIswitches\fR? ?\fIpids\fR?
.
Returns a dictionary mapping subprocess PIDs to their respective status. If
\fIpids\fR is specified as a list of PIDs then the command only returns the
status of the matching subprocesses if they exist, and raises an error
otherwise. For active processes, the status is an empty value. For terminated
processes, the status is a list with the following format:
.QW "{code ?\fImsg errorCode\fR?}" ,
where:
.RS
.TP
\fBcode\fR\0
.
is a standard Tcl return code,
.TP
\fBmsg\fR\0
.
is the human-readable error message,
.TP
\fBerrorCode\fR\0
.
uses the same format as the \fBerrorCode\fR global variable
.RE
Note that \fBmsg\fR and \fBerrorCode\fR are only present for abnormally
terminated processes (i.e. those where \fBcode\fR is nonzero). Under the hood
this command calls \fBTcl_WaitPid\fR with the \fBWNOHANG\fR flag set for
non-blocking behavior, unless the \fB\-wait\fR switch is set (see below).
.RS
.PP
Additionally, \fB::tcl::process status\fR accepts the following switches:
.TP
\fB\-wait\fR\0
.
By default the command returns immediately (the underlying \fBTcl_WaitPid\fR is
called with the \fBWNOHANG\fR flag set) unless this switch is set. If \fBpids\fR
is specified as a list of PIDs then the command waits until the status of the
matching subprocesses are available. If \fBpids\fR is not specified then it
waits for all known subprocesses.
.TP
\fB\-\|\-\fR
.
Marks the end of switches. The argument following this one will
be treated as the first \fIarg\fR even if it starts with a \fB\-\fR.
.RE
.TP
\fB::tcl::process purge ?\fIpids\fR?
.
Cleans up all data associated with terminated subprocesses. If \fBpids\fR is
specified as a list of PIDs then the command only cleanup data for the matching
subprocesses if they exist, and raises an error otherwise. If the process is
still active then it does nothing.
.TP
\fB::tcl::process autopurge ?\fIflag\fR?
.
Automatic purge facility. If \fBflag\fR is specified as a boolean value then it
activates or deactivate autopurge. In all cases it returns the current status as
a boolean value. When autopurge is active, \fBTcl_ReapDetachedProcs\fR is called
each time the exec command is executed or a pipe channel created by open is
closed. When autopurge is inactive, \fB::tcl::process\fR purge must be called
explicitly. By default autopurge is active.
.RE
.SH "EXAMPLES"
.PP
.CS
\fB::tcl::process autopurge\fR
\fI\(-> true\fR
\fB::tcl::process autopurge\fR false
\fI\(-> false\fR
set pid1 [exec command1 a b c | command2 d e f &]
\fI\(-> 123 456\fR
set chan [open "|command1 a b c | command2 d e f"]
\fI\(-> file123\fR
set pid2 [pid $chan]
\fI\(-> 789 1011\fR
\fB::tcl::process list\fR
\fI\(-> 123 456 789 1011\fR
\fB::tcl::process status\fR
\fI\(-> 123 0 456 {1 "child killed: write on pipe with no readers" {CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}} 789 {1 "child suspended: background tty read" {CHILDSUSP 789 SIGTTIN "background tty read"}} 1011 {}\fR
\fB::tcl::process status\fR 123
\fI\(-> 123 0\fR
\fB::tcl::process status\fR 1011
\fI\(-> 1011 {}\fR
\fB::tcl::process status\fR -wait
\fI\(-> 123 0 456 {1 "child killed: write on pipe with no readers" {CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}} 789 {1 "child suspended: background tty read" {CHILDSUSP 789 SIGTTIN "background tty read"}} 1011 {1 "child process exited abnormally" {CHILDSTATUS 1011 -1}}\fR
\fB::tcl::process status\fR 1011
\fI\(-> 1011 {1 "child process exited abnormally" {CHILDSTATUS 1011 -1}}\fR
\fB::tcl::process purge\fR
exec command1 1 2 3 &
\fI\(-> 1213\fR
\fB::tcl::process list\fR
\fI\(-> 1213\fR
.CE
.SH "SEE ALSO"
exec(n), open(n), Tcl_DetachPids(3), Tcl_WaitPid(3), Tcl_ReapDetachedProcs(3)
.SH "KEYWORDS"
background, child, detach, process, wait
'\" Local Variables:
'\" mode: nroff
'\" End:
+2 -4
View File
@@ -224,12 +224,10 @@ set string "#08D03F"
\fBscan\fR $string "#%2x%2x%2x" r g b
.CE
.PP
Parse a \fIHH:MM\fR time string, noting that this avoids problems with
octal numbers by forcing interpretation as decimals (if we did not
care, we would use the \fB%i\fR conversion instead):
Parse a \fIHH:MM\fR time string:
.PP
.CS
set string "08:08" ;# *Not* octal!
set string "08:08"
if {[\fBscan\fR $string "%d:%d" hours minutes] != 2} {
error "not a valid time string"
}
+1 -6
View File
@@ -32,12 +32,7 @@ implement the current call chain. The first element is the same as would be
reported by \fBinfo object\fR \fBcall\fR for the current method (except that this
also reports useful values from within constructors and destructors, whose
names are reported as \fB<constructor>\fR and \fB<destructor>\fR
respectively,
.VS TIP500
and for private methods, which are described as being \fBprivate\fR instead of
being a \fBmethod\fR),
.VE TIP500
and the second element is an index into the first element's
respectively), and the second element is an index into the first element's
list that indicates which actual implementation is currently executing (the
first implementation to execute is always at index 0).
.TP
+1 -65
View File
@@ -10,7 +10,7 @@
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_library, tcl_nonwordchars, tcl_patchLevel, tcl_pkgPath, tcl_platform, tcl_precision, tcl_rcFileName, tcl_traceCompile, tcl_traceExec, tcl_wordchars, tcl_version \- Variables used by Tcl
argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_library, tcl_nonwordchars, tcl_patchLevel, tcl_pkgPath, tcl_platform, tcl_rcFileName, tcl_traceCompile, tcl_traceExec, tcl_wordchars, tcl_version \- Variables used by Tcl
.BE
.SH DESCRIPTION
.PP
@@ -356,70 +356,6 @@ This gives the size of the native-machine word in bytes (strictly, it
is same as the result of evaluating \fIsizeof(long)\fR in C.)
.RE
.TP
\fBtcl_precision\fR
.
This variable controls the number of digits to generate
when converting floating-point values to strings. It defaults
to 0. \fIApplications should not change this value;\fR it is
provided for compatibility with legacy code.
.PP
.RS
The default value of 0 is special, meaning that Tcl should
convert numbers using as few digits as possible while still
distinguishing any floating point number from its nearest
neighbours. It differs from using an arbitrarily high value
for \fItcl_precision\fR in that an inexact number like \fI1.4\fR
will convert as \fI1.4\fR rather than \fI1.3999999999999999\fR
even though the latter is nearer to the exact value of the
binary number.
.RE
.PP
.RS
If \fBtcl_precision\fR is not zero, then when Tcl converts a floating
point number, it creates a decimal representation of at most
\fBtcl_precision\fR significant digits; the result may be shorter if
the shorter result represents the original number exactly. If no
result of at most \fBtcl_precision\fR digits is an exact representation
of the original number, the one that is closest to the original
number is chosen.
If the original number lies precisely between two equally accurate
decimal representations, then the one with an even value for the least
significant digit is chosen; for instance, if \fBtcl_precision\fR is 3, then
0.3125 will convert to 0.312, not 0.313, while 0.6875 will convert to
0.688, not 0.687. Any string of trailing zeroes that remains is trimmed.
.RE
.PP
.RS
a \fBtcl_precision\fR value of 17 digits is
.QW perfect
for IEEE floating-point in that it allows
double-precision values to be converted to strings and back to
binary with no loss of information. For this reason, you will often
see it as a value in legacy code that must run on Tcl versions before
8.5. It is no longer recommended; as noted above, a zero value is the
preferred method.
.RE
.PP
.RS
All interpreters in a thread share a single \fBtcl_precision\fR value:
changing it in one interpreter will affect all other interpreters as
well. Safe interpreters are not allowed to modify the
variable.
.RE
.PP
.RS
Valid values for \fBtcl_precision\fR range from 0 to 17.
.RE
.TP
\fBtcl_rcFileName\fR
.
This variable is used during initialization to indicate the name of a
user-specific startup file. If it is set by application-specific
initialization, then the Tcl startup code will check for the existence
of this file and \fBsource\fR it if it exists. For example, for \fBwish\fR
the variable is set to \fB~/.wishrc\fR for Unix and \fB~/wishrc.tcl\fR
for Windows.
.TP
\fBtcl_traceCompile\fR
.
The value of this variable can be set to control
+114 -91
View File
@@ -104,9 +104,10 @@ declare 20 {
declare 21 {
int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line)
}
declare 22 {
Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line)
}
# Removed in 9.0 (changed to macro):
#declare 22 {
# Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line)
#}
declare 23 {
Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, int length,
const char *file, int line)
@@ -119,9 +120,10 @@ declare 25 {
Tcl_Obj *Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
const char *file, int line)
}
declare 26 {
Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line)
}
# Removed in 9.0 (changed to macro):
#declare 26 {
# Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line)
#}
declare 27 {
Tcl_Obj *Tcl_DbNewObj(const char *file, int line)
}
@@ -166,7 +168,7 @@ declare 39 {
int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr)
}
declare 40 {
CONST86 Tcl_ObjType *Tcl_GetObjType(const char *typeName)
const Tcl_ObjType *Tcl_GetObjType(const char *typeName)
}
declare 41 {
char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr)
@@ -198,33 +200,37 @@ declare 48 {
int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first,
int count, int objc, Tcl_Obj *const objv[])
}
declare 49 {
Tcl_Obj *Tcl_NewBooleanObj(int boolValue)
}
# Removed in 9.0 (changed to macro):
#declare 49 {
# Tcl_Obj *Tcl_NewBooleanObj(int boolValue)
#}
declare 50 {
Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, int length)
}
declare 51 {
Tcl_Obj *Tcl_NewDoubleObj(double doubleValue)
}
declare 52 {
Tcl_Obj *Tcl_NewIntObj(int intValue)
}
# Removed in 9.0 (changed to macro):
#declare 52 {
# Tcl_Obj *Tcl_NewIntObj(int intValue)
#}
declare 53 {
Tcl_Obj *Tcl_NewListObj(int objc, Tcl_Obj *const objv[])
}
declare 54 {
Tcl_Obj *Tcl_NewLongObj(long longValue)
}
# Removed in 9.0 (changed to macro):
#declare 54 {
# Tcl_Obj *Tcl_NewLongObj(long longValue)
#}
declare 55 {
Tcl_Obj *Tcl_NewObj(void)
}
declare 56 {
Tcl_Obj *Tcl_NewStringObj(const char *bytes, int length)
}
declare 57 {
void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
}
# Removed in 9.0 (changed to macro):
#declare 57 {
# void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
#}
declare 58 {
unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length)
}
@@ -235,15 +241,17 @@ declare 59 {
declare 60 {
void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue)
}
declare 61 {
void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
}
# Removed in 9.0 (changed to macro):
#declare 61 {
# void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
#}
declare 62 {
void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[])
}
declare 63 {
void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue)
}
# Removed in 9.0 (changed to macro):
#declare 63 {
# void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue)
#}
declare 64 {
void Tcl_SetObjLength(Tcl_Obj *objPtr, int length)
}
@@ -285,9 +293,10 @@ declare 75 {
declare 76 {
void Tcl_BackgroundError(Tcl_Interp *interp)
}
declare 77 {deprecated {Use Tcl_UtfBackslash}} {
char Tcl_Backslash(const char *src, int *readPtr)
}
# Removed in 9.0:
#declare 77 {deprecated {Use Tcl_UtfBackslash}} {
# char Tcl_Backslash(const char *src, int *readPtr)
#}
declare 78 {
int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName,
const char *optionList)
@@ -352,11 +361,12 @@ declare 93 {
declare 94 {
Tcl_Interp *Tcl_CreateInterp(void)
}
declare 95 {deprecated {}} {
void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name,
int numArgs, Tcl_ValueType *argTypes,
Tcl_MathProc *proc, ClientData clientData)
}
# Removed in 9.0:
#declare 95 {deprecated {}} {
# void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name,
# int numArgs, Tcl_ValueType *argTypes,
# Tcl_MathProc *proc, ClientData clientData)
#}
declare 96 {
Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
const char *cmdName,
@@ -472,9 +482,10 @@ declare 129 {
declare 130 {
int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName)
}
declare 131 {
int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
# Removed in 9.0, replaced by macro.
#declare 131 {
# int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#}
declare 132 {
void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc)
}
@@ -565,7 +576,7 @@ declare 157 {
const char *optionName, Tcl_DString *dsPtr)
}
declare 158 {
CONST86 Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan)
const Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan)
}
declare 159 {
int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName,
@@ -635,9 +646,10 @@ declare 176 {
declare 177 {
int Tcl_GlobalEval(Tcl_Interp *interp, const char *command)
}
declare 178 {
int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
# Removed in 9.0, replaced by macro.
#declare 178 {
# int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#}
declare 179 {
int Tcl_HideCommand(Tcl_Interp *interp, const char *cmdName,
const char *hiddenCmdToken)
@@ -779,9 +791,10 @@ declare 218 {
declare 219 {
int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr)
}
declare 220 {deprecated {}} {
int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode)
}
# Removed in 9.0:
#declare 220 {
# int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode)
#}
declare 221 {
int Tcl_ServiceAll(void)
}
@@ -866,9 +879,10 @@ declare 244 {
declare 245 {
int Tcl_StringMatch(const char *str, const char *pattern)
}
declare 246 {deprecated {}} {
int Tcl_TellOld(Tcl_Channel chan)
}
# Removed in 9.0:
#declare 246 {
# int Tcl_TellOld(Tcl_Channel chan)
#}
declare 247 {
int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags,
Tcl_VarTraceProc *proc, ClientData clientData)
@@ -942,12 +956,14 @@ declare 265 {
declare 266 {
void Tcl_ValidateAllMemory(const char *file, int line)
}
declare 267 {deprecated {see TIP #422}} {
void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList)
}
declare 268 {deprecated {see TIP #422}} {
void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList)
}
# Removed in 9.0:
#declare 267 {
# void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList)
#}
# Removed in 9.0:
#declare 268 {
# void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList)
#}
declare 269 {
char *Tcl_HashStats(Tcl_HashTable *tablePtr)
}
@@ -973,18 +989,21 @@ declare 274 {
const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
const char *version, int exact)
}
declare 275 {deprecated {see TIP #422}} {
void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)
}
declare 276 {deprecated {see TIP #422}} {
int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList)
}
# Removed in 9.0:
#declare 275 {
# void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)
#}
# Removed in 9.0:
#declare 276 {
# int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList)
#}
declare 277 {
Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
}
declare 278 {deprecated {see TIP #422}} {
TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList)
}
# Removed in 9.0:
#declare 278 {
# TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList)
#}
declare 279 {
void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type)
}
@@ -1211,12 +1230,14 @@ declare 339 {
declare 340 {
char *Tcl_GetString(Tcl_Obj *objPtr)
}
declare 341 {deprecated {Use Tcl_GetEncodingSearchPath}} {
const char *Tcl_GetDefaultEncodingDir(void)
}
declare 342 {deprecated {Use Tcl_SetEncodingSearchPath}} {
void Tcl_SetDefaultEncodingDir(const char *path)
}
# Removed in 9.0:
#declare 341 {deprecated {Use Tcl_GetEncodingSearchPath}} {
# const char *Tcl_GetDefaultEncodingDir(void)
#}
# Removed in 9.0:
#declare 342 {deprecated {Use Tcl_SetEncodingSearchPath}} {
# void Tcl_SetDefaultEncodingDir(const char *path)
#}
declare 343 {
void Tcl_AlertNotifier(ClientData clientData)
}
@@ -1263,10 +1284,11 @@ declare 356 {
Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj,
int flags)
}
declare 357 {deprecated {Use Tcl_EvalTokensStandard}} {
Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
int count)
}
# Removed in 9.0:
#declare 357 {deprecated {Use Tcl_EvalTokensStandard}} {
# Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
# int count)
#}
declare 358 {
void Tcl_FreeParse(Tcl_Parse *parsePtr)
}
@@ -1490,13 +1512,15 @@ declare 420 {
int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
const Tcl_UniChar *uniPattern, int nocase)
}
declare 421 {
Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key)
}
declare 422 {
Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
const void *key, int *newPtr)
}
# Removed in 9.0, as it is actually a macro:
#declare 421 {
# Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key)
#}
# Removed in 9.0, as it is actually a macro:
#declare 422 {
# Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
# const void *key, int *newPtr)
#}
declare 423 {
void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType,
const Tcl_HashKeyType *typePtr)
@@ -1545,14 +1569,16 @@ declare 434 {
}
# TIP#15 (math function introspection) dkf
declare 435 {deprecated {}} {
int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
int *numArgsPtr, Tcl_ValueType **argTypesPtr,
Tcl_MathProc **procPtr, ClientData *clientDataPtr)
}
declare 436 {deprecated {}} {
Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern)
}
# Removed in 9.0:
#declare 435 {deprecated {}} {
# int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
# int *numArgsPtr, Tcl_ValueType **argTypesPtr,
# Tcl_MathProc **procPtr, ClientData *clientDataPtr)
#}
# Removed in 9.0:
#declare 436 {deprecated {}} {
# Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern)
#}
# TIP#36 (better access to 'subst') dkf
declare 437 {
@@ -1614,7 +1640,7 @@ declare 452 {
int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr)
}
declare 453 {
const char *CONST86 *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
const char *const *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
Tcl_Obj **objPtrRef)
}
declare 454 {
@@ -1692,7 +1718,7 @@ declare 476 {
Tcl_Obj *pathPtr)
}
declare 477 {
CONST86 Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr)
const Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr)
}
declare 478 {
Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr)
@@ -2375,9 +2401,6 @@ declare 1 macosx {
# Public functions that are not accessible via the stubs table.
export {
void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc)
}
export {
const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version,
int exact)
+49 -220
View File
@@ -52,30 +52,15 @@ extern "C" {
* tools/tcl.hpj.in (not patchlevel, for windows installer)
*/
#define TCL_MAJOR_VERSION 8
#define TCL_MINOR_VERSION 7
#define TCL_MAJOR_VERSION 9
#define TCL_MINOR_VERSION 0
#define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE
#define TCL_RELEASE_SERIAL 2
#define TCL_RELEASE_SERIAL 0
#define TCL_VERSION "8.7"
#define TCL_PATCH_LEVEL "8.7a2"
#define TCL_VERSION "9.0"
#define TCL_PATCH_LEVEL "9.0a0"
#if !defined(TCL_NO_DEPRECATED) || defined(RC_INVOKED)
/*
*----------------------------------------------------------------------------
* The following definitions set up the proper options for Windows compilers.
* We use this method because there is no autoconf equivalent.
*/
#ifdef _WIN32
# ifndef __WIN32__
# define __WIN32__
# endif
# ifndef WIN32
# define WIN32
# endif
#endif
#if defined(RC_INVOKED)
/*
* Utility macros: STRINGIFY takes an argument and wraps it in "" (double
* quotation marks), JOIN joins two arguments.
@@ -89,11 +74,7 @@ extern "C" {
# define JOIN(a,b) JOIN1(a,b)
# define JOIN1(a,b) a##b
#endif
#ifndef TCL_THREADS
# define TCL_THREADS 1
#endif
#endif /* !TCL_NO_DEPRECATED */
#endif /* RC_INVOKED */
/*
* A special definition used to allow this header file to be included from
@@ -107,10 +88,15 @@ extern "C" {
#ifndef RC_INVOKED
/*
* Special macro to define mutexes.
* Special macro to define mutexes, that doesn't do anything if we are not
* using threads.
*/
#ifdef TCL_THREADS
#define TCL_DECLARE_MUTEX(name) static Tcl_Mutex name;
#else
#define TCL_DECLARE_MUTEX(name)
#endif
/*
* Tcl's public routine Tcl_FSSeek() uses the values SEEK_SET, SEEK_CUR, and
@@ -124,32 +110,11 @@ extern "C" {
#include <stdio.h>
/*
*----------------------------------------------------------------------------
* Support for functions with a variable number of arguments.
*
* The following TCL_VARARGS* macros are to support old extensions
* written for older versions of Tcl where the macros permitted
* support for the varargs.h system as well as stdarg.h .
*
* New code should just directly be written to use stdarg.h conventions.
*/
#include <stdarg.h>
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
# define TCL_VARARGS(type, name) (type name, ...)
# define TCL_VARARGS_DEF(type, name) (type name, ...)
# define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
#endif /* !TCL_NO_DEPRECATED */
#if defined(__GNUC__) && (__GNUC__ > 2)
# define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))
# define TCL_NORETURN __attribute__ ((noreturn))
# define TCL_NOINLINE __attribute__ ((noinline))
# if defined(BUILD_tcl) || defined(BUILD_tk)
# define TCL_NORETURN1 __attribute__ ((noreturn))
# else
# define TCL_NORETURN1 /* nothing */
# endif
# define TCL_NORETURN1 __attribute__ ((noreturn))
#else
# define TCL_FORMAT_PRINTF(a,b)
# if defined(_MSC_VER) && (_MSC_VER >= 1310)
@@ -224,7 +189,7 @@ extern "C" {
* to be included in a shared library, then it should have the DLLEXPORT
* storage class. If is being declared for use by a module that is going to
* link against the shared library, then it should have the DLLIMPORT storage
* class. If the symbol is beind declared for a static build or for use from a
* class. If the symbol is being declared for a static build or for use from a
* stub library, then the storage class should be empty.
*
* The convention is that a macro called BUILD_xxxx, where xxxx is the name of
@@ -245,33 +210,7 @@ extern "C" {
# endif
#endif
/*
* The following _ANSI_ARGS_ macro is to support old extensions
* written for older versions of Tcl where it permitted support
* for compilers written in the pre-prototype era of C.
*
* New code should use prototypes.
*/
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
# undef _ANSI_ARGS_
# define _ANSI_ARGS_(x) x
/*
* Definitions that allow this header file to be used either with or without
* ANSI C features.
*/
#ifndef INLINE
# define INLINE
#endif
#ifndef CONST
# define CONST const
#endif
#endif /* !TCL_NO_DEPRECATED */
#ifndef CONST86
#if !defined(CONST86) && !defined(TCL_NO_DEPRECATED)
# define CONST86 const
#endif
@@ -289,41 +228,11 @@ extern "C" {
# define EXTERN extern TCL_STORAGE_CLASS
#endif
/*
*----------------------------------------------------------------------------
* The following code is copied from winnt.h. If we don't replicate it here,
* then <windows.h> can't be included after tcl.h, since tcl.h also defines
* VOID. This block is skipped under Cygwin and Mingw.
*/
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID)
#ifndef VOID
#define VOID void
typedef char CHAR;
typedef short SHORT;
typedef long LONG;
#endif
#endif /* _WIN32 && !HAVE_WINNT_IGNORE_VOID */
/*
* Macro to use instead of "void" for arguments that must have type "void *"
* in ANSI C; maps them to type "char *" in non-ANSI systems.
*/
#ifndef __VXWORKS__
# define VOID void
#endif
#endif /* !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 */
/*
* Miscellaneous declarations.
*/
#ifndef _CLIENTDATA
typedef void *ClientData;
# define _CLIENTDATA
#endif
typedef void *ClientData;
/*
* Darwin specific configure overrides (to support fat compiles, where
@@ -460,17 +369,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
* accessed with Tcl_GetObjResult() and Tcl_SetObjResult().
*/
typedef struct Tcl_Interp
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
{
/* TIP #330: Strongly discourage extensions from using the string
* result. */
char *resultDontUse; /* Don't use in extensions! */
void (*freeProcDontUse) (char *); /* Don't use in extensions! */
int errorLineDontUse; /* Don't use in extensions! */
}
#endif /* !TCL_NO_DEPRECATED */
Tcl_Interp;
typedef struct Tcl_Interp Tcl_Interp;
typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
typedef struct Tcl_Channel_ *Tcl_Channel;
@@ -619,10 +518,6 @@ typedef struct stat *Tcl_OldStat_;
#define TCL_BREAK 3
#define TCL_CONTINUE 4
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#define TCL_RESULT_SIZE 200
#endif
/*
*----------------------------------------------------------------------------
* Flags to control what substitutions are performed by Tcl_SubstObj():
@@ -633,27 +528,6 @@ typedef struct stat *Tcl_OldStat_;
#define TCL_SUBST_BACKSLASHES 004
#define TCL_SUBST_ALL 007
/*
* Argument descriptors for math function callbacks in expressions:
*/
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
typedef enum {
TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT
} Tcl_ValueType;
typedef struct Tcl_Value {
Tcl_ValueType type; /* Indicates intValue or doubleValue is valid,
* or both. */
long intValue; /* Integer value. */
double doubleValue; /* Double-precision floating value. */
Tcl_WideInt wideValue; /* Wide (min. 64-bit) integer value. */
} Tcl_Value;
#else
#define Tcl_ValueType void /* Just enough to prevent compilation error in Tcl */
#define Tcl_Value void /* Just enough to prevent compilation error in Tcl */
#endif
/*
* Forward declaration of Tcl_Obj to prevent an error when the forward
* reference to Tcl_Obj is encountered in the function types declared below.
@@ -699,8 +573,6 @@ typedef void (Tcl_FreeProc) (char *blockPtr);
typedef void (Tcl_IdleProc) (ClientData clientData);
typedef void (Tcl_InterpDeleteProc) (ClientData clientData,
Tcl_Interp *interp);
typedef int (Tcl_MathProc) (ClientData clientData, Tcl_Interp *interp,
Tcl_Value *args, Tcl_Value *resultPtr);
typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData);
typedef int (Tcl_ObjCmdProc) (ClientData clientData, Tcl_Interp *interp,
int objc, struct Tcl_Obj *const *objv);
@@ -812,20 +684,11 @@ int Tcl_IsShared(Tcl_Obj *objPtr);
/*
*----------------------------------------------------------------------------
* The following structure contains the state needed by Tcl_SaveResult. No-one
* outside of Tcl should access any of these fields. This structure is
* typically allocated on the stack.
* The following type contains the state needed by Tcl_SaveResult. It
* is typically allocated on the stack.
*/
typedef struct Tcl_SavedResult {
char *result;
Tcl_FreeProc *freeProc;
Tcl_Obj *objResultPtr;
char *appendResult;
int appendAvl;
int appendUsed;
char resultSpace[200+1];
} Tcl_SavedResult;
typedef Tcl_Obj *Tcl_SavedResult;
/*
*----------------------------------------------------------------------------
@@ -950,14 +813,11 @@ typedef struct Tcl_DString {
#define Tcl_DStringLength(dsPtr) ((dsPtr)->length)
#define Tcl_DStringValue(dsPtr) ((dsPtr)->string)
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
# define Tcl_DStringTrunc Tcl_DStringSetLength
#endif /* !TCL_NO_DEPRECATED */
/*
* Definitions for the maximum number of digits of precision that may be
* specified in the "tcl_precision" variable, and the number of bytes of
* buffer space required by Tcl_PrintDouble.
* produced by Tcl_PrintDouble, and the number of bytes of buffer space
* required by Tcl_PrintDouble.
*/
#define TCL_MAX_PREC 17
@@ -1071,17 +931,6 @@ typedef struct Tcl_DString {
#define TCL_ALLOW_INLINE_COMPILATION 0x20000
/*
* The TCL_PARSE_PART1 flag is deprecated and has no effect. The part1 is now
* always parsed whenever the part2 is NULL. (This is to avoid a common error
* when converting code to use the new object based APIs and forgetting to
* give the flag)
*/
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
# define TCL_PARSE_PART1 0x400
#endif /* !TCL_NO_DEPRECATED */
/*
* Types for linked variables:
*/
@@ -1135,9 +984,7 @@ struct Tcl_HashEntry {
Tcl_HashEntry *nextPtr; /* Pointer to next entry in this hash bucket,
* or NULL for end of chain. */
Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */
void *hash; /* Hash value, stored as pointer to ensure
* that the offsets of the fields in this
* structure are not changed. */
unsigned int hash; /* Hash value. */
ClientData clientData; /* Application stores something here with
* Tcl_SetHashValue. */
union { /* Key has one of these forms: */
@@ -1232,10 +1079,10 @@ struct Tcl_HashTable {
* table. */
int rebuildSize; /* Enlarge table when numEntries gets to be
* this large. */
unsigned int mask; /* Mask value used in hashing function. */
int downShift; /* Shift count used in hashing function.
* Designed to use high-order bits of
* randomized keys. */
int mask; /* Mask value used in hashing function. */
int keyType; /* Type of keys used in this table. It's
* either TCL_CUSTOM_KEYS, TCL_STRING_KEYS,
* TCL_ONE_WORD_KEYS, or an integer giving the
@@ -1356,8 +1203,8 @@ typedef struct Tcl_Time {
long usec; /* Microseconds. */
} Tcl_Time;
typedef void (Tcl_SetTimerProc) (CONST86 Tcl_Time *timePtr);
typedef int (Tcl_WaitForEventProc) (CONST86 Tcl_Time *timePtr);
typedef void (Tcl_SetTimerProc) (const Tcl_Time *timePtr);
typedef int (Tcl_WaitForEventProc) (const Tcl_Time *timePtr);
/*
* TIP #233 (Virtualized Time)
@@ -1629,7 +1476,7 @@ typedef int (Tcl_FSNormalizePathProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr,
int nextCheckpoint);
typedef int (Tcl_FSFileAttrsGetProc) (Tcl_Interp *interp, int index,
Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef);
typedef const char *CONST86 * (Tcl_FSFileAttrStringsProc) (Tcl_Obj *pathPtr,
typedef const char *const * (Tcl_FSFileAttrStringsProc) (Tcl_Obj *pathPtr,
Tcl_Obj **objPtrRef);
typedef int (Tcl_FSFileAttrsSetProc) (Tcl_Interp *interp, int index,
Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
@@ -1931,7 +1778,7 @@ typedef struct Tcl_Token {
* TCL_TOKEN_OPERATOR - The token describes one expression operator.
* An operator might be the name of a math
* function such as "abs". A TCL_TOKEN_OPERATOR
* token is always preceded by one
* token is always preceeded by one
* TCL_TOKEN_SUB_EXPR token for the operator's
* subexpression, and is followed by zero or more
* TCL_TOKEN_SUB_EXPR tokens for the operator's
@@ -2145,9 +1992,9 @@ 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 4 and 6
* (or perhaps 1 if we want to support a non-unicode enabled core). If 4,
* then Tcl_UniChar must be 2-bytes in size (UCS-2) (the default). If 6,
* Unicode character in UTF-8. The valid values should be 3, 4 or 6
* (or perhaps 1 if we want to support a non-unicode enabled core). If 3 or
* 4, then Tcl_UniChar must be 2-bytes in size (UCS-2) (the default). If 6,
* then Tcl_UniChar must be 4-bytes in size (UCS-4). At this time UCS-2 mode
* is the default and recommended mode. UCS-4 is experimental and not
* recommended. It works for the core, but most extensions expect UCS-2.
@@ -2360,11 +2207,6 @@ const char * Tcl_InitStubs(Tcl_Interp *interp, const char *version,
int exact, int magic);
const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
const char *version, int epoch, int revision);
#if defined(_WIN32)
TCL_NORETURN void Tcl_ConsolePanic(const char *format, ...);
#else
# define Tcl_ConsolePanic ((Tcl_PanicProc *)0)
#endif
#ifdef USE_TCL_STUBS
#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
@@ -2396,7 +2238,7 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
*/
#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
((Tcl_SetPanicProc(Tcl_ConsolePanic), Tcl_CreateInterp)()))
((Tcl_CreateInterp)()))
EXTERN void Tcl_MainEx(int argc, char **argv,
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
@@ -2547,44 +2389,31 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
* hash tables:
*/
#undef Tcl_FindHashEntry
#define Tcl_FindHashEntry(tablePtr, key) \
(*((tablePtr)->findProc))(tablePtr, (const char *)(key))
#undef Tcl_CreateHashEntry
#define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
(*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr)
/*
*----------------------------------------------------------------------------
* Deprecated Tcl functions:
* Macros that eliminate the overhead of the thread synchronization functions
* when compiling without thread support.
*/
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*
* These function have been renamed. The old names are deprecated, but we
* define these macros for backwards compatibility.
*/
# define Tcl_Ckalloc Tcl_Alloc
# define Tcl_Ckfree Tcl_Free
# define Tcl_Ckrealloc Tcl_Realloc
# define Tcl_Return Tcl_SetResult
# define Tcl_TildeSubst Tcl_TranslateFileName
#if !defined(__APPLE__) /* On OSX, there is a conflict with "mach/mach.h" */
# define panic Tcl_Panic
#endif
# define panicVA Tcl_PanicVA
/*
*----------------------------------------------------------------------------
* Convenience declaration of Tcl_AppInit for backwards compatibility. This
* function is not *implemented* by the tcl library, so the storage class is
* neither DLLEXPORT nor DLLIMPORT.
*/
extern Tcl_AppInitProc Tcl_AppInit;
#endif /* !TCL_NO_DEPRECATED */
#ifndef TCL_THREADS
#undef Tcl_MutexLock
#define Tcl_MutexLock(mutexPtr)
#undef Tcl_MutexUnlock
#define Tcl_MutexUnlock(mutexPtr)
#undef Tcl_MutexFinalize
#define Tcl_MutexFinalize(mutexPtr)
#undef Tcl_ConditionNotify
#define Tcl_ConditionNotify(condPtr)
#undef Tcl_ConditionWait
#define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
#undef Tcl_ConditionFinalize
#define Tcl_ConditionFinalize(condPtr)
#endif /* TCL_THREADS */
#endif /* RC_INVOKED */
+3 -3
View File
@@ -22,7 +22,7 @@
*/
#include "tclInt.h"
#if !TCL_THREADS || !defined(USE_THREAD_ALLOC)
#if !defined(TCL_THREADS) || !defined(USE_THREAD_ALLOC)
#if USE_TCLALLOC
@@ -121,7 +121,7 @@ static struct block bigBlocks={ /* Big blocks aren't suballocated. */
* variable.
*/
#if TCL_THREADS
#ifdef TCL_THREADS
static Tcl_Mutex *allocMutexPtr;
#endif
static int allocInit = 0;
@@ -171,7 +171,7 @@ TclInitAlloc(void)
{
if (!allocInit) {
allocInit = 1;
#if TCL_THREADS
#ifdef TCL_THREADS
allocMutexPtr = Tcl_GetAllocMutex();
#endif
}
-2
View File
@@ -406,7 +406,6 @@ static const TalInstDesc TalInstructionTable[] = {
{"jumpTrue", ASSEM_JUMP, INST_JUMP_TRUE1, 1, 0},
{"jumpTrue4", ASSEM_JUMP4, INST_JUMP_TRUE4, 1, 0},
{"label", ASSEM_LABEL, 0, 0, 0},
{"land", ASSEM_1BYTE, INST_LAND, 2, 1},
{"lappend", ASSEM_LVT, (INST_LAPPEND_SCALAR1<<8
| INST_LAPPEND_SCALAR4),
1, 1},
@@ -434,7 +433,6 @@ static const TalInstDesc TalInstructionTable[] = {
| INST_LOAD_ARRAY4), 1, 1},
{"loadArrayStk", ASSEM_1BYTE, INST_LOAD_ARRAY_STK, 2, 1},
{"loadStk", ASSEM_1BYTE, INST_LOAD_STK, 1, 1},
{"lor", ASSEM_1BYTE, INST_LOR, 2, 1},
{"lsetFlat", ASSEM_LSET_FLAT,INST_LSET_FLAT, INT_MIN,1},
{"lsetList", ASSEM_1BYTE, INST_LSET_LIST, 3, 1},
{"lshift", ASSEM_1BYTE, INST_LSHIFT, 2, 1},
+53 -650
View File
@@ -37,18 +37,6 @@
# define MAX_EXACT 9007199254740991.0
#endif
/*
* The following structure defines the client data for a math function
* registered with Tcl_CreateMathFunc
*/
typedef struct OldMathFuncData {
Tcl_MathProc *proc; /* Handler function */
int numArgs; /* Number of args expected */
Tcl_ValueType *argTypes; /* Types of the args */
ClientData clientData; /* Client data for the handler function */
} OldMathFuncData;
/*
* This is the script cancellation struct and hash table. The hash table is
* used to keep track of the information necessary to process script
@@ -132,10 +120,6 @@ static Tcl_NRPostProc NRCoroutineCallerCallback;
static Tcl_NRPostProc NRCoroutineExitCallback;
static Tcl_NRPostProc NRCommand;
#if !defined(TCL_NO_DEPRECATED)
static Tcl_ObjCmdProc OldMathFuncProc;
static void OldMathFuncDeleteProc(ClientData clientData);
#endif /* !defined(TCL_NO_DEPRECATED) */
static void ProcessUnexpectedResult(Tcl_Interp *interp,
int returnCode);
static int RewindCoroutine(CoroutineData *corPtr, int result);
@@ -207,9 +191,6 @@ static const CmdInfo builtInCmds[] = {
{"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE},
{"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE},
{"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE},
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
{"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE},
#endif
{"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE},
{"concat", Tcl_ConcatObjCmd, TclCompileConcatCmd, NULL, CMD_IS_SAFE},
{"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, CMD_IS_SAFE},
@@ -516,13 +497,12 @@ Tcl_CreateInterp(void)
iPtr = ckalloc(sizeof(Interp));
interp = (Tcl_Interp *) iPtr;
#ifdef TCL_NO_DEPRECATED
iPtr->result = &tclEmptyString;
#else
iPtr->result = iPtr->resultSpace;
#endif
iPtr->freeProc = NULL;
iPtr->legacyResult = NULL;
/* Special invalid value: Any attempt to free the legacy result
* will cause a crash. */
iPtr->legacyFreeProc = (void (*) (void))-1;
iPtr->errorLine = 0;
iPtr->stubTable = &tclStubs;
iPtr->objResultPtr = Tcl_NewObj();
Tcl_IncrRefCount(iPtr->objResultPtr);
iPtr->handle = TclHandleCreate(iPtr);
@@ -530,8 +510,7 @@ Tcl_CreateInterp(void)
iPtr->hiddenCmdTablePtr = NULL;
iPtr->interpInfo = NULL;
TCL_CT_ASSERT(sizeof(iPtr->extra) <= sizeof(Tcl_HashTable));
iPtr->extra.optimizer = TclOptimizeBytecode;
iPtr->optimizer = TclOptimizeBytecode;
iPtr->numLevels = 0;
iPtr->maxNestingDepth = MAX_NESTING_DEPTH;
@@ -580,12 +559,6 @@ Tcl_CreateInterp(void)
iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */
iPtr->lookupNsPtr = NULL;
#ifndef TCL_NO_DEPRECATED
iPtr->appendResult = NULL;
iPtr->appendAvl = 0;
iPtr->appendUsed = 0;
#endif
Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
iPtr->packageUnknown = NULL;
@@ -614,9 +587,6 @@ Tcl_CreateInterp(void)
iPtr->emptyObjPtr = Tcl_NewObj();
/* Another empty object. */
Tcl_IncrRefCount(iPtr->emptyObjPtr);
#ifndef TCL_NO_DEPRECATED
iPtr->resultSpace[0] = 0;
#endif
iPtr->threadId = Tcl_GetCurrentThread();
/* TIP #378 */
@@ -726,12 +696,6 @@ Tcl_CreateInterp(void)
memset(statsPtr->literalCount, 0, sizeof(statsPtr->literalCount));
#endif /* TCL_COMPILE_STATS */
/*
* Initialise the stub table pointer.
*/
iPtr->stubTable = &tclStubs;
/*
* Initialize the ensemble error message rewriting support.
*/
@@ -749,7 +713,7 @@ Tcl_CreateInterp(void)
* cache was already initialised by the call to alloc the interp struct.
*/
#if TCL_THREADS && defined(USE_THREAD_ALLOC)
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
iPtr->allocCache = TclpGetAllocCache();
#else
iPtr->allocCache = NULL;
@@ -957,14 +921,9 @@ Tcl_CreateInterp(void)
Tcl_SetVar2(interp, "tcl_patchLevel", NULL, TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY);
Tcl_SetVar2(interp, "tcl_version", NULL, TCL_VERSION, TCL_GLOBAL_ONLY);
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
Tcl_TraceVar2(interp, "tcl_precision", NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
TclPrecTraceProc, NULL);
#endif /* !TCL_NO_DEPRECATED */
TclpSetVariables(interp);
#if TCL_THREADS
#ifdef TCL_THREADS
/*
* The existence of the "threaded" element of the tcl_platform array
* indicates that this particular Tcl shell has been compiled with threads
@@ -1530,7 +1489,6 @@ DeleteInterpProc(
*/
Tcl_FreeResult(interp);
iPtr->result = NULL;
Tcl_DecrRefCount(iPtr->objResultPtr);
iPtr->objResultPtr = NULL;
Tcl_DecrRefCount(iPtr->ecVar);
@@ -1552,12 +1510,6 @@ DeleteInterpProc(
if (iPtr->returnOpts) {
Tcl_DecrRefCount(iPtr->returnOpts);
}
#ifndef TCL_NO_DEPRECATED
if (iPtr->appendResult != NULL) {
ckfree(iPtr->appendResult);
iPtr->appendResult = NULL;
}
#endif
TclFreePackageInfo(iPtr);
while (iPtr->tracePtr != NULL) {
Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr);
@@ -2295,33 +2247,30 @@ Tcl_CreateObjCommand(
}
Tcl_Command
TclCreateObjCommandInNs(
TclCreateObjCommandInNs (
Tcl_Interp *interp,
const char *cmdName, /* Name of command, without any namespace
* components. */
const char *cmdName, /* Name of command, without any namespace components */
Tcl_Namespace *namespace, /* The namespace to create the command in */
Tcl_ObjCmdProc *proc, /* Object-based function to associate with
* name. */
ClientData clientData, /* Arbitrary value to pass to object
* function. */
Tcl_CmdDeleteProc *deleteProc)
Tcl_CmdDeleteProc *deleteProc
/* If not NULL, gives a function to call when
* this command is deleted. */
{
) {
int deleted = 0, isNew = 0;
Command *cmdPtr;
ImportRef *oldRefPtr = NULL;
ImportedCmdData *dataPtr;
Tcl_HashEntry *hPtr;
Namespace *nsPtr = (Namespace *) namespace;
/*
* If the command name we seek to create already exists, we need to delete
* that first. That can be tricky in the presence of traces. Loop until we
* no longer find an existing command in the way, or until we've deleted
* one command and that didn't finish the job.
* If the command name we seek to create already exists, we need to
* delete that first. That can be tricky in the presence of traces.
* Loop until we no longer find an existing command in the way, or
* until we've deleted one command and that didn't finish the job.
*/
while (1) {
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
@@ -2333,18 +2282,16 @@ TclCreateObjCommandInNs(
break;
}
/*
* An existing command conflicts. Try to delete it.
*/
/* An existing command conflicts. Try to delete it.. */
cmdPtr = Tcl_GetHashValue(hPtr);
/*
* [***] This is wrong. See Tcl Bug a16752c252. However, this buggy
* behavior is kept under particular circumstances to accommodate
* deployed binaries of the "tclcompiler" program
* http://sourceforge.net/projects/tclpro/
* that crash if the bug is fixed.
* [***] This is wrong. See Tcl Bug a16752c252.
* However, this buggy behavior is kept under particular
* circumstances to accommodate deployed binaries of the
* "tclcompiler" program. http://sourceforge.net/projects/tclpro/
* that crash if the bug is fixed.
*/
if (cmdPtr->objProc == TclInvokeStringCommand
@@ -2368,15 +2315,12 @@ TclCreateObjCommandInNs(
cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
}
/*
* Make sure namespace doesn't get deallocated.
*/
/* Make sure namespace doesn't get deallocated. */
cmdPtr->nsPtr->refCount++;
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
nsPtr = (Namespace *) TclEnsureNamespace(interp,
(Tcl_Namespace *) cmdPtr->nsPtr);
(Tcl_Namespace *)cmdPtr->nsPtr);
TclNsDecrRefCount(cmdPtr->nsPtr);
if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
@@ -2388,9 +2332,9 @@ TclCreateObjCommandInNs(
}
if (!isNew) {
/*
* If the deletion callback recreated the command, just throw away the
* new command (if we try to delete it again, we could get stuck in an
* infinite loop).
* If the deletion callback recreated the command, just throw away
* the new command (if we try to delete it again, we could get
* stuck in an infinite loop).
*/
ckfree(Tcl_GetHashValue(hPtr));
@@ -2445,7 +2389,6 @@ TclCreateObjCommandInNs(
cmdPtr->importRefPtr = oldRefPtr;
while (oldRefPtr != NULL) {
Command *refCmdPtr = oldRefPtr->importedCmdPtr;
dataPtr = refCmdPtr->objClientData;
dataPtr->realCmdPtr = cmdPtr;
oldRefPtr = oldRefPtr->nextPtr;
@@ -2523,7 +2466,7 @@ TclInvokeStringCommand(
* in the Command structure.
*
* Results:
* A standard Tcl string result value.
* A standard Tcl result value.
*
* Side effects:
* Besides those side effects of the called Tcl_ObjCmdProc,
@@ -2563,13 +2506,6 @@ TclInvokeObjectCommand(
cmdPtr->objClientData, argc, objv);
}
/*
* Move the interpreter's object result to the string result, then reset
* the object result.
*/
(void) Tcl_GetStringResult(interp);
/*
* Decrement the ref counts for the argument objects created above, then
* free the objv array if malloc'ed storage was used.
@@ -3510,362 +3446,6 @@ TclCleanupCommand(
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_CreateMathFunc --
*
* Creates a new math function for expressions in a given interpreter.
*
* Results:
* None.
*
* Side effects:
* The Tcl function defined by "name" is created or redefined. If the
* function already exists then its definition is replaced; this includes
* the builtin functions. Redefining a builtin function forces all
* existing code to be invalidated since that code may be compiled using
* an instruction specific to the replaced function. In addition,
* redefioning a non-builtin function will force existing code to be
* invalidated if the number of arguments has changed.
*
*----------------------------------------------------------------------
*/
#if !defined(TCL_NO_DEPRECATED)
void
Tcl_CreateMathFunc(
Tcl_Interp *interp, /* Interpreter in which function is to be
* available. */
const char *name, /* Name of function (e.g. "sin"). */
int numArgs, /* Nnumber of arguments required by
* function. */
Tcl_ValueType *argTypes, /* Array of types acceptable for each
* argument. */
Tcl_MathProc *proc, /* C function that implements the math
* function. */
ClientData clientData) /* Additional value to pass to the
* function. */
{
Tcl_DString bigName;
OldMathFuncData *data = ckalloc(sizeof(OldMathFuncData));
data->proc = proc;
data->numArgs = numArgs;
data->argTypes = ckalloc(numArgs * sizeof(Tcl_ValueType));
memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType));
data->clientData = clientData;
Tcl_DStringInit(&bigName);
TclDStringAppendLiteral(&bigName, "::tcl::mathfunc::");
Tcl_DStringAppend(&bigName, name, -1);
Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName),
OldMathFuncProc, data, OldMathFuncDeleteProc);
Tcl_DStringFree(&bigName);
}
/*
*----------------------------------------------------------------------
*
* OldMathFuncProc --
*
* Dispatch to a math function created with Tcl_CreateMathFunc
*
* Results:
* Returns a standard Tcl result.
*
* Side effects:
* Whatever the math function does.
*
*----------------------------------------------------------------------
*/
static int
OldMathFuncProc(
ClientData clientData, /* Pointer to OldMathFuncData describing the
* function being called */
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Actual parameter count */
Tcl_Obj *const *objv) /* Parameter vector */
{
Tcl_Obj *valuePtr;
OldMathFuncData *dataPtr = clientData;
Tcl_Value funcResult, *args;
int result;
int j, k;
double d;
/*
* Check argument count.
*/
if (objc != dataPtr->numArgs + 1) {
MathFuncWrongNumArgs(interp, dataPtr->numArgs+1, objc, objv);
return TCL_ERROR;
}
/*
* Convert arguments from Tcl_Obj's to Tcl_Value's.
*/
args = ckalloc(dataPtr->numArgs * sizeof(Tcl_Value));
for (j = 1, k = 0; j < objc; ++j, ++k) {
/* TODO: Convert to TclGetNumberFromObj? */
valuePtr = objv[j];
result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
#ifdef ACCEPT_NAN
if ((result != TCL_OK) && (valuePtr->typePtr == &tclDoubleType)) {
d = valuePtr->internalRep.doubleValue;
result = TCL_OK;
}
#endif
if (result != TCL_OK) {
/*
* We have a non-numeric argument.
*/
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"argument to math function didn't have numeric value",
-1));
TclCheckBadOctal(interp, TclGetString(valuePtr));
ckfree(args);
return TCL_ERROR;
}
/*
* Copy the object's numeric value to the argument record, converting
* it if necessary.
*
* NOTE: no bignum support; use the new mathfunc interface for that.
*/
args[k].type = dataPtr->argTypes[k];
switch (args[k].type) {
case TCL_EITHER:
if (Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue)
== TCL_OK) {
args[k].type = TCL_INT;
break;
}
if (TclGetWideIntFromObj(interp, valuePtr, &args[k].wideValue)
== TCL_OK) {
args[k].type = TCL_WIDE_INT;
break;
}
args[k].type = TCL_DOUBLE;
/* FALLTHROUGH */
case TCL_DOUBLE:
args[k].doubleValue = d;
break;
case TCL_INT:
if (ExprIntFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) {
ckfree(args);
return TCL_ERROR;
}
valuePtr = Tcl_GetObjResult(interp);
Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue);
Tcl_ResetResult(interp);
break;
case TCL_WIDE_INT:
if (ExprWideFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) {
ckfree(args);
return TCL_ERROR;
}
valuePtr = Tcl_GetObjResult(interp);
TclGetWideIntFromObj(NULL, valuePtr, &args[k].wideValue);
Tcl_ResetResult(interp);
break;
}
}
/*
* Call the function.
*/
errno = 0;
result = dataPtr->proc(dataPtr->clientData, interp, args, &funcResult);
ckfree(args);
if (result != TCL_OK) {
return result;
}
/*
* Return the result of the call.
*/
if (funcResult.type == TCL_INT) {
TclNewIntObj(valuePtr, funcResult.intValue);
} else if (funcResult.type == TCL_WIDE_INT) {
valuePtr = Tcl_NewWideIntObj(funcResult.wideValue);
} else {
return CheckDoubleResult(interp, funcResult.doubleValue);
}
Tcl_SetObjResult(interp, valuePtr);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* OldMathFuncDeleteProc --
*
* Cleans up after deleting a math function registered with
* Tcl_CreateMathFunc
*
* Results:
* None.
*
* Side effects:
* Frees allocated memory.
*
*----------------------------------------------------------------------
*/
static void
OldMathFuncDeleteProc(
ClientData clientData)
{
OldMathFuncData *dataPtr = clientData;
ckfree(dataPtr->argTypes);
ckfree(dataPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetMathFuncInfo --
*
* Discovers how a particular math function was created in a given
* interpreter.
*
* Results:
* TCL_OK if it succeeds, TCL_ERROR else (leaving an error message in the
* interpreter result if that happens.)
*
* Side effects:
* If this function succeeds, the variables pointed to by the numArgsPtr
* and argTypePtr arguments will be updated to detail the arguments
* allowed by the function. The variable pointed to by the procPtr
* argument will be set to NULL if the function is a builtin function,
* and will be set to the address of the C function used to implement the
* math function otherwise (in which case the variable pointed to by the
* clientDataPtr argument will also be updated.)
*
*----------------------------------------------------------------------
*/
int
Tcl_GetMathFuncInfo(
Tcl_Interp *interp,
const char *name,
int *numArgsPtr,
Tcl_ValueType **argTypesPtr,
Tcl_MathProc **procPtr,
ClientData *clientDataPtr)
{
Tcl_Obj *cmdNameObj;
Command *cmdPtr;
/*
* Get the command that implements the math function.
*/
TclNewLiteralStringObj(cmdNameObj, "tcl::mathfunc::");
Tcl_AppendToObj(cmdNameObj, name, -1);
Tcl_IncrRefCount(cmdNameObj);
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdNameObj);
Tcl_DecrRefCount(cmdNameObj);
/*
* Report unknown functions.
*/
if (cmdPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"unknown math function \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "MATHFUNC", name, NULL);
*numArgsPtr = -1;
*argTypesPtr = NULL;
*procPtr = NULL;
*clientDataPtr = NULL;
return TCL_ERROR;
}
/*
* Retrieve function info for user defined functions; return dummy
* information for builtins.
*/
if (cmdPtr->objProc == &OldMathFuncProc) {
OldMathFuncData *dataPtr = cmdPtr->clientData;
*procPtr = dataPtr->proc;
*numArgsPtr = dataPtr->numArgs;
*argTypesPtr = dataPtr->argTypes;
*clientDataPtr = dataPtr->clientData;
} else {
*procPtr = NULL;
*numArgsPtr = -1;
*argTypesPtr = NULL;
*procPtr = NULL;
*clientDataPtr = NULL;
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Tcl_ListMathFuncs --
*
* Produces a list of all the math functions defined in a given
* interpreter.
*
* Results:
* A pointer to a Tcl_Obj structure with a reference count of zero, or
* NULL in the case of an error (in which case a suitable error message
* will be left in the interpreter result.)
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
Tcl_ListMathFuncs(
Tcl_Interp *interp,
const char *pattern)
{
Tcl_Obj *script = Tcl_NewStringObj("::info functions ", -1);
Tcl_Obj *result;
Tcl_InterpState state;
if (pattern) {
Tcl_Obj *patternObj = Tcl_NewStringObj(pattern, -1);
Tcl_Obj *arg = Tcl_NewListObj(1, &patternObj);
Tcl_AppendObjToObj(script, arg);
Tcl_DecrRefCount(arg); /* Should tear down patternObj too */
}
state = Tcl_SaveInterpState(interp, TCL_OK);
Tcl_IncrRefCount(script);
if (TCL_OK == Tcl_EvalObjEx(interp, script, 0)) {
result = Tcl_DuplicateObj(Tcl_GetObjResult(interp));
} else {
result = Tcl_NewObj();
}
Tcl_DecrRefCount(script);
Tcl_RestoreInterpState(interp, state);
return result;
}
#endif /* !defined(TCL_NO_DEPRECATED) */
/*
*----------------------------------------------------------------------
*
@@ -3879,7 +3459,7 @@ Tcl_ListMathFuncs(
* otherwise.
*
* Side effects:
* The interpreters object and string results are cleared.
* The interpreter's result is cleared.
*
*----------------------------------------------------------------------
*/
@@ -3891,8 +3471,8 @@ TclInterpReady(
register Interp *iPtr = (Interp *) interp;
/*
* Reset both the interpreter's string and object results and clear out
* any previous error information.
* Reset the interpreter's result and clear out any previous error
* information.
*/
Tcl_ResetResult(interp);
@@ -4472,30 +4052,9 @@ TclNRRunCallbacks(
/* All callbacks down to rootPtr not inclusive
* are to be run. */
{
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
Interp *iPtr = (Interp *) interp;
#endif /* !defined(TCL_NO_DEPRECATED) */
NRE_callback *callbackPtr;
Tcl_NRPostProc *procPtr;
/*
* If the interpreter has a non-empty string result, the result object is
* either empty or stale because some function set interp->result
* directly. If so, move the string result to the result object, then
* reset the string result.
*
* This only needs to be done for the first item in the list: all other
* are for NR function calls, and those are Tcl_Obj based.
*/
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
if (*(iPtr->result) != 0) {
(void) Tcl_GetObjResult(interp);
}
#endif /* !defined(TCL_NO_DEPRECATED) */
/* This is the trampoline. */
while (TOP_CB(interp) != rootPtr) {
callbackPtr = TOP_CB(interp);
procPtr = callbackPtr->procPtr;
@@ -4810,7 +4369,7 @@ TEOV_RunEnterTraces(
{
Interp *iPtr = (Interp *) interp;
Command *cmdPtr = *cmdPtrPtr;
unsigned int newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
size_t newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
int length, traceCode = TCL_OK;
const char *command = TclGetStringFromObj(commandPtr, &length);
@@ -4953,56 +4512,6 @@ Tcl_EvalTokensStandard(
NULL, NULL);
}
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*
*----------------------------------------------------------------------
*
* Tcl_EvalTokens --
*
* Given an array of tokens parsed from a Tcl command (e.g., the tokens
* that make up a word or the index for an array variable) this function
* evaluates the tokens and concatenates their values to form a single
* result value.
*
* Results:
* The return value is a pointer to a newly allocated Tcl_Obj containing
* the value of the array of tokens. The reference count of the returned
* object has been incremented. If an error occurs in evaluating the
* tokens then a NULL value is returned and an error message is left in
* interp's result.
*
* Side effects:
* A new object is allocated to hold the result.
*
*----------------------------------------------------------------------
*
* This uses a non-standard return convention; its use is now deprecated. It
* is a wrapper for the new function Tcl_EvalTokensStandard, and is not used
* in the core any longer. It is only kept for backward compatibility.
*/
Tcl_Obj *
Tcl_EvalTokens(
Tcl_Interp *interp, /* Interpreter in which to lookup variables,
* execute nested commands, and report
* errors. */
Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to
* evaluate and concatenate. */
int count) /* Number of tokens to consider at tokenPtr.
* Must be at least 1. */
{
Tcl_Obj *resPtr;
if (Tcl_EvalTokensStandard(interp, tokenPtr, count) != TCL_OK) {
return NULL;
}
resPtr = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(resPtr);
Tcl_ResetResult(interp);
return resPtr;
}
#endif /* !TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
*
@@ -5965,50 +5474,7 @@ Tcl_Eval(
* previous call to Tcl_CreateInterp). */
const char *script) /* Pointer to TCL command to execute. */
{
int code = Tcl_EvalEx(interp, script, -1, 0);
/*
* For backwards compatibility with old C code that predates the object
* system in Tcl 8.0, we have to mirror the object result back into the
* string result (some callers may expect it there).
*/
(void) Tcl_GetStringResult(interp);
return code;
}
/*
*----------------------------------------------------------------------
*
* Tcl_EvalObj, Tcl_GlobalEvalObj --
*
* These functions are deprecated but we keep them around for backwards
* compatibility reasons.
*
* Results:
* See the functions they call.
*
* Side effects:
* See the functions they call.
*
*----------------------------------------------------------------------
*/
#undef Tcl_EvalObj
int
Tcl_EvalObj(
Tcl_Interp *interp,
Tcl_Obj *objPtr)
{
return Tcl_EvalObjEx(interp, objPtr, 0);
}
#undef Tcl_GlobalEvalObj
int
Tcl_GlobalEvalObj(
Tcl_Interp *interp,
Tcl_Obj *objPtr)
{
return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
return Tcl_EvalEx(interp, script, -1, 0);
}
#endif /* TCL_NO_DEPRECATED */
@@ -6397,9 +5863,6 @@ Tcl_ExprLong(
Tcl_IncrRefCount(exprPtr);
result = Tcl_ExprLongObj(interp, exprPtr, ptr);
Tcl_DecrRefCount(exprPtr);
if (result != TCL_OK) {
(void) Tcl_GetStringResult(interp);
}
}
return result;
}
@@ -6426,9 +5889,6 @@ Tcl_ExprDouble(
result = Tcl_ExprDoubleObj(interp, exprPtr, ptr);
Tcl_DecrRefCount(exprPtr);
/* Discard the expression object. */
if (result != TCL_OK) {
(void) Tcl_GetStringResult(interp);
}
}
return result;
}
@@ -6454,14 +5914,6 @@ Tcl_ExprBoolean(
Tcl_IncrRefCount(exprPtr);
result = Tcl_ExprBooleanObj(interp, exprPtr, ptr);
Tcl_DecrRefCount(exprPtr);
if (result != TCL_OK) {
/*
* Move the interpreter's object result to the string result, then
* reset the object result.
*/
(void) Tcl_GetStringResult(interp);
}
return result;
}
}
@@ -6775,12 +6227,6 @@ Tcl_ExprString(
Tcl_DecrRefCount(resultPtr);
}
}
/*
* Force the string rep of the interp result.
*/
(void) Tcl_GetStringResult(interp);
return code;
}
@@ -6887,20 +6333,7 @@ Tcl_AddObjErrorInfo(
iPtr->flags |= ERR_LEGACY_COPY;
if (iPtr->errorInfo == NULL) {
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
if (*(iPtr->result) != 0) {
/*
* The interp's string result is set, apparently by some extension
* making a deprecated direct write to it. That extension may
* expect interp->result to continue to be set, so we'll take
* special pains to avoid clearing it, until we drop support for
* interp->result completely.
*/
iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1);
} else
#endif /* !defined(TCL_NO_DEPRECATED) */
iPtr->errorInfo = iPtr->objResultPtr;
iPtr->errorInfo = iPtr->objResultPtr;
Tcl_IncrRefCount(iPtr->errorInfo);
if (!iPtr->errorCode) {
Tcl_SetErrorCode(interp, "NONE", NULL);
@@ -6922,32 +6355,34 @@ Tcl_AddObjErrorInfo(
}
/*
*---------------------------------------------------------------------------
*----------------------------------------------------------------------
*
* Tcl_VarEvalVA --
* Tcl_VarEval --
*
* Given a variable number of string arguments, concatenate them all
* together and execute the result as a Tcl command.
*
* Results:
* A standard Tcl return result. An error message or other result may be
* left in the interp's result.
* left in the interp.
*
* Side effects:
* Depends on what was done by the command.
*
*---------------------------------------------------------------------------
*----------------------------------------------------------------------
*/
/* ARGSUSED */
int
Tcl_VarEvalVA(
Tcl_Interp *interp, /* Interpreter in which to evaluate command */
va_list argList) /* Variable argument list. */
Tcl_VarEval(
Tcl_Interp *interp,
...)
{
va_list argList;
int result;
Tcl_DString buf;
char *string;
int result;
va_start(argList, interp);
/*
* Copy the strings one after the other into a single larger string. Use
* stack-allocated space for small commands, but if the command gets too
@@ -6968,39 +6403,6 @@ Tcl_VarEvalVA(
return result;
}
/*
*----------------------------------------------------------------------
*
* Tcl_VarEval --
*
* Given a variable number of string arguments, concatenate them all
* together and execute the result as a Tcl command.
*
* Results:
* A standard Tcl return result. An error message or other result may be
* left in interp->result.
*
* Side effects:
* Depends on what was done by the command.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
int
Tcl_VarEval(
Tcl_Interp *interp,
...)
{
va_list argList;
int result;
va_start(argList, interp);
result = Tcl_VarEvalVA(interp, argList);
va_end(argList);
return result;
}
/*
*----------------------------------------------------------------------
*
@@ -8285,26 +7687,23 @@ Tcl_NRCreateCommand(
* this command is deleted. */
{
Command *cmdPtr = (Command *)
Tcl_CreateObjCommand(interp, cmdName, proc, clientData,
deleteProc);
Tcl_CreateObjCommand(interp,cmdName,proc,clientData,deleteProc);
cmdPtr->nreProc = nreProc;
return (Tcl_Command) cmdPtr;
}
Tcl_Command
TclNRCreateCommandInNs(
TclNRCreateCommandInNs (
Tcl_Interp *interp,
const char *cmdName,
Tcl_Namespace *nsPtr,
Tcl_ObjCmdProc *proc,
Tcl_ObjCmdProc *nreProc,
ClientData clientData,
Tcl_CmdDeleteProc *deleteProc)
{
Tcl_CmdDeleteProc *deleteProc) {
Command *cmdPtr = (Command *)
TclCreateObjCommandInNs(interp, cmdName, nsPtr, proc, clientData,
deleteProc);
TclCreateObjCommandInNs(interp,cmdName,nsPtr,proc,clientData,deleteProc);
cmdPtr->nreProc = nreProc;
return (Tcl_Command) cmdPtr;
@@ -8408,6 +7807,7 @@ TclPushTailcallPoint(
TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
((Interp *) interp)->numLevels++;
}
/*
*----------------------------------------------------------------------
@@ -8443,6 +7843,7 @@ TclSetTailcall(
}
runPtr->data[1] = listPtr;
}
/*
*----------------------------------------------------------------------
@@ -8518,6 +7919,7 @@ TclNRTailcallObjCmd(
}
return TCL_RETURN;
}
/*
*----------------------------------------------------------------------
@@ -8585,6 +7987,7 @@ TclNRReleaseValues(
}
return result;
}
void
Tcl_NRAddCallback(
+1 -1
View File
@@ -267,7 +267,7 @@ const Tcl_ObjType tclByteArrayType = {
* fewer mallocs.
*/
typedef struct ByteArray {
typedef struct {
int used; /* The number of bytes used in the byte
* array. */
int allocated; /* The amount of space actually allocated
+2 -2
View File
@@ -33,7 +33,7 @@
* "memory tag" command is invoked, to hold the current tag.
*/
typedef struct MemTag {
typedef struct {
size_t refCount; /* Number of mem_headers referencing this
* tag. */
char string[1]; /* Actual size of string will be as large as
@@ -156,7 +156,7 @@ TclInitDbCkalloc(void)
if (!ckallocInit) {
ckallocInit = 1;
ckallocMutexPtr = Tcl_GetAllocMutex();
#if !TCL_THREADS
#ifndef TCL_THREADS
/* Silence compiler warning */
(void)ckallocMutexPtr;
#endif
+1 -1
View File
@@ -100,7 +100,7 @@ typedef struct {
* Structure containing the fields used in [clock format] and [clock scan]
*/
typedef struct TclDateFields {
typedef struct {
Tcl_WideInt seconds; /* Time expressed in seconds from the Posix
* epoch */
Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds
-137
View File
@@ -147,143 +147,6 @@ Tcl_BreakObjCmd(
return TCL_BREAK;
}
/*
*----------------------------------------------------------------------
*
* Tcl_CaseObjCmd --
*
* This procedure is invoked to process the "case" Tcl command. See the
* user documentation for details on what it does. THIS COMMAND IS
* OBSOLETE AND DEPRECATED. SLATED FOR REMOVAL IN TCL 9.0.
*
* Results:
* A standard Tcl object result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/* ARGSUSED */
int
Tcl_CaseObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
register int i;
int body, result, caseObjc;
const char *stringPtr, *arg;
Tcl_Obj *const *caseObjv;
Tcl_Obj *armPtr;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv,
"string ?in? ?pattern body ...? ?default body?");
return TCL_ERROR;
}
stringPtr = TclGetString(objv[1]);
body = -1;
arg = TclGetString(objv[2]);
if (strcmp(arg, "in") == 0) {
i = 3;
} else {
i = 2;
}
caseObjc = objc - i;
caseObjv = objv + i;
/*
* If all of the pattern/command pairs are lumped into a single argument,
* split them out again.
*/
if (caseObjc == 1) {
Tcl_Obj **newObjv;
TclListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv);
caseObjv = newObjv;
}
for (i = 0; i < caseObjc; i += 2) {
int patObjc, j;
const char **patObjv;
const char *pat, *p;
if (i == caseObjc-1) {
Tcl_ResetResult(interp);
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"extra case pattern with no body", -1));
return TCL_ERROR;
}
/*
* Check for special case of single pattern (no list) with no
* backslash sequences.
*/
pat = TclGetString(caseObjv[i]);
for (p = pat; *p != '\0'; p++) {
if (TclIsSpaceProc(*p) || (*p == '\\')) {
break;
}
}
if (*p == '\0') {
if ((*pat == 'd') && (strcmp(pat, "default") == 0)) {
body = i + 1;
}
if (Tcl_StringMatch(stringPtr, pat)) {
body = i + 1;
goto match;
}
continue;
}
/*
* Break up pattern lists, then check each of the patterns in the
* list.
*/
result = Tcl_SplitList(interp, pat, &patObjc, &patObjv);
if (result != TCL_OK) {
return result;
}
for (j = 0; j < patObjc; j++) {
if (Tcl_StringMatch(stringPtr, patObjv[j])) {
body = i + 1;
break;
}
}
ckfree(patObjv);
if (j < patObjc) {
break;
}
}
match:
if (body != -1) {
armPtr = caseObjv[body - 1];
result = Tcl_EvalObjEx(interp, caseObjv[body], 0);
if (result == TCL_ERROR) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (\"%.50s\" arm line %d)",
TclGetString(armPtr), Tcl_GetErrorLine(interp)));
}
return result;
}
/*
* Nothing matched: return nothing.
*/
return TCL_OK;
}
#endif /* !TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
*
+1 -1
View File
@@ -56,7 +56,7 @@ typedef int (*SortMemCmpFn_t) (const void *, const void *, size_t);
* The following structure is used to pass this information.
*/
typedef struct SortInfo {
typedef struct {
int isIncreasing; /* Nonzero means sort in increasing order. */
int sortMode; /* The sort mode. One of SORTMODE_* values
* defined below. */
+182 -51
View File
@@ -597,9 +597,9 @@ Tcl_RegsubObjCmd(
* slightly modified version of the one pair STR_MAP code.
*/
int slen, nocase, wsrclc;
int slen, nocase;
int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long);
Tcl_UniChar *p;
Tcl_UniChar *p, wsrclc;
numMatches = 0;
nocase = (cflags & TCL_REG_NOCASE);
@@ -1576,11 +1576,9 @@ StringIsCmd(
string1 = TclGetStringFromObj(objPtr, &length1);
result = length1 == 0;
}
} else if (index != STR_IS_BOOL) {
TclGetBooleanFromObj(NULL, objPtr, &i);
if ((index == STR_IS_TRUE) ^ i) {
result = 0;
}
} else if ((objPtr->internalRep.wideValue != 0)
? (index == STR_IS_FALSE) : (index == STR_IS_TRUE)) {
result = 0;
}
break;
case STR_IS_CONTROL:
@@ -2001,8 +1999,8 @@ StringMapCmd(
* larger strings.
*/
int mapLen, u2lc;
Tcl_UniChar *mapString;
int mapLen;
Tcl_UniChar *mapString, u2lc;
ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2);
p = ustring1;
@@ -2033,8 +2031,8 @@ StringMapCmd(
}
}
} else {
Tcl_UniChar **mapStrings;
int *mapLens, *u2lc = NULL;
Tcl_UniChar **mapStrings, *u2lc = NULL;
int *mapLens;
/*
* Precompute pointers to the unicode string and length. This saves us
@@ -2046,7 +2044,7 @@ StringMapCmd(
mapStrings = TclStackAlloc(interp, mapElemc*2*sizeof(Tcl_UniChar *));
mapLens = TclStackAlloc(interp, mapElemc * 2 * sizeof(int));
if (nocase) {
u2lc = TclStackAlloc(interp, mapElemc * sizeof(int));
u2lc = TclStackAlloc(interp, mapElemc * sizeof(Tcl_UniChar));
}
for (index = 0; index < mapElemc; index++) {
mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index],
@@ -2546,8 +2544,10 @@ StringEqualCmd(
* the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
*/
const char *string2;
int length, i, match, nocase = 0, reqlength = -1;
const char *string1, *string2;
int length1, length2, i, match, length, nocase = 0, reqlength = -1;
typedef int (*strCmpFn_t)(const char *, const char *, unsigned int);
strCmpFn_t strCmpFn;
if (objc < 3 || objc > 6) {
str_cmp_args:
@@ -2557,11 +2557,11 @@ StringEqualCmd(
}
for (i = 1; i < objc-2; i++) {
string2 = TclGetStringFromObj(objv[i], &length);
if ((length > 1) && !strncmp(string2, "-nocase", (size_t)length)) {
string2 = TclGetStringFromObj(objv[i], &length2);
if ((length2 > 1) && !strncmp(string2, "-nocase", (size_t)length2)) {
nocase = 1;
} else if ((length > 1)
&& !strncmp(string2, "-length", (size_t)length)) {
} else if ((length2 > 1)
&& !strncmp(string2, "-length", (size_t)length2)) {
if (i+1 >= objc-2) {
goto str_cmp_args;
}
@@ -2586,7 +2586,78 @@ StringEqualCmd(
objv += objc-2;
match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength);
if ((reqlength == 0) || (objv[0] == objv[1])) {
/*
* Always match at 0 chars of if it is the same obj.
*/
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
return TCL_OK;
}
if (!nocase && TclIsPureByteArray(objv[0]) &&
TclIsPureByteArray(objv[1])) {
/*
* Use binary versions of comparisons since that won't cause undue
* type conversions and it is much faster. Only do this if we're
* case-sensitive (which is all that really makes sense with byte
* arrays anyway, and we have no memcasecmp() for some reason... :^)
*/
string1 = (char *) Tcl_GetByteArrayFromObj(objv[0], &length1);
string2 = (char *) Tcl_GetByteArrayFromObj(objv[1], &length2);
strCmpFn = (strCmpFn_t) memcmp;
} else if ((objv[0]->typePtr == &tclStringType)
&& (objv[1]->typePtr == &tclStringType)) {
/*
* Do a unicode-specific comparison if both of the args are of String
* type. In benchmark testing this proved the most efficient check
* between the unicode and string comparison operations.
*/
string1 = (char *) Tcl_GetUnicodeFromObj(objv[0], &length1);
string2 = (char *) Tcl_GetUnicodeFromObj(objv[1], &length2);
strCmpFn = (strCmpFn_t)
(nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
} else {
/*
* As a catch-all we will work with UTF-8. We cannot use memcmp() as
* that is unsafe with any string containing NUL (\xC0\x80 in Tcl's
* utf rep). We can use the more efficient TclpUtfNcmp2 if we are
* case-sensitive and no specific length was requested.
*/
string1 = (char *) TclGetStringFromObj(objv[0], &length1);
string2 = (char *) TclGetStringFromObj(objv[1], &length2);
if ((reqlength < 0) && !nocase) {
strCmpFn = (strCmpFn_t) TclpUtfNcmp2;
} else {
length1 = Tcl_NumUtfChars(string1, length1);
length2 = Tcl_NumUtfChars(string2, length2);
strCmpFn = (strCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
}
}
if ((reqlength < 0) && (length1 != length2)) {
match = 1; /* This will be reversed below. */
} else {
length = (length1 < length2) ? length1 : length2;
if (reqlength > 0 && reqlength < length) {
length = reqlength;
} else if (reqlength < 0) {
/*
* The requested length is negative, so we ignore it by setting it
* to length + 1 so we correct the match var.
*/
reqlength = length + 1;
}
match = strCmpFn(string1, string2, (unsigned) length);
if ((match == 0) && (reqlength > length)) {
match = length1 - length2;
}
}
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1));
return TCL_OK;
@@ -2623,31 +2694,11 @@ StringCmpCmd(
* the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
*/
int match, nocase, reqlength, status;
const char *string1, *string2;
int length1, length2, i, match, length, nocase = 0, reqlength = -1;
typedef int (*strCmpFn_t)(const char *, const char *, unsigned int);
strCmpFn_t strCmpFn;
status = TclStringCmpOpts(interp, objc, objv, &nocase, &reqlength);
if (status != TCL_OK) {
return status;
}
objv += objc-2;
match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength);
Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
return TCL_OK;
}
int TclStringCmpOpts(
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[], /* Argument objects. */
int *nocase,
int *reqlength)
{
int i, length;
const char *string;
*reqlength = -1;
*nocase = 0;
if (objc < 3 || objc > 6) {
str_cmp_args:
Tcl_WrongNumArgs(interp, 1, objv,
@@ -2656,27 +2707,106 @@ int TclStringCmpOpts(
}
for (i = 1; i < objc-2; i++) {
string = TclGetStringFromObj(objv[i], &length);
if ((length > 1) && !strncmp(string, "-nocase", (size_t)length)) {
*nocase = 1;
} else if ((length > 1)
&& !strncmp(string, "-length", (size_t)length)) {
string2 = TclGetStringFromObj(objv[i], &length2);
if ((length2 > 1) && !strncmp(string2, "-nocase", (size_t)length2)) {
nocase = 1;
} else if ((length2 > 1)
&& !strncmp(string2, "-length", (size_t)length2)) {
if (i+1 >= objc-2) {
goto str_cmp_args;
}
i++;
if (TclGetIntFromObj(interp, objv[i], reqlength) != TCL_OK) {
if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
return TCL_ERROR;
}
} else {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad option \"%s\": must be -nocase or -length",
string));
string2));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
string, NULL);
string2, NULL);
return TCL_ERROR;
}
}
/*
* From now on, we only access the two objects at the end of the argument
* array.
*/
objv += objc-2;
if ((reqlength == 0) || (objv[0] == objv[1])) {
/*
* Always match at 0 chars of if it is the same obj.
*/
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
return TCL_OK;
}
if (!nocase && TclIsPureByteArray(objv[0]) &&
TclIsPureByteArray(objv[1])) {
/*
* Use binary versions of comparisons since that won't cause undue
* type conversions and it is much faster. Only do this if we're
* case-sensitive (which is all that really makes sense with byte
* arrays anyway, and we have no memcasecmp() for some reason... :^)
*/
string1 = (char *) Tcl_GetByteArrayFromObj(objv[0], &length1);
string2 = (char *) Tcl_GetByteArrayFromObj(objv[1], &length2);
strCmpFn = (strCmpFn_t) memcmp;
} else if ((objv[0]->typePtr == &tclStringType)
&& (objv[1]->typePtr == &tclStringType)) {
/*
* Do a unicode-specific comparison if both of the args are of String
* type. In benchmark testing this proved the most efficient check
* between the unicode and string comparison operations.
*/
string1 = (char *) Tcl_GetUnicodeFromObj(objv[0], &length1);
string2 = (char *) Tcl_GetUnicodeFromObj(objv[1], &length2);
strCmpFn = (strCmpFn_t)
(nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
} else {
/*
* As a catch-all we will work with UTF-8. We cannot use memcmp() as
* that is unsafe with any string containing NUL (\xC0\x80 in Tcl's
* utf rep). We can use the more efficient TclpUtfNcmp2 if we are
* case-sensitive and no specific length was requested.
*/
string1 = (char *) TclGetStringFromObj(objv[0], &length1);
string2 = (char *) TclGetStringFromObj(objv[1], &length2);
if ((reqlength < 0) && !nocase) {
strCmpFn = (strCmpFn_t) TclpUtfNcmp2;
} else {
length1 = Tcl_NumUtfChars(string1, length1);
length2 = Tcl_NumUtfChars(string2, length2);
strCmpFn = (strCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
}
}
length = (length1 < length2) ? length1 : length2;
if (reqlength > 0 && reqlength < length) {
length = reqlength;
} else if (reqlength < 0) {
/*
* The requested length is negative, so we ignore it by setting it to
* length + 1 so we correct the match var.
*/
reqlength = length + 1;
}
match = strCmpFn(string1, string2, (unsigned) length);
if ((match == 0) && (reqlength > length)) {
match = length1 - length2;
}
Tcl_SetObjResult(interp,
Tcl_NewIntObj((match > 0) ? 1 : (match < 0) ? -1 : 0));
return TCL_OK;
}
@@ -2742,6 +2872,7 @@ StringCatCmd(
*
*----------------------------------------------------------------------
*/
static int
StringBytesCmd(
ClientData dummy, /* Not used. */
+21 -23
View File
@@ -27,6 +27,7 @@ static void CompileReturnInternal(CompileEnv *envPtr,
Tcl_Obj *returnOpts);
static int IndexTailVarIfKnown(Tcl_Interp *interp,
Tcl_Token *varTokenPtr, CompileEnv *envPtr);
/*
*----------------------------------------------------------------------
@@ -126,12 +127,9 @@ TclCompileGlobalCmd(
return TCL_ERROR;
}
/*
* TODO: Consider what value can pass through the
* IndexTailVarIfKnown() screen. Full CompileWord() likely does not
* apply here. Push known value instead.
*/
/* TODO: Consider what value can pass through the
* IndexTailVarIfKnown() screen. Full CompileWord()
* likely does not apply here. Push known value instead. */
CompileWord(envPtr, varTokenPtr, interp, i);
TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr);
}
@@ -272,7 +270,7 @@ TclCompileIfCmd(
jumpIndex = jumpFalseFixupArray.next;
jumpFalseFixupArray.next++;
TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
jumpFalseFixupArray.fixup + jumpIndex);
jumpFalseFixupArray.fixup+jumpIndex);
}
code = TCL_OK;
}
@@ -319,7 +317,7 @@ TclCompileIfCmd(
}
jumpEndFixupArray.next++;
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
jumpEndFixupArray.fixup + jumpIndex);
jumpEndFixupArray.fixup+jumpIndex);
/*
* Fix the target of the jumpFalse after the test. Generate a 4
@@ -331,7 +329,7 @@ TclCompileIfCmd(
TclAdjustStackDepth(-1, envPtr);
if (TclFixupForwardJumpToHere(envPtr,
jumpFalseFixupArray.fixup + jumpIndex, 120)) {
jumpFalseFixupArray.fixup+jumpIndex, 120)) {
/*
* Adjust the code offset for the proceeding jump to the end
* of the "if" command.
@@ -414,7 +412,7 @@ TclCompileIfCmd(
for (j = jumpEndFixupArray.next; j > 0; j--) {
jumpIndex = (j - 1); /* i.e. process the closest jump first. */
if (TclFixupForwardJumpToHere(envPtr,
jumpEndFixupArray.fixup + jumpIndex, 127)) {
jumpEndFixupArray.fixup+jumpIndex, 127)) {
/*
* Adjust the immediately preceeding "ifFalse" jump. We moved it's
* target (just after this jump) down three bytes.
@@ -922,7 +920,7 @@ TclCompileLappendCmd(
CompileWord(envPtr, valueTokenPtr, interp, i);
valueTokenPtr = TokenAfter(valueTokenPtr);
}
TclEmitInstInt4( INST_LIST, numWords - 2, envPtr);
TclEmitInstInt4( INST_LIST, numWords-2, envPtr);
if (isScalar) {
if (localIndex < 0) {
TclEmitOpcode( INST_LAPPEND_LIST_STK, envPtr);
@@ -999,7 +997,7 @@ TclCompileLassignCmd(
*/
PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex,
&isScalar, idx + 2);
&isScalar, idx+2);
/*
* Emit instructions to get the idx'th item out of the list value on
@@ -1416,7 +1414,7 @@ TclCompileLinsertCmd(
tokenPtr = TokenAfter(tokenPtr);
CompileWord(envPtr, tokenPtr, interp, i);
}
TclEmitInstInt4( INST_LIST, i - 3, envPtr);
TclEmitInstInt4( INST_LIST, i-3, envPtr);
if (idx == TCL_INDEX_START) {
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
@@ -1441,7 +1439,7 @@ TclCompileLinsertCmd(
}
TclEmitInstInt4( INST_OVER, 1, envPtr);
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
TclEmitInt4( idx - 1, envPtr);
TclEmitInt4( idx-1, envPtr);
TclEmitInstInt4( INST_REVERSE, 3, envPtr);
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr);
TclEmitInt4( TCL_INDEX_END, envPtr);
@@ -2236,7 +2234,7 @@ TclCompileRegexpCmd(
}
if (!simple) {
CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords - 2);
CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-2);
}
/*
@@ -2244,7 +2242,7 @@ TclCompileRegexpCmd(
*/
varTokenPtr = TokenAfter(varTokenPtr);
CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords - 1);
CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-1);
if (simple) {
if (exact && !nocase) {
@@ -2428,7 +2426,7 @@ TclCompileRegsubCmd(
PushLiteral(envPtr, bytes, len);
bytes = TclGetStringFromObj(replacementObj, &len);
PushLiteral(envPtr, bytes, len);
CompileWord(envPtr, stringTokenPtr, interp, parsePtr->numWords - 2);
CompileWord(envPtr, stringTokenPtr, interp, parsePtr->numWords-2);
TclEmitOpcode( INST_STR_MAP, envPtr);
done:
@@ -2557,7 +2555,7 @@ TclCompileReturnCmd(
*/
if (explicitResult) {
CompileWord(envPtr, wordTokenPtr, interp, numWords - 1);
CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
} else {
/*
* No explict result argument, so default result is empty string.
@@ -2635,7 +2633,7 @@ TclCompileReturnCmd(
*/
if (explicitResult) {
CompileWord(envPtr, wordTokenPtr, interp, numWords - 1);
CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
} else {
PushStringLiteral(envPtr, "");
}
@@ -2866,12 +2864,12 @@ TclCompileVariableCmd(
CompileWord(envPtr, varTokenPtr, interp, i);
TclEmitInstInt4( INST_VARIABLE, localIndex, envPtr);
if (i + 1 < numWords) {
if (i+1 < numWords) {
/*
* A value has been given: set the variable, pop the value
*/
CompileWord(envPtr, valueTokenPtr, interp, i + 1);
CompileWord(envPtr, valueTokenPtr, interp, i+1);
Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr);
TclEmitOpcode( INST_POP, envPtr);
}
@@ -2947,7 +2945,7 @@ IndexTailVarIfKnown(
tailName = TclGetStringFromObj(tailPtr, &len);
if (len) {
if (*(tailName + len - 1) == ')') {
if (*(tailName+len-1) == ')') {
/*
* Possible array: bail out
*/
@@ -2961,7 +2959,7 @@ IndexTailVarIfKnown(
*/
for (p = tailName + len -1; p > tailName; p--) {
if ((*p == ':') && (*(p - 1) == ':')) {
if ((*p == ':') && (*(p-1) == ':')) {
p++;
break;
}
+1 -1
View File
@@ -22,7 +22,7 @@
* The tree is composed of OpNodes.
*/
typedef struct OpNode {
typedef struct {
int left; /* "Pointer" to the left operand. */
int right; /* "Pointer" to the right operand. */
union {
+4 -22
View File
@@ -129,10 +129,6 @@ InstructionDesc const tclInstructionTable[] = {
{"jumpFalse4", 5, -1, 1, {OPERAND_OFFSET4}},
/* Jump relative to (pc + op4) if stktop expr object is false */
{"lor", 1, -1, 0, {OPERAND_NONE}},
/* Logical or: push (stknext || stktop) */
{"land", 1, -1, 0, {OPERAND_NONE}},
/* Logical and: push (stknext && stktop) */
{"bitor", 1, -1, 0, {OPERAND_NONE}},
/* Bitwise or: push (stknext | stktop) */
{"bitxor", 1, -1, 0, {OPERAND_NONE}},
@@ -173,10 +169,6 @@ InstructionDesc const tclInstructionTable[] = {
/* Bitwise not: push ~stktop */
{"not", 1, 0, 0, {OPERAND_NONE}},
/* Logical not: push !stktop */
{"callBuiltinFunc1", 2, 1, 1, {OPERAND_UINT1}},
/* Call builtin math function with index op1; any args are on stk */
{"callFunc1", 2, INT_MIN, 1, {OPERAND_UINT1}},
/* Call non-builtin func objv[0]; <objc,objv>=<op1,top op1> */
{"tryCvtToNumeric", 1, 0, 0, {OPERAND_NONE}},
/* Try converting stktop to first int then double if possible. */
@@ -186,13 +178,6 @@ InstructionDesc const tclInstructionTable[] = {
/* Skip to next iteration of closest enclosing loop; if none, return
* TCL_CONTINUE code. */
{"foreach_start4", 5, 0, 1, {OPERAND_AUX4}},
/* Initialize execution of a foreach loop. Operand is aux data index
* of the ForeachInfo structure for the foreach command. */
{"foreach_step4", 5, +1, 1, {OPERAND_AUX4}},
/* "Step" or begin next iteration of foreach loop. Push 0 if to
* terminate loop, else push 1. */
{"beginCatch4", 5, 0, 1, {OPERAND_UINT4}},
/* Record start of catch with the operand's exception index. Push the
* current stack depth onto a special catch stack. */
@@ -340,9 +325,6 @@ InstructionDesc const tclInstructionTable[] = {
{"dictNext", 5, +3, 1, {OPERAND_LVT4}},
/* Get the next iteration from the iterator in op4's local scalar.
* Stack: ... => ... value key doneBool */
{"dictDone", 5, 0, 1, {OPERAND_LVT4}},
/* Terminate the iterator in op4's local scalar. Use unsetScalar
* instead (with 0 for flags). */
{"dictUpdateStart", 9, 0, 2, {OPERAND_LVT4, OPERAND_AUX4}},
/* Create the variables (described in the aux data referred to by the
* second immediate argument) to mirror the state of the dictionary in
@@ -853,8 +835,8 @@ TclSetByteCodeFromAny(
* instruction generator boundaries.
*/
if (iPtr->extra.optimizer) {
(iPtr->extra.optimizer)(&compEnv);
if (iPtr->optimizer) {
(iPtr->optimizer)(&compEnv);
}
/*
@@ -1132,7 +1114,7 @@ CleanupByteCode(
}
}
if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) {
if (codePtr->localCachePtr && (codePtr->localCachePtr->refCount-- <= 1)) {
TclFreeLocalCache(interp, codePtr->localCachePtr);
}
@@ -1428,7 +1410,7 @@ TclInitCompileEnv(
{
Interp *iPtr = (Interp *) interp;
assert(tclInstructionTable[LAST_INST_OPCODE+1].name == NULL);
assert(tclInstructionTable[LAST_INST_OPCODE].name == NULL);
envPtr->iPtr = iPtr;
envPtr->source = stringPtr;
+243 -263
View File
@@ -87,7 +87,7 @@ typedef enum {
* to a catch PC offset. */
} ExceptionRangeType;
typedef struct ExceptionRange {
typedef struct {
ExceptionRangeType type; /* The kind of ExceptionRange. */
int nestingLevel; /* Static depth of the exception range. Used
* to find the most deeply-nested range
@@ -162,7 +162,7 @@ typedef struct ExceptionAux {
* source offset is not monotonic.
*/
typedef struct CmdLocation {
typedef struct {
int codeOffset; /* Offset of first byte of command code. */
int numCodeBytes; /* Number of bytes for command's code. */
int srcOffset; /* Offset of first char of the command. */
@@ -180,7 +180,7 @@ typedef struct CmdLocation {
* frame and associated information, like the path of a sourced file.
*/
typedef struct ECL {
typedef struct {
int srcOffset; /* Command location to find the entry. */
int nline; /* Number of words in the command */
int *line; /* Line information for all words in the
@@ -190,7 +190,7 @@ typedef struct ECL {
* lines. */
} ECL;
typedef struct ExtCmdLoc {
typedef struct {
int type; /* Context type. */
int start; /* Starting line for compiled script. Needed
* for the extended recompile check in
@@ -417,7 +417,7 @@ typedef struct ByteCode {
* procs are specific to an interpreter so the
* code emitted will depend on the
* interpreter. */
unsigned int compileEpoch; /* Value of iPtr->compileEpoch when this
size_t compileEpoch; /* Value of iPtr->compileEpoch when this
* ByteCode was compiled. Used to invalidate
* code when, e.g., commands with compile
* procs are redefined. */
@@ -425,11 +425,11 @@ typedef struct ByteCode {
* compiled. If the code is executed if a
* different namespace, it must be
* recompiled. */
unsigned int nsEpoch; /* Value of nsPtr->resolverEpoch when this
size_t nsEpoch; /* Value of nsPtr->resolverEpoch when this
* ByteCode was compiled. Used to invalidate
* code when new namespace resolution rules
* are put into effect. */
unsigned int refCount; /* Reference count: set 1 when created plus 1
size_t refCount; /* Reference count: set 1 when created plus 1
* for each execution of the code currently
* active. This structure can be freed when
* refCount becomes zero. */
@@ -519,312 +519,292 @@ typedef struct ByteCode {
* Opcodes for the Tcl bytecode instructions. These must correspond to the
* entries in the table of instruction descriptions, tclInstructionTable, in
* tclCompile.c. Also, the order and number of the expression opcodes (e.g.,
* INST_LOR) must match the entries in the array operatorStrings in
* INST_BITOR) must match the entries in the array operatorStrings in
* tclExecute.c.
*/
/* Opcodes 0 to 9 */
#define INST_DONE 0
#define INST_PUSH1 1
#define INST_PUSH4 2
#define INST_POP 3
#define INST_DUP 4
#define INST_STR_CONCAT1 5
#define INST_INVOKE_STK1 6
#define INST_INVOKE_STK4 7
#define INST_EVAL_STK 8
#define INST_EXPR_STK 9
enum TclInstruction {
/* Opcodes 10 to 23 */
#define INST_LOAD_SCALAR1 10
#define INST_LOAD_SCALAR4 11
#define INST_LOAD_SCALAR_STK 12
#define INST_LOAD_ARRAY1 13
#define INST_LOAD_ARRAY4 14
#define INST_LOAD_ARRAY_STK 15
#define INST_LOAD_STK 16
#define INST_STORE_SCALAR1 17
#define INST_STORE_SCALAR4 18
#define INST_STORE_SCALAR_STK 19
#define INST_STORE_ARRAY1 20
#define INST_STORE_ARRAY4 21
#define INST_STORE_ARRAY_STK 22
#define INST_STORE_STK 23
/* Opcodes 0 to 9 */
INST_DONE = 0,
INST_PUSH1,
INST_PUSH4,
INST_POP,
INST_DUP,
INST_STR_CONCAT1,
INST_INVOKE_STK1,
INST_INVOKE_STK4,
INST_EVAL_STK,
INST_EXPR_STK,
/* Opcodes 24 to 33 */
#define INST_INCR_SCALAR1 24
#define INST_INCR_SCALAR_STK 25
#define INST_INCR_ARRAY1 26
#define INST_INCR_ARRAY_STK 27
#define INST_INCR_STK 28
#define INST_INCR_SCALAR1_IMM 29
#define INST_INCR_SCALAR_STK_IMM 30
#define INST_INCR_ARRAY1_IMM 31
#define INST_INCR_ARRAY_STK_IMM 32
#define INST_INCR_STK_IMM 33
/* Opcodes 10 to 23 */
INST_LOAD_SCALAR1,
INST_LOAD_SCALAR4,
INST_LOAD_SCALAR_STK,
INST_LOAD_ARRAY1,
INST_LOAD_ARRAY4,
INST_LOAD_ARRAY_STK,
INST_LOAD_STK,
INST_STORE_SCALAR1,
INST_STORE_SCALAR4,
INST_STORE_SCALAR_STK,
INST_STORE_ARRAY1,
INST_STORE_ARRAY4,
INST_STORE_ARRAY_STK,
INST_STORE_STK,
/* Opcodes 34 to 39 */
#define INST_JUMP1 34
#define INST_JUMP4 35
#define INST_JUMP_TRUE1 36
#define INST_JUMP_TRUE4 37
#define INST_JUMP_FALSE1 38
#define INST_JUMP_FALSE4 39
/* Opcodes 24 to 33 */
INST_INCR_SCALAR1,
INST_INCR_SCALAR_STK,
INST_INCR_ARRAY1,
INST_INCR_ARRAY_STK,
INST_INCR_STK,
INST_INCR_SCALAR1_IMM,
INST_INCR_SCALAR_STK_IMM,
INST_INCR_ARRAY1_IMM,
INST_INCR_ARRAY_STK_IMM,
INST_INCR_STK_IMM,
/* Opcodes 40 to 64 */
#define INST_LOR 40
#define INST_LAND 41
#define INST_BITOR 42
#define INST_BITXOR 43
#define INST_BITAND 44
#define INST_EQ 45
#define INST_NEQ 46
#define INST_LT 47
#define INST_GT 48
#define INST_LE 49
#define INST_GE 50
#define INST_LSHIFT 51
#define INST_RSHIFT 52
#define INST_ADD 53
#define INST_SUB 54
#define INST_MULT 55
#define INST_DIV 56
#define INST_MOD 57
#define INST_UPLUS 58
#define INST_UMINUS 59
#define INST_BITNOT 60
#define INST_LNOT 61
#define INST_CALL_BUILTIN_FUNC1 62
#define INST_CALL_FUNC1 63
#define INST_TRY_CVT_TO_NUMERIC 64
/* Opcodes 34 to 39 */
INST_JUMP1,
INST_JUMP4,
INST_JUMP_TRUE1,
INST_JUMP_TRUE4,
INST_JUMP_FALSE1,
INST_JUMP_FALSE4,
/* Opcodes 65 to 66 */
#define INST_BREAK 65
#define INST_CONTINUE 66
/* Opcodes 42 to 64 */
INST_BITOR,
INST_BITXOR,
INST_BITAND,
INST_EQ,
INST_NEQ,
INST_LT,
INST_GT,
INST_LE,
INST_GE,
INST_LSHIFT,
INST_RSHIFT,
INST_ADD,
INST_SUB,
INST_MULT,
INST_DIV,
INST_MOD,
INST_UPLUS,
INST_UMINUS,
INST_BITNOT,
INST_LNOT,
INST_TRY_CVT_TO_NUMERIC,
/* Opcodes 67 to 68 */
#define INST_FOREACH_START4 67 /* DEPRECATED */
#define INST_FOREACH_STEP4 68 /* DEPRECATED */
/* Opcodes 65 to 66 */
INST_BREAK,
INST_CONTINUE,
/* Opcodes 69 to 72 */
#define INST_BEGIN_CATCH4 69
#define INST_END_CATCH 70
#define INST_PUSH_RESULT 71
#define INST_PUSH_RETURN_CODE 72
/* Opcodes 69 to 72 */
INST_BEGIN_CATCH4,
INST_END_CATCH,
INST_PUSH_RESULT,
INST_PUSH_RETURN_CODE,
/* Opcodes 73 to 78 */
#define INST_STR_EQ 73
#define INST_STR_NEQ 74
#define INST_STR_CMP 75
#define INST_STR_LEN 76
#define INST_STR_INDEX 77
#define INST_STR_MATCH 78
/* Opcodes 73 to 78 */
INST_STR_EQ,
INST_STR_NEQ,
INST_STR_CMP,
INST_STR_LEN,
INST_STR_INDEX,
INST_STR_MATCH,
/* Opcodes 78 to 81 */
#define INST_LIST 79
#define INST_LIST_INDEX 80
#define INST_LIST_LENGTH 81
/* Opcodes 79 to 81 */
INST_LIST,
INST_LIST_INDEX,
INST_LIST_LENGTH,
/* Opcodes 82 to 87 */
#define INST_APPEND_SCALAR1 82
#define INST_APPEND_SCALAR4 83
#define INST_APPEND_ARRAY1 84
#define INST_APPEND_ARRAY4 85
#define INST_APPEND_ARRAY_STK 86
#define INST_APPEND_STK 87
/* Opcodes 82 to 87 */
INST_APPEND_SCALAR1,
INST_APPEND_SCALAR4,
INST_APPEND_ARRAY1,
INST_APPEND_ARRAY4,
INST_APPEND_ARRAY_STK,
INST_APPEND_STK,
/* Opcodes 88 to 93 */
#define INST_LAPPEND_SCALAR1 88
#define INST_LAPPEND_SCALAR4 89
#define INST_LAPPEND_ARRAY1 90
#define INST_LAPPEND_ARRAY4 91
#define INST_LAPPEND_ARRAY_STK 92
#define INST_LAPPEND_STK 93
/* Opcodes 88 to 93 */
INST_LAPPEND_SCALAR1,
INST_LAPPEND_SCALAR4,
INST_LAPPEND_ARRAY1,
INST_LAPPEND_ARRAY4,
INST_LAPPEND_ARRAY_STK,
INST_LAPPEND_STK,
/* TIP #22 - LINDEX operator with flat arg list */
/* TIP #22 - LINDEX operator with flat arg list */
INST_LIST_INDEX_MULTI,
#define INST_LIST_INDEX_MULTI 94
/*
* TIP #33 - 'lset' command. Code gen also required a Forth-like
* OVER operation.
*/
INST_OVER,
INST_LSET_LIST,
INST_LSET_FLAT,
/*
* TIP #33 - 'lset' command. Code gen also required a Forth-like
* OVER operation.
*/
/* TIP#90 - 'return' command. */
INST_RETURN_IMM,
#define INST_OVER 95
#define INST_LSET_LIST 96
#define INST_LSET_FLAT 97
/* TIP#123 - exponentiation operator. */
INST_EXPON,
/* TIP#90 - 'return' command. */
/* TIP #157 - {*}... (word expansion) language syntax support. */
INST_EXPAND_START,
INST_EXPAND_STKTOP,
INST_INVOKE_EXPANDED,
#define INST_RETURN_IMM 98
/*
* TIP #57 - 'lassign' command. Code generation requires immediate
* LINDEX and LRANGE operators.
*/
INST_LIST_INDEX_IMM,
INST_LIST_RANGE_IMM,
INST_START_CMD,
INST_LIST_IN,
INST_LIST_NOT_IN,
INST_PUSH_RETURN_OPTIONS,
INST_RETURN_STK,
/* TIP#123 - exponentiation operator. */
/*
* Dictionary (TIP#111) related commands.
*/
INST_DICT_GET,
INST_DICT_SET,
INST_DICT_UNSET,
INST_DICT_INCR_IMM,
INST_DICT_APPEND,
INST_DICT_LAPPEND,
INST_DICT_FIRST,
INST_DICT_NEXT,
INST_DICT_UPDATE_START,
INST_DICT_UPDATE_END,
#define INST_EXPON 99
/*
* Instruction to support jumps defined by tables (instead of the classic
* [switch] technique of chained comparisons).
*/
INST_JUMP_TABLE,
/* TIP #157 - {*}... (word expansion) language syntax support. */
/*
* Instructions to support compilation of global, variable, upvar and
* [namespace upvar].
*/
INST_UPVAR,
INST_NSUPVAR,
INST_VARIABLE,
#define INST_EXPAND_START 100
#define INST_EXPAND_STKTOP 101
#define INST_INVOKE_EXPANDED 102
/* Instruction to support compiling syntax error to bytecode */
INST_SYNTAX,
/*
* TIP #57 - 'lassign' command. Code generation requires immediate
* LINDEX and LRANGE operators.
*/
/* Instruction to reverse N items on top of stack */
INST_REVERSE,
#define INST_LIST_INDEX_IMM 103
#define INST_LIST_RANGE_IMM 104
/* regexp instruction */
INST_REGEXP,
#define INST_START_CMD 105
/* For [info exists] compilation */
INST_EXIST_SCALAR,
INST_EXIST_ARRAY,
INST_EXIST_ARRAY_STK,
INST_EXIST_STK,
#define INST_LIST_IN 106
#define INST_LIST_NOT_IN 107
/* For [subst] compilation */
INST_NOP,
INST_RETURN_CODE_BRANCH,
#define INST_PUSH_RETURN_OPTIONS 108
#define INST_RETURN_STK 109
/* For [unset] compilation */
INST_UNSET_SCALAR,
INST_UNSET_ARRAY,
INST_UNSET_ARRAY_STK,
INST_UNSET_STK,
/*
* Dictionary (TIP#111) related commands.
*/
/* For [dict with], [dict exists], [dict create] and [dict merge] */
INST_DICT_EXPAND,
INST_DICT_RECOMBINE_STK,
INST_DICT_RECOMBINE_IMM,
INST_DICT_EXISTS,
INST_DICT_VERIFY,
#define INST_DICT_GET 110
#define INST_DICT_SET 111
#define INST_DICT_UNSET 112
#define INST_DICT_INCR_IMM 113
#define INST_DICT_APPEND 114
#define INST_DICT_LAPPEND 115
#define INST_DICT_FIRST 116
#define INST_DICT_NEXT 117
#define INST_DICT_DONE 118
#define INST_DICT_UPDATE_START 119
#define INST_DICT_UPDATE_END 120
/* For [string map] and [regsub] compilation */
INST_STR_MAP,
INST_STR_FIND,
INST_STR_FIND_LAST,
INST_STR_RANGE_IMM,
INST_STR_RANGE,
/*
* Instruction to support jumps defined by tables (instead of the classic
* [switch] technique of chained comparisons).
*/
/* For operations to do with coroutines and other NRE-manipulators */
INST_YIELD,
INST_COROUTINE_NAME,
INST_TAILCALL,
#define INST_JUMP_TABLE 121
/* For compilation of basic information operations */
INST_NS_CURRENT,
INST_INFO_LEVEL_NUM,
INST_INFO_LEVEL_ARGS,
INST_RESOLVE_COMMAND,
/*
* Instructions to support compilation of global, variable, upvar and
* [namespace upvar].
*/
/* For compilation relating to TclOO */
INST_TCLOO_SELF,
INST_TCLOO_CLASS,
INST_TCLOO_NS,
INST_TCLOO_IS_OBJECT,
#define INST_UPVAR 122
#define INST_NSUPVAR 123
#define INST_VARIABLE 124
/* For compilation of [array] subcommands */
INST_ARRAY_EXISTS_STK,
INST_ARRAY_EXISTS_IMM,
INST_ARRAY_MAKE_STK,
INST_ARRAY_MAKE_IMM,
/* Instruction to support compiling syntax error to bytecode */
INST_INVOKE_REPLACE,
#define INST_SYNTAX 125
INST_LIST_CONCAT,
/* Instruction to reverse N items on top of stack */
INST_EXPAND_DROP,
#define INST_REVERSE 126
/* New foreach implementation */
INST_FOREACH_START,
INST_FOREACH_STEP,
INST_FOREACH_END,
INST_LMAP_COLLECT,
/* regexp instruction */
/* For compilation of [string trim] and related */
INST_STR_TRIM,
INST_STR_TRIM_LEFT,
INST_STR_TRIM_RIGHT,
#define INST_REGEXP 127
INST_CONCAT_STK,
/* For [info exists] compilation */
#define INST_EXIST_SCALAR 128
#define INST_EXIST_ARRAY 129
#define INST_EXIST_ARRAY_STK 130
#define INST_EXIST_STK 131
INST_STR_UPPER,
INST_STR_LOWER,
INST_STR_TITLE,
INST_STR_REPLACE,
/* For [subst] compilation */
#define INST_NOP 132
#define INST_RETURN_CODE_BRANCH 133
INST_ORIGIN_COMMAND,
/* For [unset] compilation */
#define INST_UNSET_SCALAR 134
#define INST_UNSET_ARRAY 135
#define INST_UNSET_ARRAY_STK 136
#define INST_UNSET_STK 137
INST_TCLOO_NEXT,
INST_TCLOO_NEXT_CLASS,
/* For [dict with], [dict exists], [dict create] and [dict merge] */
#define INST_DICT_EXPAND 138
#define INST_DICT_RECOMBINE_STK 139
#define INST_DICT_RECOMBINE_IMM 140
#define INST_DICT_EXISTS 141
#define INST_DICT_VERIFY 142
INST_YIELD_TO_INVOKE,
/* For [string map] and [regsub] compilation */
#define INST_STR_MAP 143
#define INST_STR_FIND 144
#define INST_STR_FIND_LAST 145
#define INST_STR_RANGE_IMM 146
#define INST_STR_RANGE 147
INST_NUM_TYPE,
INST_TRY_CVT_TO_BOOLEAN,
INST_STR_CLASS,
/* For operations to do with coroutines and other NRE-manipulators */
#define INST_YIELD 148
#define INST_COROUTINE_NAME 149
#define INST_TAILCALL 150
INST_LAPPEND_LIST,
INST_LAPPEND_LIST_ARRAY,
INST_LAPPEND_LIST_ARRAY_STK,
INST_LAPPEND_LIST_STK,
/* For compilation of basic information operations */
#define INST_NS_CURRENT 151
#define INST_INFO_LEVEL_NUM 152
#define INST_INFO_LEVEL_ARGS 153
#define INST_RESOLVE_COMMAND 154
INST_CLOCK_READ,
/* For compilation relating to TclOO */
#define INST_TCLOO_SELF 155
#define INST_TCLOO_CLASS 156
#define INST_TCLOO_NS 157
#define INST_TCLOO_IS_OBJECT 158
/* The last opcode */
LAST_INST_OPCODE
};
/* For compilation of [array] subcommands */
#define INST_ARRAY_EXISTS_STK 159
#define INST_ARRAY_EXISTS_IMM 160
#define INST_ARRAY_MAKE_STK 161
#define INST_ARRAY_MAKE_IMM 162
#define INST_INVOKE_REPLACE 163
#define INST_LIST_CONCAT 164
#define INST_EXPAND_DROP 165
/* New foreach implementation */
#define INST_FOREACH_START 166
#define INST_FOREACH_STEP 167
#define INST_FOREACH_END 168
#define INST_LMAP_COLLECT 169
/* For compilation of [string trim] and related */
#define INST_STR_TRIM 170
#define INST_STR_TRIM_LEFT 171
#define INST_STR_TRIM_RIGHT 172
#define INST_CONCAT_STK 173
#define INST_STR_UPPER 174
#define INST_STR_LOWER 175
#define INST_STR_TITLE 176
#define INST_STR_REPLACE 177
#define INST_ORIGIN_COMMAND 178
#define INST_TCLOO_NEXT 179
#define INST_TCLOO_NEXT_CLASS 180
#define INST_YIELD_TO_INVOKE 181
#define INST_NUM_TYPE 182
#define INST_TRY_CVT_TO_BOOLEAN 183
#define INST_STR_CLASS 184
#define INST_LAPPEND_LIST 185
#define INST_LAPPEND_LIST_ARRAY 186
#define INST_LAPPEND_LIST_ARRAY_STK 187
#define INST_LAPPEND_LIST_STK 188
#define INST_CLOCK_READ 189
/* The last opcode */
#define LAST_INST_OPCODE 189
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
+1 -1
View File
@@ -31,7 +31,7 @@
* the (Tcl_Interp *) in which it is stored, and the encoding.
*/
typedef struct QCCD {
typedef struct {
Tcl_Obj *pkg;
Tcl_Interp *interp;
char *encoding;
+94 -190
View File
@@ -118,9 +118,7 @@ EXTERN void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file,
/* 21 */
EXTERN int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file,
int line);
/* 22 */
EXTERN Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, const char *file,
int line);
/* Slot 22 is reserved */
/* 23 */
EXTERN Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes,
int length, const char *file, int line);
@@ -130,9 +128,7 @@ EXTERN Tcl_Obj * Tcl_DbNewDoubleObj(double doubleValue,
/* 25 */
EXTERN Tcl_Obj * Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
const char *file, int line);
/* 26 */
EXTERN Tcl_Obj * Tcl_DbNewLongObj(long longValue, const char *file,
int line);
/* Slot 26 is reserved */
/* 27 */
EXTERN Tcl_Obj * Tcl_DbNewObj(const char *file, int line);
/* 28 */
@@ -171,7 +167,7 @@ EXTERN int Tcl_GetIntFromObj(Tcl_Interp *interp,
EXTERN int Tcl_GetLongFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, long *longPtr);
/* 40 */
EXTERN CONST86 Tcl_ObjType * Tcl_GetObjType(const char *typeName);
EXTERN const Tcl_ObjType * Tcl_GetObjType(const char *typeName);
/* 41 */
EXTERN char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr);
/* 42 */
@@ -197,25 +193,21 @@ EXTERN int Tcl_ListObjLength(Tcl_Interp *interp,
EXTERN int Tcl_ListObjReplace(Tcl_Interp *interp,
Tcl_Obj *listPtr, int first, int count,
int objc, Tcl_Obj *const objv[]);
/* 49 */
EXTERN Tcl_Obj * Tcl_NewBooleanObj(int boolValue);
/* Slot 49 is reserved */
/* 50 */
EXTERN Tcl_Obj * Tcl_NewByteArrayObj(const unsigned char *bytes,
int length);
/* 51 */
EXTERN Tcl_Obj * Tcl_NewDoubleObj(double doubleValue);
/* 52 */
EXTERN Tcl_Obj * Tcl_NewIntObj(int intValue);
/* Slot 52 is reserved */
/* 53 */
EXTERN Tcl_Obj * Tcl_NewListObj(int objc, Tcl_Obj *const objv[]);
/* 54 */
EXTERN Tcl_Obj * Tcl_NewLongObj(long longValue);
/* Slot 54 is reserved */
/* 55 */
EXTERN Tcl_Obj * Tcl_NewObj(void);
/* 56 */
EXTERN Tcl_Obj * Tcl_NewStringObj(const char *bytes, int length);
/* 57 */
EXTERN void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue);
/* Slot 57 is reserved */
/* 58 */
EXTERN unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length);
/* 59 */
@@ -223,13 +215,11 @@ EXTERN void Tcl_SetByteArrayObj(Tcl_Obj *objPtr,
const unsigned char *bytes, int length);
/* 60 */
EXTERN void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue);
/* 61 */
EXTERN void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue);
/* Slot 61 is reserved */
/* 62 */
EXTERN void Tcl_SetListObj(Tcl_Obj *objPtr, int objc,
Tcl_Obj *const objv[]);
/* 63 */
EXTERN void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue);
/* Slot 63 is reserved */
/* 64 */
EXTERN void Tcl_SetObjLength(Tcl_Obj *objPtr, int length);
/* 65 */
@@ -261,9 +251,7 @@ EXTERN void Tcl_AsyncMark(Tcl_AsyncHandler async);
EXTERN int Tcl_AsyncReady(void);
/* 76 */
EXTERN void Tcl_BackgroundError(Tcl_Interp *interp);
/* 77 */
TCL_DEPRECATED("Use Tcl_UtfBackslash")
char Tcl_Backslash(const char *src, int *readPtr);
/* Slot 77 is reserved */
/* 78 */
EXTERN int Tcl_BadChannelOption(Tcl_Interp *interp,
const char *optionName,
@@ -321,12 +309,7 @@ EXTERN void Tcl_CreateExitHandler(Tcl_ExitProc *proc,
ClientData clientData);
/* 94 */
EXTERN Tcl_Interp * Tcl_CreateInterp(void);
/* 95 */
TCL_DEPRECATED("")
void Tcl_CreateMathFunc(Tcl_Interp *interp,
const char *name, int numArgs,
Tcl_ValueType *argTypes, Tcl_MathProc *proc,
ClientData clientData);
/* Slot 95 is reserved */
/* 96 */
EXTERN Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
const char *cmdName, Tcl_ObjCmdProc *proc,
@@ -421,8 +404,7 @@ EXTERN int Tcl_Eval(Tcl_Interp *interp, const char *script);
/* 130 */
EXTERN int Tcl_EvalFile(Tcl_Interp *interp,
const char *fileName);
/* 131 */
EXTERN int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
/* Slot 131 is reserved */
/* 132 */
EXTERN void Tcl_EventuallyFree(ClientData clientData,
Tcl_FreeProc *freeProc);
@@ -501,7 +483,7 @@ EXTERN int Tcl_GetChannelOption(Tcl_Interp *interp,
Tcl_Channel chan, const char *optionName,
Tcl_DString *dsPtr);
/* 158 */
EXTERN CONST86 Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan);
EXTERN const Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan);
/* 159 */
EXTERN int Tcl_GetCommandInfo(Tcl_Interp *interp,
const char *cmdName, Tcl_CmdInfo *infoPtr);
@@ -557,9 +539,7 @@ EXTERN const char * Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
/* 177 */
EXTERN int Tcl_GlobalEval(Tcl_Interp *interp,
const char *command);
/* 178 */
EXTERN int Tcl_GlobalEvalObj(Tcl_Interp *interp,
Tcl_Obj *objPtr);
/* Slot 178 is reserved */
/* 179 */
EXTERN int Tcl_HideCommand(Tcl_Interp *interp,
const char *cmdName,
@@ -667,9 +647,7 @@ EXTERN int Tcl_ScanElement(const char *src, int *flagPtr);
/* 219 */
EXTERN int Tcl_ScanCountedElement(const char *src, int length,
int *flagPtr);
/* 220 */
TCL_DEPRECATED("")
int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode);
/* Slot 220 is reserved */
/* 221 */
EXTERN int Tcl_ServiceAll(void);
/* 222 */
@@ -739,9 +717,7 @@ EXTERN void Tcl_StaticPackage(Tcl_Interp *interp,
Tcl_PackageInitProc *safeInitProc);
/* 245 */
EXTERN int Tcl_StringMatch(const char *str, const char *pattern);
/* 246 */
TCL_DEPRECATED("")
int Tcl_TellOld(Tcl_Channel chan);
/* Slot 246 is reserved */
/* 247 */
EXTERN int Tcl_TraceVar(Tcl_Interp *interp, const char *varName,
int flags, Tcl_VarTraceProc *proc,
@@ -811,14 +787,8 @@ EXTERN void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc,
EXTERN int Tcl_DumpActiveMemory(const char *fileName);
/* 266 */
EXTERN void Tcl_ValidateAllMemory(const char *file, int line);
/* 267 */
TCL_DEPRECATED("see TIP #422")
void Tcl_AppendResultVA(Tcl_Interp *interp,
va_list argList);
/* 268 */
TCL_DEPRECATED("see TIP #422")
void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr,
va_list argList);
/* Slot 267 is reserved */
/* Slot 268 is reserved */
/* 269 */
EXTERN char * Tcl_HashStats(Tcl_HashTable *tablePtr);
/* 270 */
@@ -837,18 +807,11 @@ EXTERN int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
/* 274 */
EXTERN const char * Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
const char *version, int exact);
/* 275 */
TCL_DEPRECATED("see TIP #422")
void Tcl_SetErrorCodeVA(Tcl_Interp *interp,
va_list argList);
/* 276 */
TCL_DEPRECATED("see TIP #422")
int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList);
/* Slot 275 is reserved */
/* Slot 276 is reserved */
/* 277 */
EXTERN Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options);
/* 278 */
TCL_DEPRECATED("see TIP #422")
TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList);
/* Slot 278 is reserved */
/* 279 */
EXTERN void Tcl_GetVersion(int *major, int *minor,
int *patchLevel, int *type);
@@ -1012,12 +975,8 @@ EXTERN int Tcl_WriteChars(Tcl_Channel chan, const char *src,
EXTERN int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 340 */
EXTERN char * Tcl_GetString(Tcl_Obj *objPtr);
/* 341 */
TCL_DEPRECATED("Use Tcl_GetEncodingSearchPath")
const char * Tcl_GetDefaultEncodingDir(void);
/* 342 */
TCL_DEPRECATED("Use Tcl_SetEncodingSearchPath")
void Tcl_SetDefaultEncodingDir(const char *path);
/* Slot 341 is reserved */
/* Slot 342 is reserved */
/* 343 */
EXTERN void Tcl_AlertNotifier(ClientData clientData);
/* 344 */
@@ -1051,10 +1010,7 @@ EXTERN Tcl_UniChar * Tcl_UtfToUniCharDString(const char *src, int length,
/* 356 */
EXTERN Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp,
Tcl_Obj *patObj, int flags);
/* 357 */
TCL_DEPRECATED("Use Tcl_EvalTokensStandard")
Tcl_Obj * Tcl_EvalTokens(Tcl_Interp *interp,
Tcl_Token *tokenPtr, int count);
/* Slot 357 is reserved */
/* 358 */
EXTERN void Tcl_FreeParse(Tcl_Parse *parsePtr);
/* 359 */
@@ -1229,12 +1185,8 @@ EXTERN int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs,
/* 420 */
EXTERN int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
const Tcl_UniChar *uniPattern, int nocase);
/* 421 */
EXTERN Tcl_HashEntry * Tcl_FindHashEntry(Tcl_HashTable *tablePtr,
const void *key);
/* 422 */
EXTERN Tcl_HashEntry * Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
const void *key, int *newPtr);
/* Slot 421 is reserved */
/* Slot 422 is reserved */
/* 423 */
EXTERN void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr,
int keyType, const Tcl_HashKeyType *typePtr);
@@ -1272,17 +1224,8 @@ EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel);
/* 434 */
EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
int *lengthPtr);
/* 435 */
TCL_DEPRECATED("")
int Tcl_GetMathFuncInfo(Tcl_Interp *interp,
const char *name, int *numArgsPtr,
Tcl_ValueType **argTypesPtr,
Tcl_MathProc **procPtr,
ClientData *clientDataPtr);
/* 436 */
TCL_DEPRECATED("")
Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp,
const char *pattern);
/* Slot 435 is reserved */
/* Slot 436 is reserved */
/* 437 */
EXTERN Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
int flags);
@@ -1332,7 +1275,7 @@ EXTERN int Tcl_FSFileAttrsGet(Tcl_Interp *interp, int index,
EXTERN int Tcl_FSFileAttrsSet(Tcl_Interp *interp, int index,
Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
/* 453 */
EXTERN const char *CONST86 * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
EXTERN const char *const * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
Tcl_Obj **objPtrRef);
/* 454 */
EXTERN int Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
@@ -1393,7 +1336,7 @@ EXTERN ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr);
EXTERN const char * Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
Tcl_Obj *pathPtr);
/* 477 */
EXTERN CONST86 Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr);
EXTERN const Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr);
/* 478 */
EXTERN Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr);
/* 479 */
@@ -1887,11 +1830,11 @@ typedef struct TclStubs {
void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 19 */
void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 20 */
int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line); /* 21 */
Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, const char *file, int line); /* 22 */
void (*reserved22)(void);
Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, int length, const char *file, int line); /* 23 */
Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line); /* 24 */
Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *const *objv, const char *file, int line); /* 25 */
Tcl_Obj * (*tcl_DbNewLongObj) (long longValue, const char *file, int line); /* 26 */
void (*reserved26)(void);
Tcl_Obj * (*tcl_DbNewObj) (const char *file, int line); /* 27 */
Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, int length, const char *file, int line); /* 28 */
Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */
@@ -1905,7 +1848,7 @@ typedef struct TclStubs {
int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */
int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */
int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */
CONST86 Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */
const Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */
char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 41 */
void (*tcl_InvalidateStringRep) (Tcl_Obj *objPtr); /* 42 */
int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */
@@ -1914,21 +1857,21 @@ typedef struct TclStubs {
int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 46 */
int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */
int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 48 */
Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue); /* 49 */
void (*reserved49)(void);
Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, int length); /* 50 */
Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */
Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */
void (*reserved52)(void);
Tcl_Obj * (*tcl_NewListObj) (int objc, Tcl_Obj *const objv[]); /* 53 */
Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */
void (*reserved54)(void);
Tcl_Obj * (*tcl_NewObj) (void); /* 55 */
Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, int length); /* 56 */
void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue); /* 57 */
void (*reserved57)(void);
unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, int length); /* 58 */
void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, int length); /* 59 */
void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */
void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */
void (*reserved61)(void);
void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 62 */
void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */
void (*reserved63)(void);
void (*tcl_SetObjLength) (Tcl_Obj *objPtr, int length); /* 64 */
void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 65 */
void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */
@@ -1942,7 +1885,7 @@ typedef struct TclStubs {
void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */
int (*tcl_AsyncReady) (void); /* 75 */
void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */
TCL_DEPRECATED_API("Use Tcl_UtfBackslash") char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */
void (*reserved77)(void);
int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */
void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */
void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */
@@ -1960,7 +1903,7 @@ typedef struct TclStubs {
void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 92 */
void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 93 */
Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */
TCL_DEPRECATED_API("") void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */
void (*reserved95)(void);
Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */
Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *slaveName, int isSafe); /* 97 */
Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */
@@ -1996,7 +1939,7 @@ typedef struct TclStubs {
const char * (*tcl_ErrnoMsg) (int err); /* 128 */
int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */
int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */
int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */
void (*reserved131)(void);
void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */
TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */
int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */
@@ -2023,7 +1966,7 @@ typedef struct TclStubs {
int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */
const char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */
int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 157 */
CONST86 Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */
const Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */
int (*tcl_GetCommandInfo) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 159 */
const char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */
int (*tcl_GetErrno) (void); /* 161 */
@@ -2051,7 +1994,7 @@ typedef struct TclStubs {
const char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */
const char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */
int (*tcl_GlobalEval) (Tcl_Interp *interp, const char *command); /* 177 */
int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */
void (*reserved178)(void);
int (*tcl_HideCommand) (Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 179 */
int (*tcl_Init) (Tcl_Interp *interp); /* 180 */
void (*tcl_InitHashTable) (Tcl_HashTable *tablePtr, int keyType); /* 181 */
@@ -2093,7 +2036,7 @@ typedef struct TclStubs {
void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */
int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */
int (*tcl_ScanCountedElement) (const char *src, int length, int *flagPtr); /* 219 */
TCL_DEPRECATED_API("") int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */
void (*reserved220)(void);
int (*tcl_ServiceAll) (void); /* 221 */
int (*tcl_ServiceEvent) (int flags); /* 222 */
void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 223 */
@@ -2119,7 +2062,7 @@ typedef struct TclStubs {
void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */
void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */
int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */
TCL_DEPRECATED_API("") int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
void (*reserved246)(void);
int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */
int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */
char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */
@@ -2140,18 +2083,18 @@ typedef struct TclStubs {
void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */
int (*tcl_DumpActiveMemory) (const char *fileName); /* 265 */
void (*tcl_ValidateAllMemory) (const char *file, int line); /* 266 */
TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */
TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
void (*reserved267)(void);
void (*reserved268)(void);
char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */
const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */
const char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
TCL_DEPRECATED_API("see TIP #422") void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
TCL_DEPRECATED_API("see TIP #422") int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
void (*reserved275)(void);
void (*reserved276)(void);
Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
TCL_DEPRECATED_API("see TIP #422") TCL_NORETURN1 void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */
void (*reserved278)(void);
void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */
void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */
Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 281 */
@@ -2214,8 +2157,8 @@ typedef struct TclStubs {
int (*tcl_WriteChars) (Tcl_Channel chan, const char *src, int srcLen); /* 338 */
int (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */
char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */
TCL_DEPRECATED_API("Use Tcl_GetEncodingSearchPath") const char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */
TCL_DEPRECATED_API("Use Tcl_SetEncodingSearchPath") void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */
void (*reserved341)(void);
void (*reserved342)(void);
void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */
void (*tcl_ServiceModeHook) (int mode); /* 344 */
int (*tcl_UniCharIsAlnum) (int ch); /* 345 */
@@ -2230,7 +2173,7 @@ typedef struct TclStubs {
char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */
Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */
Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */
TCL_DEPRECATED_API("Use Tcl_EvalTokensStandard") Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */
void (*reserved357)(void);
void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */
void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, int length); /* 359 */
int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */
@@ -2294,8 +2237,8 @@ typedef struct TclStubs {
int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */
int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 419 */
int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 420 */
Tcl_HashEntry * (*tcl_FindHashEntry) (Tcl_HashTable *tablePtr, const void *key); /* 421 */
Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 422 */
void (*reserved421)(void);
void (*reserved422)(void);
void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 423 */
void (*tcl_InitObjHashTable) (Tcl_HashTable *tablePtr); /* 424 */
ClientData (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData); /* 425 */
@@ -2308,8 +2251,8 @@ typedef struct TclStubs {
int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */
Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */
Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */
TCL_DEPRECATED_API("") int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */
TCL_DEPRECATED_API("") Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */
void (*reserved435)(void);
void (*reserved436)(void);
Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */
int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */
int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */
@@ -2326,7 +2269,7 @@ typedef struct TclStubs {
int (*tcl_FSUtime) (Tcl_Obj *pathPtr, struct utimbuf *tval); /* 450 */
int (*tcl_FSFileAttrsGet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 451 */
int (*tcl_FSFileAttrsSet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); /* 452 */
const char *CONST86 * (*tcl_FSFileAttrStrings) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 453 */
const char *const * (*tcl_FSFileAttrStrings) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 453 */
int (*tcl_FSStat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 454 */
int (*tcl_FSAccess) (Tcl_Obj *pathPtr, int mode); /* 455 */
Tcl_Channel (*tcl_FSOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *modeString, int permissions); /* 456 */
@@ -2350,7 +2293,7 @@ typedef struct TclStubs {
int (*tcl_FSUnregister) (const Tcl_Filesystem *fsPtr); /* 474 */
ClientData (*tcl_FSData) (const Tcl_Filesystem *fsPtr); /* 475 */
const char * (*tcl_FSGetTranslatedStringPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 476 */
CONST86 Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */
const Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */
Tcl_PathType (*tcl_FSGetPathType) (Tcl_Obj *pathPtr); /* 478 */
int (*tcl_OutputBuffered) (Tcl_Channel chan); /* 479 */
void (*tcl_FSMountsChanged) (const Tcl_Filesystem *fsPtr); /* 480 */
@@ -2575,16 +2518,14 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_DbIncrRefCount) /* 20 */
#define Tcl_DbIsShared \
(tclStubsPtr->tcl_DbIsShared) /* 21 */
#define Tcl_DbNewBooleanObj \
(tclStubsPtr->tcl_DbNewBooleanObj) /* 22 */
/* Slot 22 is reserved */
#define Tcl_DbNewByteArrayObj \
(tclStubsPtr->tcl_DbNewByteArrayObj) /* 23 */
#define Tcl_DbNewDoubleObj \
(tclStubsPtr->tcl_DbNewDoubleObj) /* 24 */
#define Tcl_DbNewListObj \
(tclStubsPtr->tcl_DbNewListObj) /* 25 */
#define Tcl_DbNewLongObj \
(tclStubsPtr->tcl_DbNewLongObj) /* 26 */
/* Slot 26 is reserved */
#define Tcl_DbNewObj \
(tclStubsPtr->tcl_DbNewObj) /* 27 */
#define Tcl_DbNewStringObj \
@@ -2629,36 +2570,30 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_ListObjLength) /* 47 */
#define Tcl_ListObjReplace \
(tclStubsPtr->tcl_ListObjReplace) /* 48 */
#define Tcl_NewBooleanObj \
(tclStubsPtr->tcl_NewBooleanObj) /* 49 */
/* Slot 49 is reserved */
#define Tcl_NewByteArrayObj \
(tclStubsPtr->tcl_NewByteArrayObj) /* 50 */
#define Tcl_NewDoubleObj \
(tclStubsPtr->tcl_NewDoubleObj) /* 51 */
#define Tcl_NewIntObj \
(tclStubsPtr->tcl_NewIntObj) /* 52 */
/* Slot 52 is reserved */
#define Tcl_NewListObj \
(tclStubsPtr->tcl_NewListObj) /* 53 */
#define Tcl_NewLongObj \
(tclStubsPtr->tcl_NewLongObj) /* 54 */
/* Slot 54 is reserved */
#define Tcl_NewObj \
(tclStubsPtr->tcl_NewObj) /* 55 */
#define Tcl_NewStringObj \
(tclStubsPtr->tcl_NewStringObj) /* 56 */
#define Tcl_SetBooleanObj \
(tclStubsPtr->tcl_SetBooleanObj) /* 57 */
/* Slot 57 is reserved */
#define Tcl_SetByteArrayLength \
(tclStubsPtr->tcl_SetByteArrayLength) /* 58 */
#define Tcl_SetByteArrayObj \
(tclStubsPtr->tcl_SetByteArrayObj) /* 59 */
#define Tcl_SetDoubleObj \
(tclStubsPtr->tcl_SetDoubleObj) /* 60 */
#define Tcl_SetIntObj \
(tclStubsPtr->tcl_SetIntObj) /* 61 */
/* Slot 61 is reserved */
#define Tcl_SetListObj \
(tclStubsPtr->tcl_SetListObj) /* 62 */
#define Tcl_SetLongObj \
(tclStubsPtr->tcl_SetLongObj) /* 63 */
/* Slot 63 is reserved */
#define Tcl_SetObjLength \
(tclStubsPtr->tcl_SetObjLength) /* 64 */
#define Tcl_SetStringObj \
@@ -2685,8 +2620,7 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_AsyncReady) /* 75 */
#define Tcl_BackgroundError \
(tclStubsPtr->tcl_BackgroundError) /* 76 */
#define Tcl_Backslash \
(tclStubsPtr->tcl_Backslash) /* 77 */
/* Slot 77 is reserved */
#define Tcl_BadChannelOption \
(tclStubsPtr->tcl_BadChannelOption) /* 78 */
#define Tcl_CallWhenDeleted \
@@ -2721,8 +2655,7 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_CreateExitHandler) /* 93 */
#define Tcl_CreateInterp \
(tclStubsPtr->tcl_CreateInterp) /* 94 */
#define Tcl_CreateMathFunc \
(tclStubsPtr->tcl_CreateMathFunc) /* 95 */
/* Slot 95 is reserved */
#define Tcl_CreateObjCommand \
(tclStubsPtr->tcl_CreateObjCommand) /* 96 */
#define Tcl_CreateSlave \
@@ -2793,8 +2726,7 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_Eval) /* 129 */
#define Tcl_EvalFile \
(tclStubsPtr->tcl_EvalFile) /* 130 */
#define Tcl_EvalObj \
(tclStubsPtr->tcl_EvalObj) /* 131 */
/* Slot 131 is reserved */
#define Tcl_EventuallyFree \
(tclStubsPtr->tcl_EventuallyFree) /* 132 */
#define Tcl_Exit \
@@ -2893,8 +2825,7 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_GetVar2) /* 176 */
#define Tcl_GlobalEval \
(tclStubsPtr->tcl_GlobalEval) /* 177 */
#define Tcl_GlobalEvalObj \
(tclStubsPtr->tcl_GlobalEvalObj) /* 178 */
/* Slot 178 is reserved */
#define Tcl_HideCommand \
(tclStubsPtr->tcl_HideCommand) /* 179 */
#define Tcl_Init \
@@ -2976,8 +2907,7 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_ScanElement) /* 218 */
#define Tcl_ScanCountedElement \
(tclStubsPtr->tcl_ScanCountedElement) /* 219 */
#define Tcl_SeekOld \
(tclStubsPtr->tcl_SeekOld) /* 220 */
/* Slot 220 is reserved */
#define Tcl_ServiceAll \
(tclStubsPtr->tcl_ServiceAll) /* 221 */
#define Tcl_ServiceEvent \
@@ -3028,8 +2958,7 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_StaticPackage) /* 244 */
#define Tcl_StringMatch \
(tclStubsPtr->tcl_StringMatch) /* 245 */
#define Tcl_TellOld \
(tclStubsPtr->tcl_TellOld) /* 246 */
/* Slot 246 is reserved */
#define Tcl_TraceVar \
(tclStubsPtr->tcl_TraceVar) /* 247 */
#define Tcl_TraceVar2 \
@@ -3070,10 +2999,8 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_DumpActiveMemory) /* 265 */
#define Tcl_ValidateAllMemory \
(tclStubsPtr->tcl_ValidateAllMemory) /* 266 */
#define Tcl_AppendResultVA \
(tclStubsPtr->tcl_AppendResultVA) /* 267 */
#define Tcl_AppendStringsToObjVA \
(tclStubsPtr->tcl_AppendStringsToObjVA) /* 268 */
/* Slot 267 is reserved */
/* Slot 268 is reserved */
#define Tcl_HashStats \
(tclStubsPtr->tcl_HashStats) /* 269 */
#define Tcl_ParseVar \
@@ -3086,14 +3013,11 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_PkgProvide) /* 273 */
#define Tcl_PkgRequire \
(tclStubsPtr->tcl_PkgRequire) /* 274 */
#define Tcl_SetErrorCodeVA \
(tclStubsPtr->tcl_SetErrorCodeVA) /* 275 */
#define Tcl_VarEvalVA \
(tclStubsPtr->tcl_VarEvalVA) /* 276 */
/* Slot 275 is reserved */
/* Slot 276 is reserved */
#define Tcl_WaitPid \
(tclStubsPtr->tcl_WaitPid) /* 277 */
#define Tcl_PanicVA \
(tclStubsPtr->tcl_PanicVA) /* 278 */
/* Slot 278 is reserved */
#define Tcl_GetVersion \
(tclStubsPtr->tcl_GetVersion) /* 279 */
#define Tcl_InitMemory \
@@ -3217,10 +3141,8 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_WriteObj) /* 339 */
#define Tcl_GetString \
(tclStubsPtr->tcl_GetString) /* 340 */
#define Tcl_GetDefaultEncodingDir \
(tclStubsPtr->tcl_GetDefaultEncodingDir) /* 341 */
#define Tcl_SetDefaultEncodingDir \
(tclStubsPtr->tcl_SetDefaultEncodingDir) /* 342 */
/* Slot 341 is reserved */
/* Slot 342 is reserved */
#define Tcl_AlertNotifier \
(tclStubsPtr->tcl_AlertNotifier) /* 343 */
#define Tcl_ServiceModeHook \
@@ -3249,8 +3171,7 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_UtfToUniCharDString) /* 355 */
#define Tcl_GetRegExpFromObj \
(tclStubsPtr->tcl_GetRegExpFromObj) /* 356 */
#define Tcl_EvalTokens \
(tclStubsPtr->tcl_EvalTokens) /* 357 */
/* Slot 357 is reserved */
#define Tcl_FreeParse \
(tclStubsPtr->tcl_FreeParse) /* 358 */
#define Tcl_LogCommandInfo \
@@ -3377,10 +3298,8 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_UniCharNcasecmp) /* 419 */
#define Tcl_UniCharCaseMatch \
(tclStubsPtr->tcl_UniCharCaseMatch) /* 420 */
#define Tcl_FindHashEntry \
(tclStubsPtr->tcl_FindHashEntry) /* 421 */
#define Tcl_CreateHashEntry \
(tclStubsPtr->tcl_CreateHashEntry) /* 422 */
/* Slot 421 is reserved */
/* Slot 422 is reserved */
#define Tcl_InitCustomHashTable \
(tclStubsPtr->tcl_InitCustomHashTable) /* 423 */
#define Tcl_InitObjHashTable \
@@ -3405,10 +3324,8 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_GetChannelThread) /* 433 */
#define Tcl_GetUnicodeFromObj \
(tclStubsPtr->tcl_GetUnicodeFromObj) /* 434 */
#define Tcl_GetMathFuncInfo \
(tclStubsPtr->tcl_GetMathFuncInfo) /* 435 */
#define Tcl_ListMathFuncs \
(tclStubsPtr->tcl_ListMathFuncs) /* 436 */
/* Slot 435 is reserved */
/* Slot 436 is reserved */
#define Tcl_SubstObj \
(tclStubsPtr->tcl_SubstObj) /* 437 */
#define Tcl_DetachChannel \
@@ -3833,9 +3750,6 @@ extern const TclStubs *tclStubsPtr;
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
#undef Tcl_SeekOld
#undef Tcl_TellOld
#undef Tcl_PkgPresent
#define Tcl_PkgPresent(interp, name, version, exact) \
Tcl_PkgPresentEx(interp, name, version, exact, NULL)
@@ -3849,15 +3763,12 @@ extern const TclStubs *tclStubsPtr;
#define Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) \
Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, \
sizeof(char *), msg, flags, indexPtr)
#undef Tcl_NewBooleanObj
#define Tcl_NewBooleanObj(boolValue) \
Tcl_NewLongObj((boolValue)!=0)
#undef Tcl_DbNewBooleanObj
Tcl_NewWideIntObj((boolValue)!=0)
#define Tcl_DbNewBooleanObj(boolValue, file, line) \
Tcl_DbNewLongObj((boolValue)!=0, file, line)
#undef Tcl_SetBooleanObj
Tcl_DbNewWideIntObj((boolValue)!=0, file, line)
#define Tcl_SetBooleanObj(objPtr, boolValue) \
Tcl_SetLongObj(objPtr, (boolValue)!=0)
Tcl_SetWideIntObj(objPtr, (boolValue)!=0)
#undef Tcl_SetVar
#define Tcl_SetVar(interp, varName, newValue, flags) \
Tcl_SetVar2(interp, varName, NULL, newValue, flags)
@@ -3895,20 +3806,20 @@ extern const TclStubs *tclStubsPtr;
#undef Tcl_SaveResult
#define Tcl_SaveResult(interp, statePtr) \
do { \
(statePtr)->objResultPtr = Tcl_GetObjResult(interp); \
Tcl_IncrRefCount((statePtr)->objResultPtr); \
*(statePtr) = Tcl_GetObjResult(interp); \
Tcl_IncrRefCount(*(statePtr)); \
Tcl_SetObjResult(interp, Tcl_NewObj()); \
} while(0)
#undef Tcl_RestoreResult
#define Tcl_RestoreResult(interp, statePtr) \
do { \
Tcl_ResetResult(interp); \
Tcl_SetObjResult(interp, (statePtr)->objResultPtr); \
Tcl_DecrRefCount((statePtr)->objResultPtr); \
Tcl_SetObjResult(interp, *(statePtr)); \
Tcl_DecrRefCount(*(statePtr)); \
} while(0)
#undef Tcl_DiscardResult
#define Tcl_DiscardResult(statePtr) \
Tcl_DecrRefCount((statePtr)->objResultPtr)
Tcl_DecrRefCount(*(statePtr))
#undef Tcl_SetResult
#define Tcl_SetResult(interp, result, freeProc) \
do { \
@@ -3967,25 +3878,18 @@ extern const TclStubs *tclStubsPtr;
# endif
#endif
#undef Tcl_NewLongObj
#define Tcl_NewLongObj(value) Tcl_NewWideIntObj((long)(value))
#undef Tcl_NewIntObj
#define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value))
#undef Tcl_DbNewLongObj
#define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line)
#undef Tcl_SetIntObj
#define Tcl_SetIntObj(objPtr, value) Tcl_SetWideIntObj(objPtr, (int)(value))
#undef Tcl_SetLongObj
#define Tcl_SetLongObj(objPtr, value) Tcl_SetWideIntObj(objPtr, (long)(value))
/*
* Deprecated Tcl procedures:
*/
#undef Tcl_EvalObj
#define Tcl_EvalObj(interp, objPtr) \
Tcl_EvalObjEx(interp, objPtr, 0)
#undef Tcl_GlobalEvalObj
#define Tcl_GlobalEvalObj(interp, objPtr) \
Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)
+1 -1
View File
@@ -235,7 +235,7 @@ AllocChainEntry(
cPtr = ckalloc(sizeof(ChainEntry));
cPtr->entry.key.objPtr = objPtr;
Tcl_IncrRefCount(objPtr);
cPtr->entry.clientData = NULL;
Tcl_SetHashValue(&cPtr->entry, NULL);
cPtr->prevPtr = cPtr->nextPtr = NULL;
return &cPtr->entry;
+6 -6
View File
@@ -267,9 +267,9 @@ DisassembleByteCodeObj(
*/
Tcl_AppendPrintfToObj(bufferObj,
"ByteCode %p, refCt %u, epoch %u, interp %p (epoch %u)\n",
codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr,
iPtr->compileEpoch);
"ByteCode %p, refCt %" TCL_LL_MODIFIER "d, epoch %" TCL_LL_MODIFIER "d, interp %p (epoch %" TCL_LL_MODIFIER "d)\n",
codePtr, (Tcl_WideUInt)codePtr->refCount, (Tcl_WideUInt)codePtr->compileEpoch, iPtr,
(Tcl_WideUInt)iPtr->compileEpoch);
Tcl_AppendToObj(bufferObj, " Source ", -1);
PrintSourceToObj(bufferObj, codePtr->source,
TclMin(codePtr->numSrcBytes, 55));
@@ -312,8 +312,8 @@ DisassembleByteCodeObj(
int numCompiledLocals = procPtr->numCompiledLocals;
Tcl_AppendPrintfToObj(bufferObj,
" Proc %p, refCt %u, args %d, compiled locals %d\n",
procPtr, procPtr->refCount, procPtr->numArgs,
" Proc %p, refCt %" TCL_LL_MODIFIER "d, args %d, compiled locals %d\n",
procPtr, (Tcl_WideUInt)procPtr->refCount, procPtr->numArgs,
numCompiledLocals);
if (numCompiledLocals > 0) {
CompiledLocal *localPtr = procPtr->firstLocalPtr;
@@ -820,7 +820,7 @@ UpdateStringOfInstName(
size_t len, inst = (size_t)objPtr->internalRep.wideValue;
char *s, buf[TCL_INTEGER_SPACE + 5];
if (inst > LAST_INST_OPCODE) {
if (inst >= LAST_INST_OPCODE) {
sprintf(buf, "inst_%" TCL_Z_MODIFIER "d", inst);
s = buf;
} else {
+1 -65
View File
@@ -675,70 +675,6 @@ TclFinalizeEncodingSubsystem(void)
Tcl_MutexUnlock(&encodingMutex);
}
/*
*-------------------------------------------------------------------------
*
* Tcl_GetDefaultEncodingDir --
*
* Legacy public interface to retrieve first directory in the encoding
* searchPath.
*
* Results:
* The directory pathname, as a string, or NULL for an empty encoding
* search path.
*
* Side effects:
* None.
*
*-------------------------------------------------------------------------
*/
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
const char *
Tcl_GetDefaultEncodingDir(void)
{
int numDirs;
Tcl_Obj *first, *searchPath = Tcl_GetEncodingSearchPath();
Tcl_ListObjLength(NULL, searchPath, &numDirs);
if (numDirs == 0) {
return NULL;
}
Tcl_ListObjIndex(NULL, searchPath, 0, &first);
return TclGetString(first);
}
/*
*-------------------------------------------------------------------------
*
* Tcl_SetDefaultEncodingDir --
*
* Legacy public interface to set the first directory in the encoding
* search path.
*
* Results:
* None.
*
* Side effects:
* Modifies the encoding search path.
*
*-------------------------------------------------------------------------
*/
void
Tcl_SetDefaultEncodingDir(
const char *path)
{
Tcl_Obj *searchPath = Tcl_GetEncodingSearchPath();
Tcl_Obj *directory = Tcl_NewStringObj(path, -1);
searchPath = Tcl_DuplicateObj(searchPath);
Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &directory);
Tcl_SetEncodingSearchPath(searchPath);
}
#endif
/*
*-------------------------------------------------------------------------
*
@@ -3628,7 +3564,7 @@ unilen(
static void
InitializeEncodingSearchPath(
char **valuePtr,
unsigned int *lengthPtr,
size_t *lengthPtr,
Tcl_Encoding *encodingPtr)
{
const char *bytes;
+52 -58
View File
@@ -87,20 +87,21 @@ static const Tcl_ObjType ensembleCmdType = {
};
/*
* The internal rep for caching ensemble subcommand lookups and spelling
* corrections.
* The internal rep for caching ensemble subcommand lookups and
* spell corrections.
*/
typedef struct {
unsigned int epoch; /* Used to confirm when the data in this
size_t epoch; /* Used to confirm when the data in this
* really structure matches up with the
* ensemble. */
Command *token; /* Reference to the command for which this
* structure is a cache of the resolution. */
Tcl_Obj *fix; /* Corrected spelling, if needed. */
Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand hash
* table. */
Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand
* hash table. */
} EnsembleCmdRep;
static inline Tcl_Obj *
NewNsObj(
@@ -110,8 +111,9 @@ NewNsObj(
if (namespacePtr == TclGetGlobalNamespace(nsPtr->interp)) {
return Tcl_NewStringObj("::", 2);
} else {
return Tcl_NewStringObj(nsPtr->fullName, -1);
}
return Tcl_NewStringObj(nsPtr->fullName, -1);
}
/*
@@ -145,7 +147,7 @@ TclNamespaceEnsembleCmd(
{
Tcl_Namespace *namespacePtr;
Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp), *cxtPtr,
*foundNsPtr, *altFoundNsPtr, *actualCxtPtr;
*foundNsPtr, *altFoundNsPtr, *actualCxtPtr;
Tcl_Command token;
Tcl_DictSearch search;
Tcl_Obj *listObj;
@@ -300,8 +302,7 @@ TclNamespaceEnsembleCmd(
Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
newList);
}
Tcl_DictObjNext(&search, &subcmdWordsObj, &listObj,
&done);
Tcl_DictObjNext(&search, &subcmdWordsObj,&listObj, &done);
} while (!done);
if (allocatedMapFlag) {
@@ -335,8 +336,8 @@ TclNamespaceEnsembleCmd(
}
TclGetNamespaceForQualName(interp, name, cxtPtr,
TCL_CREATE_NS_IF_UNKNOWN, &foundNsPtr, &altFoundNsPtr,
&actualCxtPtr, &simpleName);
TCL_CREATE_NS_IF_UNKNOWN, &foundNsPtr, &altFoundNsPtr, &actualCxtPtr,
&simpleName);
/*
* Create the ensemble. Note that this might delete another ensemble
@@ -346,8 +347,8 @@ TclNamespaceEnsembleCmd(
*/
token = TclCreateEnsembleInNs(interp, simpleName,
(Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr,
(permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
(Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr,
(permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
Tcl_SetEnsembleMappingDict(interp, token, mapObj);
Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
@@ -575,8 +576,7 @@ TclNamespaceEnsembleCmd(
Tcl_AppendStringsToObj(newCmd, "::", NULL);
}
Tcl_AppendObjToObj(newCmd, listv[0]);
Tcl_ListObjReplace(NULL, newList, 0, 1, 1,
&newCmd);
Tcl_ListObjReplace(NULL, newList, 0,1, 1,&newCmd);
if (patchedDict == NULL) {
patchedDict = Tcl_DuplicateObj(objv[1]);
}
@@ -650,13 +650,15 @@ TclNamespaceEnsembleCmd(
Tcl_Command
TclCreateEnsembleInNs(
Tcl_Interp *interp,
const char *name, /* Simple name of command to create (no
* namespace components). */
Tcl_Namespace *nameNsPtr, /* Name of namespace to create the command
* in. */
Tcl_Namespace *ensembleNsPtr,
/* Name of the namespace for the ensemble. */
int flags)
const char *name, /* Simple name of command to create (no */
/* namespace components). */
Tcl_Namespace /* Name of namespace to create the command in. */
*nameNsPtr,
Tcl_Namespace
*ensembleNsPtr, /* Name of the namespace for the ensemble. */
int flags
)
{
Namespace *nsPtr = (Namespace *) ensembleNsPtr;
EnsembleConfig *ensemblePtr;
@@ -664,8 +666,8 @@ TclCreateEnsembleInNs(
ensemblePtr = ckalloc(sizeof(EnsembleConfig));
token = TclNRCreateCommandInNs(interp, name,
(Tcl_Namespace *) nameNsPtr, NsEnsembleImplementationCmd,
NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
(Tcl_Namespace *) nameNsPtr, NsEnsembleImplementationCmd,
NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
if (token == NULL) {
ckfree(ensemblePtr);
return NULL;
@@ -699,15 +701,18 @@ TclCreateEnsembleInNs(
}
return ensemblePtr->token;
}
/*
*----------------------------------------------------------------------
*
* Tcl_CreateEnsemble
*
* Create a simple ensemble attached to the given namespace. Deprecated
* (internally) by TclCreateEnsembleInNs.
* Create a simple ensemble attached to the given namespace.
*
* Deprecated by TclCreateEnsembleInNs.
*
* Value
*
@@ -727,8 +732,8 @@ Tcl_CreateEnsemble(
Tcl_Namespace *namespacePtr,
int flags)
{
Namespace *nsPtr = (Namespace *) namespacePtr, *foundNsPtr, *altNsPtr,
*actualNsPtr;
Namespace *nsPtr = (Namespace *)namespacePtr, *foundNsPtr, *altNsPtr,
*actualNsPtr;
const char * simpleName;
if (nsPtr == NULL) {
@@ -736,10 +741,11 @@ Tcl_CreateEnsemble(
}
TclGetNamespaceForQualName(interp, name, nsPtr, TCL_CREATE_NS_IF_UNKNOWN,
&foundNsPtr, &altNsPtr, &actualNsPtr, &simpleName);
&foundNsPtr, &altNsPtr, &actualNsPtr, &simpleName);
return TclCreateEnsembleInNs(interp, simpleName,
(Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr, flags);
(Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr, flags);
}
/*
*----------------------------------------------------------------------
@@ -2111,27 +2117,22 @@ TclSpellFix(
iPtr->ensembleRewrite.numInsertedObjs = 0;
}
/*
* Compute the valid length of the ensemble root.
*/
/* Compute the valid length of the ensemble root */
size = iPtr->ensembleRewrite.numRemovedObjs + objc
- iPtr->ensembleRewrite.numInsertedObjs;
- iPtr->ensembleRewrite.numInsertedObjs;
search = iPtr->ensembleRewrite.sourceObjs;
if (search[0] == NULL) {
/*
* Awful casting abuse here...
*/
/* Awful casting abuse here */
search = (Tcl_Obj *const *) search[1];
}
if (badIdx < iPtr->ensembleRewrite.numInsertedObjs) {
/*
* Misspelled value was inserted. We cannot directly jump to the bad
* value, but have to search.
* Misspelled value was inserted. We cannot directly jump
* to the bad value, but have to search.
*/
idx = 1;
while (idx < size) {
if (search[idx] == bad) {
@@ -2155,14 +2156,13 @@ TclSpellFix(
search = iPtr->ensembleRewrite.sourceObjs;
if (search[0] == NULL) {
store = (Tcl_Obj **) search[2];
} else {
store = (Tcl_Obj **)search[2];
} else {
Tcl_Obj **tmp = ckalloc(3 * sizeof(Tcl_Obj *));
tmp[0] = NULL;
tmp[1] = (Tcl_Obj *) iPtr->ensembleRewrite.sourceObjs;
tmp[2] = (Tcl_Obj *) ckalloc(size * sizeof(Tcl_Obj *));
memcpy(tmp[2], tmp[1], size * sizeof(Tcl_Obj *));
tmp[1] = (Tcl_Obj *)iPtr->ensembleRewrite.sourceObjs;
tmp[2] = (Tcl_Obj *)ckalloc(size * sizeof(Tcl_Obj *));
memcpy(tmp[2], tmp[1], size*sizeof(Tcl_Obj *));
iPtr->ensembleRewrite.sourceObjs = (Tcl_Obj *const *) tmp;
TclNRAddCallback(interp, FreeER, tmp, NULL, NULL, NULL);
@@ -2589,9 +2589,7 @@ BuildEnsembleConfig(
}
}
} else {
/*
* Usual case where we can freely act on the list and dict.
*/
/* Usual case where we can freely act on the list and dict. */
for (i = 0; i < subc; i++) {
name = TclGetString(subv[i]);
@@ -2600,10 +2598,7 @@ BuildEnsembleConfig(
continue;
}
/*
* Lookup target in the dictionary.
*/
/* Lookup target in the dictionary */
if (mapDict) {
Tcl_DictObjGet(NULL, mapDict, subv[i], &target);
if (target) {
@@ -2615,11 +2610,10 @@ BuildEnsembleConfig(
/*
* target was not in the dictionary so map onto the namespace.
* Note in this case that we do not guarantee that the command
* is actually there; that is the programmer's responsibility
* (or [::unknown] of course).
* Note in this case that we do not guarantee that the
* command is actually there; that is the programmer's
* responsibility (or [::unknown] of course).
*/
cmdObj = Tcl_NewStringObj(name, -1);
cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
Tcl_SetHashValue(hPtr, cmdPrefixObj);
+5 -5
View File
@@ -100,7 +100,7 @@ typedef struct ThreadSpecificData {
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
#if TCL_THREADS
#ifdef TCL_THREADS
typedef struct {
Tcl_ThreadCreateProc *proc; /* Main() function of the thread */
ClientData clientData; /* The one argument to Main() */
@@ -1043,7 +1043,7 @@ TclInitSubsystems(void)
#if USE_TCLALLOC
TclInitAlloc(); /* Process wide mutex init */
#endif
#if TCL_THREADS && defined(USE_THREAD_ALLOC)
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
TclInitThreadAlloc(); /* Setup thread allocator caches */
#endif
#ifdef TCL_MEM_DEBUG
@@ -1220,7 +1220,7 @@ Tcl_Finalize(void)
* Close down the thread-specific object allocator.
*/
#if TCL_THREADS && defined(USE_THREAD_ALLOC)
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
TclFinalizeThreadAlloc();
#endif
@@ -1538,7 +1538,7 @@ Tcl_UpdateObjCmd(
return TCL_OK;
}
#if TCL_THREADS
#ifdef TCL_THREADS
/*
*----------------------------------------------------------------------
*
@@ -1601,7 +1601,7 @@ Tcl_CreateThread(
int flags) /* Flags controlling behaviour of the new
* thread. */
{
#if TCL_THREADS
#ifdef TCL_THREADS
ThreadClientData *cdPtr = ckalloc(sizeof(ThreadClientData));
int result;
+127 -396
View File
@@ -73,11 +73,11 @@ int tclTraceExec = 0;
* expression opcodes (e.g., INST_LOR) in tclCompile.h.
*
* Does not include the string for INST_EXPON (and beyond), as that is
* disjoint for backward-compatability reasons.
* disjoint for backward-compatibility reasons.
*/
static const char *const operatorStrings[] = {
"||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
"|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
"+", "-", "*", "/", "%", "+", "-", "~", "!"
};
@@ -101,64 +101,6 @@ long tclObjsAlloced = 0;
long tclObjsFreed = 0;
long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
#endif /* TCL_COMPILE_STATS */
/*
* Support pre-8.5 bytecodes unless specifically requested otherwise.
*/
#ifndef TCL_SUPPORT_84_BYTECODE
#define TCL_SUPPORT_84_BYTECODE 1
#endif
#if TCL_SUPPORT_84_BYTECODE
/*
* We need to know the tclBuiltinFuncTable to support translation of pre-8.5
* math functions to the namespace-based ::tcl::mathfunc::op in 8.5+.
*/
typedef struct {
const char *name; /* Name of function. */
int numArgs; /* Number of arguments for function. */
} BuiltinFunc;
/*
* Table describing the built-in math functions. Entries in this table are
* indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's
* operand byte.
*/
static BuiltinFunc const tclBuiltinFuncTable[] = {
{"acos", 1},
{"asin", 1},
{"atan", 1},
{"atan2", 2},
{"ceil", 1},
{"cos", 1},
{"cosh", 1},
{"exp", 1},
{"floor", 1},
{"fmod", 2},
{"hypot", 2},
{"log", 1},
{"log10", 1},
{"pow", 2},
{"sin", 1},
{"sinh", 1},
{"sqrt", 1},
{"tan", 1},
{"tanh", 1},
{"abs", 1},
{"double", 1},
{"int", 1},
{"rand", 0},
{"round", 1},
{"srand", 1},
{"wide", 1},
{NULL, 0},
};
#define LAST_BUILTIN_FUNC 25
#endif
/*
* NR_TEBC
@@ -166,7 +108,7 @@ static BuiltinFunc const tclBuiltinFuncTable[] = {
* Minimal data required to fully reconstruct the execution state.
*/
typedef struct TEBCdata {
typedef struct {
ByteCode *codePtr; /* Constant until the BC returns */
/* -----------------------------------------*/
ptrdiff_t *catchTop; /* These fields are used on return TO this */
@@ -2797,91 +2739,6 @@ TEBCresume(
return TclNREvalObjv(interp, objc, objv,
TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL);
#if TCL_SUPPORT_84_BYTECODE
case INST_CALL_BUILTIN_FUNC1:
/*
* Call one of the built-in pre-8.5 Tcl math functions. This
* translates to INST_INVOKE_STK1 with the first argument of
* ::tcl::mathfunc::$objv[0]. We need to insert the named math
* function into the stack.
*/
opnd = TclGetUInt1AtPtr(pc+1);
if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd));
Tcl_Panic("TclNRExecuteByteCode: unrecognized builtin function code %d", opnd);
}
TclNewLiteralStringObj(objPtr, "::tcl::mathfunc::");
Tcl_AppendToObj(objPtr, tclBuiltinFuncTable[opnd].name, -1);
/*
* Only 0, 1 or 2 args.
*/
{
int numArgs = tclBuiltinFuncTable[opnd].numArgs;
Tcl_Obj *tmpPtr1, *tmpPtr2;
if (numArgs == 0) {
PUSH_OBJECT(objPtr);
} else if (numArgs == 1) {
tmpPtr1 = POP_OBJECT();
PUSH_OBJECT(objPtr);
PUSH_OBJECT(tmpPtr1);
Tcl_DecrRefCount(tmpPtr1);
} else {
tmpPtr2 = POP_OBJECT();
tmpPtr1 = POP_OBJECT();
PUSH_OBJECT(objPtr);
PUSH_OBJECT(tmpPtr1);
PUSH_OBJECT(tmpPtr2);
Tcl_DecrRefCount(tmpPtr1);
Tcl_DecrRefCount(tmpPtr2);
}
objc = numArgs + 1;
}
pcAdjustment = 2;
goto doInvocation;
case INST_CALL_FUNC1:
/*
* Call a non-builtin Tcl math function previously registered by a
* call to Tcl_CreateMathFunc pre-8.5. This is essentially
* INST_INVOKE_STK1 converting the first arg to
* ::tcl::mathfunc::$objv[0].
*/
objc = TclGetUInt1AtPtr(pc+1); /* Number of arguments. The function
* name is the 0-th argument. */
objPtr = OBJ_AT_DEPTH(objc-1);
TclNewLiteralStringObj(tmpPtr, "::tcl::mathfunc::");
Tcl_AppendObjToObj(tmpPtr, objPtr);
Tcl_DecrRefCount(objPtr);
/*
* Variation of PUSH_OBJECT.
*/
OBJ_AT_DEPTH(objc-1) = tmpPtr;
Tcl_IncrRefCount(tmpPtr);
pcAdjustment = 2;
goto doInvocation;
#else
/*
* INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 were made obsolete by the
* changes to add a ::tcl::mathfunc namespace in 8.5. Optional support
* remains for existing bytecode precompiled files.
*/
case INST_CALL_BUILTIN_FUNC1:
Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found");
case INST_CALL_FUNC1:
Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found");
#endif
case INST_INVOKE_REPLACE:
objc = TclGetUInt4AtPtr(pc+1);
opnd = TclGetUInt1AtPtr(pc+5);
@@ -3964,29 +3821,6 @@ TEBCresume(
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
/*
* This is really an unset operation these days. Do not issue.
*/
case INST_DICT_DONE:
opnd = TclGetUInt4AtPtr(pc+1);
TRACE(("%u => OK\n", opnd));
varPtr = LOCAL(opnd);
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) {
if (!TclIsVarUndefined(varPtr)) {
TclDecrRefCount(varPtr->value.objPtr);
}
varPtr->value.objPtr = NULL;
} else {
DECACHE_STACK_INFO();
TclPtrUnsetVarIdx(interp, varPtr, NULL, NULL, NULL, 0, opnd);
CACHE_STACK_INFO();
}
NEXT_INST_F(5, 0, 0);
}
/*
@@ -4307,50 +4141,6 @@ TEBCresume(
}
}
/*
* These two instructions are now redundant: the complete logic of the LOR
* and LAND is now handled by the expression compiler.
*/
case INST_LOR:
case INST_LAND: {
/*
* Operands must be boolean or numeric. No int->double conversions are
* performed.
*/
int i1, i2, iResult;
value2Ptr = OBJ_AT_TOS;
valuePtr = OBJ_UNDER_TOS;
if (TclGetBooleanFromObj(NULL, valuePtr, &i1) != TCL_OK) {
TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
(valuePtr->typePtr? valuePtr->typePtr->name : "null")));
DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
CACHE_STACK_INFO();
goto gotError;
}
if (TclGetBooleanFromObj(NULL, value2Ptr, &i2) != TCL_OK) {
TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr),
(value2Ptr->typePtr? value2Ptr->typePtr->name : "null")));
DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, value2Ptr);
CACHE_STACK_INFO();
goto gotError;
}
if (*pc == INST_LOR) {
iResult = (i1 || i2);
} else {
iResult = (i1 && i2);
}
objResultPtr = TCONST(iResult);
TRACE(("%.20s %.20s => %d\n", O2S(valuePtr),O2S(value2Ptr),iResult));
NEXT_INST_F(1, 2, 1);
}
/*
* -----------------------------------------------------------------
* Start of general introspector instructions.
@@ -5088,10 +4878,124 @@ TEBCresume(
value2Ptr = OBJ_AT_TOS;
valuePtr = OBJ_UNDER_TOS;
{
if (valuePtr == value2Ptr) {
match = 0;
} else {
/*
* We only need to check (in)equality when we have equal length
* strings. We can use memcmp in all (n)eq cases because we
* don't need to worry about lexical LE/BE variance.
*/
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
memCmpFn_t memCmpFn;
int checkEq = ((*pc == INST_EQ) || (*pc == INST_NEQ)
|| (*pc == INST_STR_EQ) || (*pc == INST_STR_NEQ));
match = TclStringCmp(valuePtr, value2Ptr, checkEq, 0, -1);
if (TclIsPureByteArray(valuePtr)
&& TclIsPureByteArray(value2Ptr)) {
s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len);
s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
memCmpFn = memcmp;
} else if ((valuePtr->typePtr == &tclStringType)
&& (value2Ptr->typePtr == &tclStringType)) {
/*
* Do a unicode-specific comparison if both of the args are of
* String type. If the char length == byte length, we can do a
* memcmp. In benchmark testing this proved the most efficient
* check between the unicode and string comparison operations.
*/
s1len = Tcl_GetCharLength(valuePtr);
s2len = Tcl_GetCharLength(value2Ptr);
if ((s1len == valuePtr->length)
&& (valuePtr->bytes != NULL)
&& (s2len == value2Ptr->length)
&& (value2Ptr->bytes != NULL)) {
s1 = valuePtr->bytes;
s2 = value2Ptr->bytes;
memCmpFn = memcmp;
} else {
s1 = (char *) Tcl_GetUnicode(valuePtr);
s2 = (char *) Tcl_GetUnicode(value2Ptr);
if (
#ifdef WORDS_BIGENDIAN
1
#else
checkEq
#endif
) {
memCmpFn = memcmp;
s1len *= sizeof(Tcl_UniChar);
s2len *= sizeof(Tcl_UniChar);
} else {
memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp;
}
}
} else {
/*
* In order to handle the special Tcl \xC0\x80 null encoding
* for utf-8, strcmp can't do a simple memcmp.
*/
if (TclCheckEmptyString(valuePtr) > 0) {
s1 = "";
s1len = 0;
switch (TclCheckEmptyString(value2Ptr)) {
case -1:
s2 = TclGetStringFromObj(value2Ptr, &s2len);
break;
case 0:
/* Synthesize a value for comparison */
s2 = "1";
s2len = 1;
break;
case 1:
s2 = "";
s2len = 0;
}
} else if (TclCheckEmptyString(value2Ptr) > 0) {
s2 = "";
s2len = 0;
switch (TclCheckEmptyString(valuePtr)) {
case -1:
s1 = TclGetStringFromObj(valuePtr, &s1len);
break;
case 0:
/* Synthesize a value for comparison */
s1 = "1";
s1len = 1;
break;
case 1:
s1 = "";
s1len = 0;
}
} else {
s1 = TclGetStringFromObj(valuePtr, &s1len);
s2 = TclGetStringFromObj(value2Ptr, &s2len);
}
if (checkEq) {
memCmpFn = memcmp;
} else {
memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
}
}
if (checkEq && (s1len != s2len)) {
match = 1;
} else {
/*
* The comparison function should compare up to the minimum
* byte length only.
*/
match = memCmpFn(s1, s2,
(size_t) ((s1len < s2len) ? s1len : s2len));
if (match == 0) {
match = s1len - s2len;
}
}
}
/*
@@ -6335,170 +6239,6 @@ TEBCresume(
TRACE(("=> CONTINUE!\n"));
goto processExceptionReturn;
{
ForeachInfo *infoPtr;
Var *iterVarPtr, *listVarPtr;
Tcl_Obj *oldValuePtr, *listPtr, **elements;
ForeachVarList *varListPtr;
int numLists, listTmpIndex, listLen, numVars;
size_t iterNum;
int varIndex, valIndex, continueLoop, j, iterTmpIndex;
long i;
case INST_FOREACH_START4: /* DEPRECATED */
/*
* Initialize the temporary local var that holds the count of the
* number of iterations of the loop body to -1.
*/
opnd = TclGetUInt4AtPtr(pc+1);
infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
iterTmpIndex = infoPtr->loopCtTemp;
iterVarPtr = LOCAL(iterTmpIndex);
oldValuePtr = iterVarPtr->value.objPtr;
if (oldValuePtr == NULL) {
TclNewIntObj(iterVarPtr->value.objPtr, -1);
Tcl_IncrRefCount(iterVarPtr->value.objPtr);
} else {
TclSetIntObj(oldValuePtr, -1);
}
TRACE(("%u => loop iter count temp %d\n", opnd, iterTmpIndex));
#ifndef TCL_COMPILE_DEBUG
/*
* Remark that the compiler ALWAYS sets INST_FOREACH_STEP4 immediately
* after INST_FOREACH_START4 - let us just fall through instead of
* jumping back to the top.
*/
pc += 5;
TCL_DTRACE_INST_NEXT();
#else
NEXT_INST_F(5, 0, 0);
#endif
case INST_FOREACH_STEP4: /* DEPRECATED */
/*
* "Step" a foreach loop (i.e., begin its next iteration) by assigning
* the next value list element to each loop var.
*/
opnd = TclGetUInt4AtPtr(pc+1);
TRACE(("%u => ", opnd));
infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
numLists = infoPtr->numLists;
/*
* Increment the temp holding the loop iteration number.
*/
iterVarPtr = LOCAL(infoPtr->loopCtTemp);
valuePtr = iterVarPtr->value.objPtr;
iterNum = (size_t)valuePtr->internalRep.wideValue + 1;
TclSetIntObj(valuePtr, iterNum);
/*
* Check whether all value lists are exhausted and we should stop the
* loop.
*/
continueLoop = 0;
listTmpIndex = infoPtr->firstValueTemp;
for (i = 0; i < numLists; i++) {
varListPtr = infoPtr->varLists[i];
numVars = varListPtr->numVars;
listVarPtr = LOCAL(listTmpIndex);
listPtr = listVarPtr->value.objPtr;
if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
TRACE_APPEND(("ERROR converting list %ld, \"%.30s\": %s\n",
i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
goto gotError;
}
if ((size_t)listLen > iterNum * numVars) {
continueLoop = 1;
}
listTmpIndex++;
}
/*
* If some var in some var list still has a remaining list element
* iterate one more time. Assign to var the next element from its
* value list. We already checked above that each list temp holds a
* valid list object (by calling Tcl_ListObjLength), but cannot rely
* on that check remaining valid: one list could have been shimmered
* as a side effect of setting a traced variable.
*/
if (continueLoop) {
listTmpIndex = infoPtr->firstValueTemp;
for (i = 0; i < numLists; i++) {
varListPtr = infoPtr->varLists[i];
numVars = varListPtr->numVars;
listVarPtr = LOCAL(listTmpIndex);
listPtr = TclListObjCopy(NULL, listVarPtr->value.objPtr);
TclListObjGetElements(interp, listPtr, &listLen, &elements);
valIndex = (iterNum * numVars);
for (j = 0; j < numVars; j++) {
if (valIndex >= listLen) {
TclNewObj(valuePtr);
} else {
valuePtr = elements[valIndex];
}
varIndex = varListPtr->varIndexes[j];
varPtr = LOCAL(varIndex);
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
if (TclIsVarDirectWritable(varPtr)) {
value2Ptr = varPtr->value.objPtr;
if (valuePtr != value2Ptr) {
if (value2Ptr != NULL) {
TclDecrRefCount(value2Ptr);
}
varPtr->value.objPtr = valuePtr;
Tcl_IncrRefCount(valuePtr);
}
} else {
DECACHE_STACK_INFO();
if (TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL,
valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
CACHE_STACK_INFO();
TRACE_APPEND((
"ERROR init. index temp %d: %s\n",
varIndex, O2S(Tcl_GetObjResult(interp))));
TclDecrRefCount(listPtr);
goto gotError;
}
CACHE_STACK_INFO();
}
valIndex++;
}
TclDecrRefCount(listPtr);
listTmpIndex++;
}
}
TRACE_APPEND(("%d lists, iter %" TCL_Z_MODIFIER "d, %s loop\n",
numLists, iterNum, (continueLoop? "continue" : "exit")));
/*
* Run-time peep-hole optimisation: the compiler ALWAYS follows
* INST_FOREACH_STEP4 with an INST_JUMP_FALSE. We just skip that
* instruction and jump direct from here.
*/
pc += 5;
if (*pc == INST_JUMP_FALSE1) {
NEXT_INST_F((continueLoop? 2 : TclGetInt1AtPtr(pc+1)), 0, 0);
} else {
NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
}
}
{
ForeachInfo *infoPtr;
Tcl_Obj *listPtr, **elements, *tmpPtr;
@@ -8989,10 +8729,9 @@ PrintByteCodeInfo(
Proc *procPtr = codePtr->procPtr;
Interp *iPtr = (Interp *) *codePtr->interpHandle;
fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %u, interp 0x%p (epoch %u)\n",
fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp 0x%p (epoch %" TCL_Z_MODIFIER "u)\n",
codePtr, (size_t)codePtr->refCount, codePtr->compileEpoch, iPtr,
iPtr->compileEpoch);
fprintf(stdout, " Source: ");
TclPrintSource(stdout, codePtr->source, 60);
@@ -9018,7 +8757,7 @@ PrintByteCodeInfo(
#endif /* TCL_COMPILE_STATS */
if (procPtr != NULL) {
fprintf(stdout,
" Proc 0x%p, refCt %d, args %d, compiled locals %d\n",
" Proc 0x%p, refCt %zd, args %d, compiled locals %d\n",
procPtr, procPtr->refCount, procPtr->numArgs,
procPtr->numCompiledLocals);
}
@@ -9070,7 +8809,7 @@ ValidatePcAndStackTop(
pc);
Tcl_Panic("TclNRExecuteByteCode execution failure: bad pc");
}
if ((unsigned) opCode > LAST_INST_OPCODE) {
if ((unsigned) opCode >= LAST_INST_OPCODE) {
fprintf(stderr, "\nBad opcode %d at pc %u in TclNRExecuteByteCode\n",
(unsigned) opCode, relativePc);
Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode");
@@ -9133,20 +8872,11 @@ IllegalExprOperandType(
if (opcode == INST_EXPON) {
operator = "**";
} else if (opcode <= INST_LNOT) {
operator = operatorStrings[opcode - INST_LOR];
operator = operatorStrings[opcode - INST_BITOR];
}
if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {
int numBytes;
const char *bytes = TclGetStringFromObj(opndPtr, &numBytes);
if (numBytes == 0) {
description = "empty string";
} else if (TclCheckBadOctal(NULL, bytes)) {
description = "invalid octal number";
} else {
description = "non-numeric string";
}
description = "non-numeric string";
} else if (type == TCL_NUMBER_NAN) {
description = "non-numeric floating-point value";
} else if (type == TCL_NUMBER_DOUBLE) {
@@ -9157,7 +8887,8 @@ IllegalExprOperandType(
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't use %s as operand of \"%s\"", description, operator));
"can't use %s \"%s\" as operand of \"%s\"", description,
Tcl_GetString(opndPtr), operator));
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL);
}
@@ -9968,7 +9699,7 @@ EvalStatsCmd(
*/
Tcl_AppendPrintfToObj(objPtr, "\nInstruction counts:\n");
for (i = 0; i <= LAST_INST_OPCODE; i++) {
for (i = 0; i < LAST_INST_OPCODE; i++) {
Tcl_AppendPrintfToObj(objPtr, "%20s %8ld ",
tclInstructionTable[i].name, statsPtr->instructionCount[i]);
if (statsPtr->instructionCount[i]) {
+1 -1
View File
@@ -142,7 +142,7 @@ Tcl_GetBoolean(
Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
if (code == TCL_OK) {
TclGetBooleanFromObj(NULL, &obj, boolPtr);
*boolPtr = obj.internalRep.wideValue != 0;
}
return code;
}
+18 -43
View File
@@ -13,13 +13,6 @@
#include "tclInt.h"
/*
* Prevent macros from clashing with function definitions.
*/
#undef Tcl_FindHashEntry
#undef Tcl_CreateHashEntry
/*
* When there are this many entries per bucket, on average, rebuild the hash
* table to make it larger.
@@ -35,7 +28,7 @@
*/
#define RANDOM_INDEX(tablePtr, i) \
((((i)*1103515245L) >> (tablePtr)->downShift) & (tablePtr)->mask)
((((i)*1103515245UL) >> (tablePtr)->downShift) & (tablePtr)->mask)
/*
* Prototypes for the array hash key methods.
@@ -200,7 +193,7 @@ Tcl_InitCustomHashTable(
/*
*----------------------------------------------------------------------
*
* Tcl_FindHashEntry --
* FindHashEntry --
*
* Given a hash table find the entry with a matching key.
*
@@ -214,14 +207,6 @@ Tcl_InitCustomHashTable(
*----------------------------------------------------------------------
*/
Tcl_HashEntry *
Tcl_FindHashEntry(
Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
const void *key) /* Key to use to find matching entry. */
{
return (*((tablePtr)->findProc))(tablePtr, key);
}
static Tcl_HashEntry *
FindHashEntry(
Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
@@ -234,7 +219,7 @@ FindHashEntry(
/*
*----------------------------------------------------------------------
*
* Tcl_CreateHashEntry --
* CreateHashEntry --
*
* Given a hash table with string keys, and a string key, find the entry
* with a matching key. If there is no matching entry, then create a new
@@ -252,17 +237,6 @@ FindHashEntry(
*----------------------------------------------------------------------
*/
Tcl_HashEntry *
Tcl_CreateHashEntry(
Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
const void *key, /* Key to use to find or create matching
* entry. */
int *newPtr) /* Store info here telling whether a new entry
* was created. */
{
return (*((tablePtr)->createProc))(tablePtr, key, newPtr);
}
static Tcl_HashEntry *
CreateHashEntry(
Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
@@ -274,7 +248,7 @@ CreateHashEntry(
register Tcl_HashEntry *hPtr;
const Tcl_HashKeyType *typePtr;
unsigned int hash;
int index;
unsigned int index;
if (tablePtr->keyType == TCL_STRING_KEYS) {
typePtr = &tclStringHashKeyType;
@@ -308,7 +282,7 @@ CreateHashEntry(
for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
hPtr = hPtr->nextPtr) {
if (hash != PTR2UINT(hPtr->hash)) {
if (hash != hPtr->hash) {
continue;
}
if (((void *) key == hPtr) || compareKeysProc((void *) key, hPtr)) {
@@ -321,7 +295,7 @@ CreateHashEntry(
} else {
for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
hPtr = hPtr->nextPtr) {
if (hash != PTR2UINT(hPtr->hash)) {
if (hash != hPtr->hash) {
continue;
}
if (key == hPtr->key.oneWordValue) {
@@ -351,7 +325,7 @@ CreateHashEntry(
}
hPtr->tablePtr = tablePtr;
hPtr->hash = UINT2PTR(hash);
hPtr->hash = hash;
hPtr->nextPtr = tablePtr->buckets[index];
tablePtr->buckets[index] = hPtr;
tablePtr->numEntries++;
@@ -393,7 +367,7 @@ Tcl_DeleteHashEntry(
const Tcl_HashKeyType *typePtr;
Tcl_HashTable *tablePtr;
Tcl_HashEntry **bucketPtr;
int index;
unsigned int index;
tablePtr = entryPtr->tablePtr;
@@ -410,9 +384,9 @@ Tcl_DeleteHashEntry(
if (typePtr->hashKeyProc == NULL
|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
index = RANDOM_INDEX(tablePtr, PTR2INT(entryPtr->hash));
index = RANDOM_INDEX(tablePtr, entryPtr->hash);
} else {
index = PTR2UINT(entryPtr->hash) & tablePtr->mask;
index = entryPtr->hash & tablePtr->mask;
}
bucketPtr = &tablePtr->buckets[index];
@@ -767,14 +741,14 @@ HashArrayKey(
void *keyPtr) /* Key from which to compute hash value. */
{
register const int *array = (const int *) keyPtr;
register unsigned int result;
register TCL_HASH_TYPE result;
int count;
for (result = 0, count = tablePtr->keyType; count > 0;
count--, array++) {
result += *array;
}
return (TCL_HASH_TYPE) result;
return result;
}
/*
@@ -863,7 +837,7 @@ HashStringKey(
void *keyPtr) /* Key from which to compute hash value. */
{
register const char *string = keyPtr;
register unsigned int result;
register TCL_HASH_TYPE result;
register char c;
/*
@@ -903,7 +877,7 @@ HashStringKey(
result += (result << 3) + UCHAR(c);
}
}
return (TCL_HASH_TYPE) result;
return result;
}
/*
@@ -985,7 +959,8 @@ static void
RebuildTable(
register Tcl_HashTable *tablePtr) /* Table to enlarge. */
{
int count, index, oldSize = tablePtr->numBuckets;
int count, oldSize = tablePtr->numBuckets;
unsigned int index;
Tcl_HashEntry **oldBuckets = tablePtr->buckets;
register Tcl_HashEntry **oldChainPtr, **newChainPtr;
register Tcl_HashEntry *hPtr;
@@ -1038,9 +1013,9 @@ RebuildTable(
*oldChainPtr = hPtr->nextPtr;
if (typePtr->hashKeyProc == NULL
|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
index = RANDOM_INDEX(tablePtr, PTR2INT(hPtr->hash));
index = RANDOM_INDEX(tablePtr, hPtr->hash);
} else {
index = PTR2UINT(hPtr->hash) & tablePtr->mask;
index = hPtr->hash & tablePtr->mask;
}
hPtr->nextPtr = tablePtr->buckets[index];
tablePtr->buckets[index] = hPtr;
-7
View File
@@ -73,13 +73,6 @@ Tcl_RecordAndEval(
Tcl_IncrRefCount(cmdPtr);
result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);
/*
* Move the interpreter's object result to the string result, then
* reset the object result.
*/
(void) Tcl_GetStringResult(interp);
/*
* Discard the Tcl object created to hold the command.
*/
-14
View File
@@ -9036,20 +9036,6 @@ ZeroTransferTimerProc(
*----------------------------------------------------------------------
*/
#if !defined(TCL_NO_DEPRECATED)
int
TclCopyChannelOld(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Channel inChan, /* Channel to read from. */
Tcl_Channel outChan, /* Channel to write to. */
int toRead, /* Amount of data to copy, or -1 for all. */
Tcl_Obj *cmdPtr) /* Pointer to script to execute or NULL. */
{
return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead,
cmdPtr);
}
#endif
int
TclCopyChannel(
Tcl_Interp *interp, /* Current interpreter. */
+1 -28
View File
@@ -15,7 +15,7 @@
* Callback structure for accept callback in a TCP server.
*/
typedef struct AcceptCallback {
typedef struct {
Tcl_Obj *script; /* Script to invoke. */
Tcl_Interp *interp; /* Interpreter in which to run it. */
} AcceptCallback;
@@ -137,19 +137,6 @@ Tcl_PutsObjCmd(
chanObjPtr = objv[2];
string = objv[3];
break;
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
} else if (strcmp(TclGetString(objv[3]), "nonewline") == 0) {
/*
* The code below provides backwards compatibility with an old
* form of the command that is no longer recommended or
* documented. See also [Bug #3151675]. Will be removed in Tcl 9,
* maybe even earlier.
*/
chanObjPtr = objv[1];
string = objv[2];
break;
#endif
}
/* Fall through */
default: /* [puts] or
@@ -439,25 +426,11 @@ Tcl_ReadObjCmd(
if (i < objc) {
if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK)
|| (toRead < 0)) {
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*
* The code below provides backwards compatibility with an old
* form of the command that is no longer recommended or
* documented. See also [Bug #3151675]. Will be removed in Tcl 9,
* maybe even earlier.
*/
if (strcmp(TclGetString(objv[i]), "nonewline") != 0) {
#endif
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected non-negative integer but got \"%s\"",
TclGetString(objv[i])));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
return TCL_ERROR;
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
}
newline = 1;
#endif
}
}
+24 -24
View File
@@ -39,7 +39,7 @@ static int ReflectOutput(ClientData clientData, const char *buf,
int toWrite, int *errorCodePtr);
static void ReflectWatch(ClientData clientData, int mask);
static int ReflectBlock(ClientData clientData, int mode);
#if TCL_THREADS
#ifdef TCL_THREADS
static void ReflectThread(ClientData clientData, int action);
static int ReflectEventRun(Tcl_Event *ev, int flags);
static int ReflectEventDelete(Tcl_Event *ev, ClientData cd);
@@ -76,7 +76,7 @@ static const Tcl_ChannelType tclRChannelType = {
NULL, /* Flush channel. Not used by core. NULL'able */
NULL, /* Handle events. NULL'able */
ReflectSeekWide, /* Move access point (64 bit). NULL'able */
#if TCL_THREADS
#ifdef TCL_THREADS
ReflectThread, /* thread action, tracking owner */
#else
NULL, /* thread action */
@@ -97,7 +97,7 @@ typedef struct {
* interpreter/thread containing its Tcl
* command is gone.
*/
#if TCL_THREADS
#ifdef TCL_THREADS
Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */
Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */
#endif
@@ -201,7 +201,7 @@ typedef enum {
#define NEGIMPL(a,b)
#define HAS(x,f) (x & FLAG(f))
#if TCL_THREADS
#ifdef TCL_THREADS
/*
* Thread specific types and structures.
*
@@ -451,7 +451,7 @@ static const char *msg_read_toomuch = "{read delivered more than requested}";
static const char *msg_write_toomuch = "{write wrote more than requested}";
static const char *msg_write_nothing = "{write wrote nothing}";
static const char *msg_seek_beforestart = "{Tried to seek before origin}";
#if TCL_THREADS
#ifdef TCL_THREADS
static const char *msg_send_originlost = "{Channel thread lost}";
#endif /* TCL_THREADS */
static const char *msg_send_dstlost = "{Owner lost}";
@@ -706,7 +706,7 @@ TclChanCreateObjCmd(
Tcl_Panic("TclChanCreateObjCmd: duplicate channel names");
}
Tcl_SetHashValue(hPtr, chan);
#if TCL_THREADS
#ifdef TCL_THREADS
rcmPtr = GetThreadReflectedChannelMap();
hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName,
&isNew);
@@ -750,7 +750,7 @@ TclChanCreateObjCmd(
*----------------------------------------------------------------------
*/
#if TCL_THREADS
#ifdef TCL_THREADS
typedef struct {
Tcl_Event header;
ReflectedChannel *rcPtr;
@@ -917,11 +917,11 @@ TclChanPostEventObjCmd(
* We have the channel and the events to post.
*/
#if TCL_THREADS
#ifdef TCL_THREADS
if (rcPtr->owner == rcPtr->thread) {
#endif
Tcl_NotifyChannel(chan, events);
#if TCL_THREADS
#ifdef TCL_THREADS
} else {
ReflectEvent *ev = ckalloc(sizeof(ReflectEvent));
@@ -1137,7 +1137,7 @@ ReflectClose(
* if lost?
*/
#if TCL_THREADS
#ifdef TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1169,7 +1169,7 @@ ReflectClose(
* Are we in the correct thread?
*/
#if TCL_THREADS
#ifdef TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1216,7 +1216,7 @@ ReflectClose(
Tcl_DeleteHashEntry(hPtr);
}
}
#if TCL_THREADS
#ifdef TCL_THREADS
rcmPtr = GetThreadReflectedChannelMap();
hPtr = Tcl_FindHashEntry(&rcmPtr->map,
Tcl_GetChannelName(rcPtr->chan));
@@ -1267,7 +1267,7 @@ ReflectInput(
* Are we in the correct thread?
*/
#if TCL_THREADS
#ifdef TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1373,7 +1373,7 @@ ReflectOutput(
* Are we in the correct thread?
*/
#if TCL_THREADS
#ifdef TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1502,7 +1502,7 @@ ReflectSeekWide(
* Are we in the correct thread?
*/
#if TCL_THREADS
#ifdef TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1625,7 +1625,7 @@ ReflectWatch(
* Are we in the correct thread?
*/
#if TCL_THREADS
#ifdef TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1683,7 +1683,7 @@ ReflectBlock(
* Are we in the correct thread?
*/
#if TCL_THREADS
#ifdef TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1719,7 +1719,7 @@ ReflectBlock(
return errorNum;
}
#if TCL_THREADS
#ifdef TCL_THREADS
/*
*----------------------------------------------------------------------
*
@@ -1789,7 +1789,7 @@ ReflectSetOption(
* Are we in the correct thread?
*/
#if TCL_THREADS
#ifdef TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1868,7 +1868,7 @@ ReflectGetOption(
* Are we in the correct thread?
*/
#if TCL_THREADS
#ifdef TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
int opcode;
ForwardParam p;
@@ -2131,7 +2131,7 @@ NewReflectedChannel(
rcPtr->chan = NULL;
rcPtr->interp = interp;
rcPtr->dead = 0;
#if TCL_THREADS
#ifdef TCL_THREADS
rcPtr->thread = Tcl_GetCurrentThread();
#endif
rcPtr->mode = mode;
@@ -2506,7 +2506,7 @@ DeleteReflectedChannelMap(
Tcl_HashEntry *hPtr; /* Search variable. */
ReflectedChannel *rcPtr;
Tcl_Channel chan;
#if TCL_THREADS
#ifdef TCL_THREADS
ForwardingResult *resultPtr;
ForwardingEvent *evPtr;
ForwardParam *paramPtr;
@@ -2536,7 +2536,7 @@ DeleteReflectedChannelMap(
Tcl_DeleteHashTable(&rcmPtr->map);
ckfree(&rcmPtr->map);
#if TCL_THREADS
#ifdef TCL_THREADS
/*
* The origin interpreter for one or more reflected channels is gone.
*/
@@ -2622,7 +2622,7 @@ DeleteReflectedChannelMap(
#endif
}
#if TCL_THREADS
#ifdef TCL_THREADS
/*
*----------------------------------------------------------------------
*
+19 -19
View File
@@ -127,7 +127,7 @@ typedef struct {
* in the argv, see below. The separate field
* gives us direct access, needed when working
* with the reflection maps. */
#if TCL_THREADS
#ifdef TCL_THREADS
Tcl_ThreadId thread; /* Thread the 'interp' belongs to. */
#endif
@@ -220,7 +220,7 @@ typedef enum {
#define NEGIMPL(a,b)
#define HAS(x,f) (x & FLAG(f))
#if TCL_THREADS
#ifdef TCL_THREADS
/*
* Thread specific types and structures.
*
@@ -438,7 +438,7 @@ static void DeleteReflectedTransformMap(ClientData clientData,
static const char *msg_read_unsup = "{read not supported by Tcl driver}";
static const char *msg_write_unsup = "{write not supported by Tcl driver}";
#if TCL_THREADS
#ifdef TCL_THREADS
static const char *msg_send_originlost = "{Channel thread lost}";
static const char *msg_send_dstlost = "{Owner lost}";
#endif /* TCL_THREADS */
@@ -699,7 +699,7 @@ TclChanPushObjCmd(
Tcl_Panic("TclChanPushObjCmd: duplicate transformation handle");
}
Tcl_SetHashValue(hPtr, rtPtr);
#if TCL_THREADS
#ifdef TCL_THREADS
rtmPtr = GetThreadReflectedTransformMap();
hPtr = Tcl_CreateHashEntry(&rtmPtr->map, TclGetString(rtId), &isNew);
Tcl_SetHashValue(hPtr, rtPtr);
@@ -911,7 +911,7 @@ ReflectClose(
* if lost?
*/
#if TCL_THREADS
#ifdef TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -938,7 +938,7 @@ ReflectClose(
if (HAS(rtPtr->methods, METH_DRAIN) && !rtPtr->readIsDrained) {
if (!TransformDrain(rtPtr, &errorCode)) {
#if TCL_THREADS
#ifdef TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
Tcl_EventuallyFree(rtPtr,
(Tcl_FreeProc *) FreeReflectedTransform);
@@ -952,7 +952,7 @@ ReflectClose(
if (HAS(rtPtr->methods, METH_FLUSH)) {
if (!TransformFlush(rtPtr, &errorCode, FLUSH_WRITE)) {
#if TCL_THREADS
#ifdef TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
Tcl_EventuallyFree(rtPtr,
(Tcl_FreeProc *) FreeReflectedTransform);
@@ -968,7 +968,7 @@ ReflectClose(
* Are we in the correct thread?
*/
#if TCL_THREADS
#ifdef TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1025,7 +1025,7 @@ ReflectClose(
* under a channel by deleting the owning thread.
*/
#if TCL_THREADS
#ifdef TCL_THREADS
rtmPtr = GetThreadReflectedTransformMap();
hPtr = Tcl_FindHashEntry(&rtmPtr->map, TclGetString(rtPtr->handle));
if (hPtr) {
@@ -1767,7 +1767,7 @@ NewReflectedTransform(
rtPtr->chan = NULL;
rtPtr->methods = 0;
#if TCL_THREADS
#ifdef TCL_THREADS
rtPtr->thread = Tcl_GetCurrentThread();
#endif
rtPtr->parent = parentChan;
@@ -2152,7 +2152,7 @@ DeleteReflectedTransformMap(
Tcl_HashSearch hSearch; /* Search variable. */
Tcl_HashEntry *hPtr; /* Search variable. */
ReflectedTransform *rtPtr;
#if TCL_THREADS
#ifdef TCL_THREADS
ForwardingResult *resultPtr;
ForwardingEvent *evPtr;
ForwardParam *paramPtr;
@@ -2182,7 +2182,7 @@ DeleteReflectedTransformMap(
Tcl_DeleteHashTable(&rtmPtr->map);
ckfree(&rtmPtr->map);
#if TCL_THREADS
#ifdef TCL_THREADS
/*
* The origin interpreter for one or more reflected channels is gone.
*/
@@ -2254,7 +2254,7 @@ DeleteReflectedTransformMap(
#endif /* TCL_THREADS */
}
#if TCL_THREADS
#ifdef TCL_THREADS
/*
*----------------------------------------------------------------------
*
@@ -3088,7 +3088,7 @@ TransformRead(
* Are we in the correct thread?
*/
#if TCL_THREADS
#ifdef TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -3144,7 +3144,7 @@ TransformWrite(
* Are we in the correct thread?
*/
#if TCL_THREADS
#ifdef TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -3210,7 +3210,7 @@ TransformDrain(
* Are we in the correct thread?
*/
#if TCL_THREADS
#ifdef TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -3260,7 +3260,7 @@ TransformFlush(
* Are we in the correct thread?
*/
#if TCL_THREADS
#ifdef TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -3315,7 +3315,7 @@ TransformClear(
* Are we in the correct thread?
*/
#if TCL_THREADS
#ifdef TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -3347,7 +3347,7 @@ TransformLimit(
* Are we in the correct thread?
*/
#if TCL_THREADS
#ifdef TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
+1 -1
View File
@@ -223,7 +223,7 @@ TclCreateSocketAddress(
* using AI_ADDRCONFIG is probably low even in situations where it works,
* we'll leave it out for now. After all, it is just an optimisation.
*
* Missing on: OpenBSD, NetBSD.
* Missing on NetBSD.
* Causes failure when used on AIX 5.1 and HP-UX
*/
+2 -2
View File
@@ -3197,8 +3197,8 @@ TclSkipUnlink(
#ifndef AUFS_SUPER_MAGIC
#define AUFS_SUPER_MAGIC ('a' << 24 | 'u' << 16 | 'f' << 8 | 's')
#endif /* AUFS_SUPER_MAGIC */
if ((statfs(Tcl_GetString(shlibFile), &fs) == 0)
&& (fs.f_type == AUFS_SUPER_MAGIC)) {
if ((statfs(Tcl_GetString (shlibFile), &fs) == 0) &&
(fs.f_type == AUFS_SUPER_MAGIC)) {
return 1;
}
}
+2 -31
View File
@@ -881,29 +881,6 @@ Tcl_WrongNumArgs(
Interp *iPtr = (Interp *) interp;
const char *elementStr;
/*
* [incr Tcl] does something fairly horrific when generating error
* messages for its ensembles; it passes the whole set of ensemble
* arguments as a list in the first argument. This means that this code
* causes a problem in iTcl if it attempts to correctly quote all
* arguments, which would be the correct thing to do. We work around this
* nasty behaviour for now, and hope that we can remove it all in the
* future...
*/
#ifndef AVOID_HACKS_FOR_ITCL
int isFirst = 1; /* Special flag used to inhibit the treating
* of the first word as a list element so the
* hacky way Itcl generates error messages for
* its ensembles will still work. [Bug
* 1066837] */
# define MAY_QUOTE_WORD (!isFirst)
# define AFTER_FIRST_WORD (isFirst = 0)
#else /* !AVOID_HACKS_FOR_ITCL */
# define MAY_QUOTE_WORD 1
# define AFTER_FIRST_WORD (void) 0
#endif /* AVOID_HACKS_FOR_ITCL */
TclNewObj(objPtr);
if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) {
iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
@@ -970,7 +947,7 @@ Tcl_WrongNumArgs(
flags = 0;
len = TclScanElement(elementStr, elemLen, &flags);
if (MAY_QUOTE_WORD && len != elemLen) {
if (len != elemLen) {
char *quotedElementStr = TclStackAlloc(interp,
(unsigned)len + 1);
@@ -982,8 +959,6 @@ Tcl_WrongNumArgs(
Tcl_AppendToObj(objPtr, elementStr, elemLen);
}
AFTER_FIRST_WORD;
/*
* Add a space if the word is not the last one (which has a
* moderately complex condition here).
@@ -1021,7 +996,7 @@ Tcl_WrongNumArgs(
flags = 0;
len = TclScanElement(elementStr, elemLen, &flags);
if (MAY_QUOTE_WORD && len != elemLen) {
if (len != elemLen) {
char *quotedElementStr = TclStackAlloc(interp,
(unsigned) len + 1);
@@ -1034,8 +1009,6 @@ Tcl_WrongNumArgs(
}
}
AFTER_FIRST_WORD;
/*
* Append a space character (" ") if there is more text to follow
* (either another element from objv, or the message string).
@@ -1058,8 +1031,6 @@ Tcl_WrongNumArgs(
Tcl_AppendStringsToObj(objPtr, "\"", NULL);
Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
Tcl_SetObjResult(interp, objPtr);
#undef MAY_QUOTE_WORD
#undef AFTER_FIRST_WORD
}
/*
+178 -138
View File
@@ -50,10 +50,11 @@ declare 6 {
declare 7 {
int TclCopyAndCollapse(int count, const char *src, char *dst)
}
declare 8 {deprecated {}} {
int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan,
Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
}
# Removed in 9.0:
#declare 8 {
# int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan,
# Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
#}
# TclCreatePipeline unofficially exported for use by BLT.
@@ -183,7 +184,7 @@ declare 41 {
Tcl_Command TclGetOriginalCommand(Tcl_Command command)
}
declare 42 {
CONST86 char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr)
const char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr)
}
# Removed in 8.5a2:
#declare 43 {
@@ -313,9 +314,11 @@ declare 75 {
declare 76 {
unsigned long TclpGetSeconds(void)
}
declare 77 {deprecated {}} {
void TclpGetTime(Tcl_Time *time)
}
# Removed in 9.0:
#declare 77 {
# void TclpGetTime(Tcl_Time *time)
#}
# Removed in 8.6:
#declare 78 {
# int TclpGetTimeZone(unsigned long time)
@@ -355,10 +358,11 @@ declare 81 {
# declare 87 {
# void TclPlatformInit(Tcl_Interp *interp)
# }
declare 88 {deprecated {}} {
char *TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp,
const char *name1, const char *name2, int flags)
}
# Removed in 9.0:
#declare 88 {
# char *TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp,
# const char *name1, const char *name2, int flags)
#}
declare 89 {
int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp,
Tcl_Command cmd)
@@ -408,7 +412,7 @@ declare 98 {
# Tcl_Obj *objPtr, int flags)
#}
declare 101 {
CONST86 char *TclSetPreInitScript(const char *string)
const char *TclSetPreInitScript(const char *string)
}
declare 102 {
void TclSetupEnv(Tcl_Interp *interp)
@@ -417,9 +421,10 @@ declare 103 {
int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto,
int *portPtr)
}
declare 104 {deprecated {}} {
int TclSockMinimumBuffersOld(int sock, int size)
}
# Removed in 9.0:
#declare 104 {
# int TclSockMinimumBuffersOld(int sock, int size)
#}
# Replaced by Tcl_FSStat in 8.4:
#declare 105 {
# int TclStat(const char *path, Tcl_StatBuf *buf)
@@ -452,29 +457,35 @@ declare 111 {
Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc,
Tcl_ResolveCompiledVarProc *compiledVarProc)
}
declare 112 {
int TclAppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
Tcl_Obj *objPtr)
}
declare 113 {
Tcl_Namespace *TclCreateNamespace(Tcl_Interp *interp, const char *name,
ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
}
declare 114 {
void TclDeleteNamespace(Tcl_Namespace *nsPtr)
}
declare 115 {
int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
const char *pattern, int resetListFirst)
}
declare 116 {
Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name,
Tcl_Namespace *contextNsPtr, int flags)
}
declare 117 {
Tcl_Namespace *TclFindNamespace(Tcl_Interp *interp, const char *name,
Tcl_Namespace *contextNsPtr, int flags)
}
# Removed in 9.0:
#declare 112 {
# int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
# Tcl_Obj *objPtr)
#}
# Removed in 9.0:
#declare 113 {
# Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
# ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
#}
# Removed in 9.0:
#declare 114 {
# void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
#}
# Removed in 9.0:
#declare 115 {
# int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
# const char *pattern, int resetListFirst)
#}
# Removed in 9.0:
#declare 116 {
# Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
# Tcl_Namespace *contextNsPtr, int flags)
#}
# Removed in 9.0:
#declare 117 {
# Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name,
# Tcl_Namespace *contextNsPtr, int flags)
#}
declare 118 {
int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name,
Tcl_ResolverInfo *resInfo)
@@ -487,31 +498,37 @@ declare 120 {
Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name,
Tcl_Namespace *contextNsPtr, int flags)
}
declare 121 {
int TclForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
const char *pattern)
}
declare 122 {
Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 123 {
void TclGetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
Tcl_Obj *objPtr)
}
declare 124 {
Tcl_Namespace *TclGetCurrentNamespace_(Tcl_Interp *interp)
}
declare 125 {
Tcl_Namespace *TclGetGlobalNamespace_(Tcl_Interp *interp)
}
# Removed in 9.0:
#declare 121 {
# int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
# const char *pattern)
#}
# Removed in 9.0:
#declare 122 {
# Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#}
# Removed in 9.0:
#declare 123 {
# void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
# Tcl_Obj *objPtr)
#}
# Removed in 9.0:
#declare 124 {
# Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp)
#}
# Removed in 9.0:
#declare 125 {
# Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp)
#}
declare 126 {
void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable,
Tcl_Obj *objPtr)
}
declare 127 {
int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
const char *pattern, int allowOverwrite)
}
# Removed in 9.0:
#declare 127 {
# int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
# const char *pattern, int allowOverwrite)
#}
declare 128 {
void Tcl_PopCallFrame(Tcl_Interp *interp)
}
@@ -530,9 +547,10 @@ declare 131 {
declare 132 {
int TclpHasSockets(Tcl_Interp *interp)
}
declare 133 {deprecated {}} {
struct tm *TclpGetDate(const time_t *time, int useGMT)
}
# Removed in 9.0
#declare 133 {
# struct tm *TclpGetDate(const time_t *time, int useGMT)
#}
# Removed in 8.5
#declare 134 {
# size_t TclpStrftime(char *s, size_t maxsize, const char *format,
@@ -623,12 +641,14 @@ declare 156 {
declare 157 {
Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName)
}
declare 158 {deprecated {use public Tcl_SetStartupScript()}} {
void TclSetStartupScriptFileName(const char *filename)
}
declare 159 {deprecated {use public Tcl_GetStartupScript()}} {
const char *TclGetStartupScriptFileName(void)
}
# REMOVED - use public Tcl_SetStartupScript()
#declare 158 {
# void TclSetStartupScriptFileName(const char *filename)
#}
# REMOVED - use public Tcl_GetStartupScript()
#declare 159 {
# const char *TclGetStartupScriptFileName(void)
#}
#declare 160 {
# int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators,
# Tcl_DString *dirPtr, char *pattern, char *tail,
@@ -672,12 +692,15 @@ declare 166 {
int index, Tcl_Obj *valuePtr)
}
declare 167 {deprecated {use public Tcl_SetStartupScript()}} {
void TclSetStartupScriptPath(Tcl_Obj *pathPtr)
}
declare 168 {deprecated {use public Tcl_GetStartupScript()}} {
Tcl_Obj *TclGetStartupScriptPath(void)
}
# VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above)
# REMOVED - use public Tcl_SetStartupScript()
#declare 167 {
# void TclSetStartupScriptPath(Tcl_Obj *pathPtr)
#}
# REMOVED - use public Tcl_GetStartupScript()
#declare 168 {
# Tcl_Obj *TclGetStartupScriptPath(void)
#}
# variant of Tcl_UtfNCmp that takes n as bytes, not chars
declare 169 {
int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n)
@@ -723,12 +746,13 @@ declare 177 {
void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2,
const char *operation, const char *reason)
}
declare 178 {
void TclSetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
}
declare 179 {
Tcl_Obj *TclGetStartupScript(const char **encodingNamePtr)
}
# TIP 338 made these public - now declared in tcl.h
#declare 178 {
# void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
#}
#declare 179 {
# Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr)
#}
# REMOVED
# Allocate lists without copying arrays
@@ -740,12 +764,14 @@ declare 179 {
# const char *file, int line)
#}
declare 182 {deprecated {}} {
struct tm *TclpLocaltime(const time_t *clock)
}
declare 183 {deprecated {}} {
struct tm *TclpGmtime(const time_t *clock)
}
# Removed in 9.0
#declare 182 {
# struct tm *TclpLocaltime(const time_t *clock)
#}
# Removed in 9.0
#declare 183 {
# struct tm *TclpGmtime(const time_t *clock)
#}
# For the new "Thread Storage" subsystem.
@@ -927,9 +953,12 @@ declare 234 {
declare 235 {
void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr)
}
declare 236 {deprecated {use Tcl_BackgroundException}} {
void TclBackgroundException(Tcl_Interp *interp, int code)
}
# TIP 337 made this one public
#declare 236 {
# void TclBackgroundException(Tcl_Interp *interp, int code)
#}
# TIP #285: Script cancellation support.
declare 237 {
@@ -1038,17 +1067,20 @@ interface tclIntPlat
declare 0 win {
void TclWinConvertError(DWORD errCode)
}
declare 1 win {
void TclWinConvertWSAError(DWORD errCode)
}
declare 2 win {
struct servent *TclWinGetServByName(const char *nm,
const char *proto)
}
declare 3 win {
int TclWinGetSockOpt(SOCKET s, int level, int optname,
char *optval, int *optlen)
}
# Removed in 9.0:
#declare 1 win {
# void TclWinConvertWSAError(DWORD errCode)
#}
# Removed in 9.0:
#declare 2 win {
# struct servent *TclWinGetServByName(const char *nm,
# const char *proto)
#}
# Removed in 9.0:
#declare 3 win {
# int TclWinGetSockOpt(SOCKET s, int level, int optname,
# char *optval, int *optlen)
#}
declare 4 win {
HINSTANCE TclWinGetTclInstance(void)
}
@@ -1060,23 +1092,26 @@ declare 5 win {
# declare 5 win {
# HINSTANCE TclWinLoadLibrary(char *name)
# }
declare 6 win {
unsigned short TclWinNToHS(unsigned short ns)
}
declare 7 win {
int TclWinSetSockOpt(SOCKET s, int level, int optname,
const char *optval, int optlen)
}
# Removed in 9.0:
#declare 6 win {
# unsigned short TclWinNToHS(unsigned short ns)
#}
# Removed in 9.0:
#declare 7 win {
# int TclWinSetSockOpt(SOCKET s, int level, int optname,
# const char *optval, int optlen)
#}
declare 8 win {
int TclpGetPid(Tcl_Pid pid)
}
declare 9 win {
int TclWinGetPlatformId(void)
}
# new for 8.4.20+/8.5.12+ Cygwin only
declare 10 win {
Tcl_DirEntry *TclpReaddir(TclDIR *dir)
}
# Removed in 9.0:
#declare 9 win {
# int TclWinGetPlatformId(void)
#}
# Removed in 9.0:
#declare 10 win {
# Tcl_DirEntry *TclpReaddir(DIR *dir)
#}
# Removed in 8.3.1 (for Win32s only):
#declare 10 win {
# int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr)
@@ -1127,9 +1162,10 @@ declare 19 win {
declare 20 win {
void TclWinAddProcess(HANDLE hProcess, DWORD id)
}
declare 21 win {
char *TclpInetNtoa(struct in_addr addr)
}
# Removed in 9.0:
#declare 21 win {
# char *TclpInetNtoa(struct in_addr addr)
#}
# removed permanently for 8.4
#declare 21 win {
# void TclpAsyncMark(Tcl_AsyncHandler async)
@@ -1150,9 +1186,10 @@ declare 24 win {
#declare 25 win {
# TclPlatformType *TclWinGetPlatform(void)
#}
declare 26 win {
void TclWinSetInterfaces(int wide)
}
# Removed in 9.0:
#declare 26 win {
# void TclWinSetInterfaces(int wide)
#}
# Added in Tcl 8.3.3 / 8.4
@@ -1162,9 +1199,10 @@ declare 27 win {
# Added in 8.4.2
declare 28 win {
void TclWinResetInterfaces(void)
}
# Removed in 9.0:
#declare 28 win {
# void TclWinResetInterfaces(void)
#}
################################
# Unix specific functions
@@ -1211,20 +1249,22 @@ declare 9 unix {
# Added in 8.4:
declare 10 unix {
Tcl_DirEntry *TclpReaddir(TclDIR *dir)
}
# Slots 11 and 12 are forwarders for functions that were promoted to
# generic Stubs
declare 11 unix {
struct tm *TclpLocaltime_unix(const time_t *clock)
}
declare 12 unix {
struct tm *TclpGmtime_unix(const time_t *clock)
}
declare 13 unix {
char *TclpInetNtoa(struct in_addr addr)
}
# Removed in 9.0:
#declare 10 unix {
# Tcl_DirEntry *TclpReaddir(DIR *dir)
#}
# Removed in 9.0:
#declare 11 unix {
# struct tm *TclpLocaltime_unix(const time_t *clock)
#}
# Removed in 9.0:
#declare 12 unix {
# struct tm *TclpGmtime_unix(const time_t *clock)
#}
# Removed in 9.0:
#declare 13 unix {
# char *TclpInetNtoa(struct in_addr addr)
#}
# Added in 8.5:
+73 -164
View File
@@ -25,19 +25,6 @@
#undef ACCEPT_NAN
/*
* In Tcl 8.7, stop supporting special hacks for legacy Itcl 3.
* Itcl 4 doesn't need them. Itcl 3 can be updated to not need them
* using the Tcl(Init|Reset)RewriteEnsemble() routines in all Tcl 8.6+
* releases. Perhaps Tcl 8.7 will add even better public interfaces
* supporting all the re-invocation mechanisms extensions like Itcl 3
* need. As an absolute last resort, folks who must make Itcl 3 work
* unchanged with Tcl 8.7 can remove this line to regain the migration
* support. Tcl 9 will no longer offer even that option.
*/
#define AVOID_HACKS_FOR_ITCL 1
/*
* Common include files needed by most of the Tcl source files are included
* here, so that system-dependent personalizations for the include files only
@@ -51,6 +38,7 @@
#include <stdio.h>
#include <ctype.h>
#include <stdarg.h>
#ifdef NO_STDLIB_H
# include "../compat/stdlib.h"
#else
@@ -136,26 +124,6 @@ typedef int ptrdiff_t;
# define vsnprintf _vsnprintf
#endif
#if !defined(TCL_THREADS)
# define TCL_THREADS 1
#endif
#if !TCL_THREADS
# undef TCL_DECLARE_MUTEX
# define TCL_DECLARE_MUTEX(name)
# undef Tcl_MutexLock
# define Tcl_MutexLock(mutexPtr)
# undef Tcl_MutexUnlock
# define Tcl_MutexUnlock(mutexPtr)
# undef Tcl_MutexFinalize
# define Tcl_MutexFinalize(mutexPtr)
# undef Tcl_ConditionNotify
# define Tcl_ConditionNotify(condPtr)
# undef Tcl_ConditionWait
# define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
# undef Tcl_ConditionFinalize
# define Tcl_ConditionFinalize(condPtr)
#endif
/*
* The following procedures allow namespaces to be customized to support
* special name resolution rules for commands/variables.
@@ -210,9 +178,6 @@ typedef struct Tcl_ResolverInfo {
* - Bug #696893 - variable is either proc-local or in the current
* namespace; never follow the second (global) resolution path
* - Bug #631741 - do not use special namespace or interp resolvers
*
* It should also not collide with the (deprecated) TCL_PARSE_PART1 flag
* (Bug #835020)
*/
#define TCL_AVOID_RESOLVERS 0x40000
@@ -285,7 +250,7 @@ typedef struct Namespace {
* strings; values have type (Namespace *). If
* NULL, there are no children. */
#endif
unsigned long nsId; /* Unique id for the namespace. */
size_t nsId; /* Unique id for the namespace. */
Tcl_Interp *interp; /* The interpreter containing this
* namespace. */
int flags; /* OR-ed combination of the namespace status
@@ -294,7 +259,7 @@ typedef struct Namespace {
* frames for this namespace that are on the
* Tcl call stack. The namespace won't be
* freed until activationCount becomes zero. */
unsigned int refCount; /* Count of references by namespaceName
size_t refCount; /* Count of references by namespaceName
* objects. The namespace can't be freed until
* refCount becomes zero. */
Tcl_HashTable cmdTable; /* Contains all the commands currently
@@ -319,12 +284,12 @@ typedef struct Namespace {
* registered using "namespace export". */
int maxExportPatterns; /* Mumber of export patterns for which space
* is currently allocated. */
unsigned int cmdRefEpoch; /* Incremented if a newly added command
size_t cmdRefEpoch; /* Incremented if a newly added command
* shadows a command for which this namespace
* has already cached a Command* pointer; this
* causes all its cached Command* pointers to
* be invalidated. */
unsigned int resolverEpoch; /* Incremented whenever (a) the name
size_t resolverEpoch; /* Incremented whenever (a) the name
* resolution rules change for this namespace
* or (b) a newly added command shadows a
* command that is compiled to bytecodes. This
@@ -351,7 +316,7 @@ typedef struct Namespace {
* LookupCompiledLocal to resolve variable
* references within the namespace at compile
* time. */
unsigned int exportLookupEpoch; /* Incremented whenever a command is added to
size_t exportLookupEpoch; /* Incremented whenever a command is added to
* a namespace, removed from a namespace or
* the exports of a namespace are changed.
* Allows TIP#112-driven command lists to be
@@ -452,7 +417,7 @@ typedef struct EnsembleConfig {
* if the command has been deleted (or never
* existed; the global namespace never has an
* ensemble command.) */
unsigned int epoch; /* The epoch at which this ensemble's table of
size_t epoch; /* The epoch at which this ensemble's table of
* exported commands is valid. */
char **subcommandArrayPtr; /* Array of ensemble subcommand names. At all
* consistent points, this will have the same
@@ -565,7 +530,7 @@ typedef struct CommandTrace {
struct CommandTrace *nextPtr;
/* Next in list of traces associated with a
* particular command. */
size_t refCount; /* Used to ensure this structure is not
size_t refCount; /* Used to ensure this structure is not
* deleted too early. Keeps track of how many
* pieces of code have a pointer to this
* structure. */
@@ -638,7 +603,7 @@ typedef struct Var {
typedef struct VarInHash {
Var var;
unsigned int refCount; /* Counts number of active uses of this
size_t refCount; /* Counts number of active uses of this
* variable: 1 for the entry in the hash
* table, 1 for each additional variable whose
* linkPtr points here, 1 for each nested
@@ -970,7 +935,7 @@ typedef struct CompiledLocal {
typedef struct Proc {
struct Interp *iPtr; /* Interpreter for which this command is
* defined. */
unsigned int refCount; /* Reference count: 1 if still present in
size_t refCount; /* Reference count: 1 if still present in
* command table plus 1 for each call to the
* procedure that is currently active. This
* structure can be freed when refCount
@@ -1087,7 +1052,7 @@ typedef struct AssocData {
*/
typedef struct LocalCache {
unsigned int refCount;
size_t refCount;
int numVars;
Tcl_Obj *varName0;
} LocalCache;
@@ -1166,10 +1131,6 @@ typedef struct CallFrame {
* field contains an Object reference that has
* been confirmed to refer to a class. Part of
* TIP#257. */
#define FRAME_IS_PRIVATE_DEFINE 0x10
/* Marks this frame as being used for private
* declarations with [oo::define]. Usually
* OR'd with FRAME_IS_OO_DEFINE. TIP#500. */
/*
* TIP #280
@@ -1253,7 +1214,7 @@ typedef struct CmdFrame {
typedef struct CFWord {
CmdFrame *framePtr; /* CmdFrame to access. */
int word; /* Index of the word in the command. */
unsigned int refCount; /* Number of times the word is on the
size_t refCount; /* Number of times the word is on the
* stack. */
} CFWord;
@@ -1658,12 +1619,12 @@ typedef struct Command {
* recreated). */
Namespace *nsPtr; /* Points to the namespace containing this
* command. */
unsigned int refCount; /* 1 if in command hashtable plus 1 for each
size_t refCount; /* 1 if in command hashtable plus 1 for each
* reference from a CmdName Tcl object
* representing a command's name in a ByteCode
* instruction sequence. This structure can be
* freed when refCount becomes zero. */
unsigned int cmdEpoch; /* Incremented to invalidate any references
size_t cmdEpoch; /* Incremented to invalidate any references
* that point to this command when it is
* renamed, deleted, hidden, or exposed. */
CompileProc *compileProc; /* Procedure called to compile command. NULL
@@ -1797,41 +1758,31 @@ typedef struct AllocCache {
typedef struct Interp {
/*
* Note: the first three fields must match exactly the fields in a
* Tcl_Interp struct (see tcl.h). If you change one, be sure to change the
* other.
*
* The interpreter's result is held in both the string and the
* objResultPtr fields. These fields hold, respectively, the result's
* string or object value. The interpreter's result is always in the
* result field if that is non-empty, otherwise it is in objResultPtr.
* The two fields are kept consistent unless some C code sets
* interp->result directly. Programs should not access result and
* objResultPtr directly; instead, they should always get and set the
* result using procedures such as Tcl_SetObjResult, Tcl_GetObjResult, and
* Tcl_GetStringResult. See the SetResult man page for details.
* The first two fields were named "result" and "freeProc" in earlier
* versions of Tcl. They are no longer used within Tcl, and are no
* longer available to be accessed by extensions. However, they cannot
* be removed. Why? There is a deployed base of stub-enabled extensions
* that query the value of iPtr->stubTable. For them to continue to work,
* the location of the field "stubTable" within the Interp struct cannot
* change. The most robust way to assure that is to leave all fields up to
* that one undisturbed.
*/
char *result; /* If the last command returned a string
* result, this points to it. Should not be
* accessed directly; see comment above. */
Tcl_FreeProc *freeProc; /* Zero means a string result is statically
* allocated. TCL_DYNAMIC means string result
* was allocated with ckalloc and should be
* freed with ckfree. Other values give
* address of procedure to invoke to free the
* string result. Tcl_Eval must free it before
* executing next command. */
const char *legacyResult;
void (*legacyFreeProc) (void);
int errorLine; /* When TCL_ERROR is returned, this gives the
* line number in the command where the error
* occurred (1 means first line). */
const struct TclStubs *stubTable;
/* Pointer to the exported Tcl stub table. On
* previous versions of Tcl this is a pointer
* to the objResultPtr or a pointer to a
* buckets array in a hash table. We therefore
* have to do some careful checking before we
* can use this. */
/* Pointer to the exported Tcl stub table. In
* ancient pre-8.1 versions of Tcl this was a
* pointer to the objResultPtr or a pointer to a
* buckets array in a hash table. Deployed stubs
* enabled extensions check for a NULL pointer value
* and for a TCL_STUBS_MAGIC value to verify they
* are not [load]ing into one of those pre-stubs
* interps.
*/
TclHandle handle; /* Handle used to keep track of when this
* interp is deleted. */
@@ -1844,15 +1795,7 @@ typedef struct Interp {
ClientData interpInfo; /* Information used by tclInterp.c to keep
* track of master/slave interps on a
* per-interp basis. */
union {
void (*optimizer)(void *envPtr);
Tcl_HashTable unused2; /* No longer used (was mathFuncTable). The
* unused space in interp was repurposed for
* pluggable bytecode optimizers. The core
* contains one optimizer, which can be
* selectively overridden by extensions. */
} extra;
void (*optimizer)(void *envPtr);
/*
* Information related to procedures and variables. See tclProc.c and
* tclVar.c for usage.
@@ -1881,25 +1824,6 @@ typedef struct Interp {
Namespace *lookupNsPtr; /* Namespace to use ONLY on the next
* TCL_EVAL_INVOKE call to Tcl_EvalObjv. */
/*
* Information used by Tcl_AppendResult to keep track of partial results.
* See Tcl_AppendResult code for details.
*/
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
char *appendResult; /* Storage space for results generated by
* Tcl_AppendResult. Ckalloc-ed. NULL means
* not yet allocated. */
int appendAvl; /* Total amount of space available at
* partialResult. */
int appendUsed; /* Number of non-null bytes currently stored
* at partialResult. */
#else
char *appendResultDontUse;
int appendAvlDontUse;
int appendUsedDontUse;
#endif
/*
* Information about packages. Used only in tclPkg.c.
*/
@@ -1922,13 +1846,12 @@ typedef struct Interp {
* Normally zero, but may be set before
* calling Tcl_Eval. See below for valid
* values. */
int unused1; /* No longer used (was termOffset) */
LiteralTable literalTable; /* Contains LiteralEntry's describing all Tcl
* objects holding literals of scripts
* compiled by the interpreter. Indexed by the
* string representations of literals. Used to
* avoid creating duplicate objects. */
unsigned int compileEpoch; /* Holds the current "compilation epoch" for
size_t compileEpoch; /* Holds the current "compilation epoch" for
* this interpreter. This is incremented to
* invalidate existing ByteCodes when, e.g., a
* command with a compile procedure is
@@ -1960,14 +1883,6 @@ typedef struct Interp {
* string. Returned by Tcl_ObjSetVar2 when
* variable traces change a variable in a
* gross way. */
#if TCL_MAJOR_VERSION < 9
# if !defined(TCL_NO_DEPRECATED)
char resultSpace[TCL_DSTRING_STATIC_SIZE+1];
/* Static space holding small results. */
# else
char resultSpaceDontUse[TCL_DSTRING_STATIC_SIZE+1];
# endif
#endif
Tcl_Obj *objResultPtr; /* If the last command returned an object
* result, this points to it. Should not be
* accessed directly; see comment above. */
@@ -2410,7 +2325,7 @@ typedef enum TclEolTranslation {
*/
typedef struct List {
unsigned int refCount;
size_t refCount;
int maxElemCount; /* Total number of element array slots. */
int elemCount; /* Current number of list elements. */
int canonicalFlag; /* Set if the string representation was
@@ -2479,10 +2394,9 @@ typedef struct List {
*/
#define TclGetBooleanFromObj(interp, objPtr, boolPtr) \
(((objPtr)->typePtr == &tclIntType) \
(((objPtr)->typePtr == &tclIntType \
|| (objPtr)->typePtr == &tclBooleanType) \
? (*(boolPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \
: ((objPtr)->typePtr == &tclBooleanType) \
? (*(boolPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \
: Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr)))
#ifdef TCL_WIDE_INT_IS_LONG
@@ -2648,7 +2562,7 @@ typedef Tcl_ObjCmdProc *TclObjCmdProcType;
*----------------------------------------------------------------
*/
typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, unsigned int *lengthPtr,
typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, size_t *lengthPtr,
Tcl_Encoding *encodingPtr);
/*
@@ -2660,9 +2574,9 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, unsigned int *leng
*/
typedef struct ProcessGlobalValue {
unsigned int epoch; /* Epoch counter to detect changes in the
size_t epoch; /* Epoch counter to detect changes in the
* master value. */
unsigned int numBytes; /* Length of the master string. */
size_t numBytes; /* Length of the master string. */
char *value; /* The master string value. */
Tcl_Encoding encoding; /* system encoding when master string was
* initialized. */
@@ -2926,9 +2840,6 @@ MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan);
MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan);
MODULE_SCOPE int TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr,
Var *arrayPtr, Tcl_Obj *name, int index);
MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp,
const char *value);
MODULE_SCOPE int TclCheckEmptyString(Tcl_Obj *objPtr);
MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
Tcl_Channel chan);
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
@@ -2944,13 +2855,19 @@ MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr,
Tcl_Obj *originObjPtr);
MODULE_SCOPE int TclConvertElement(const char *src, int length,
char *dst, int flags);
MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs(Tcl_Interp *interp,
const char *cmdName, Tcl_Namespace *nsPtr,
Tcl_ObjCmdProc *proc, ClientData clientData,
MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs (
Tcl_Interp *interp,
const char *cmdName,
Tcl_Namespace *nsPtr,
Tcl_ObjCmdProc *proc,
ClientData clientData,
Tcl_CmdDeleteProc *deleteProc);
MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp,
const char *name, Tcl_Namespace *nameNamespacePtr,
Tcl_Namespace *ensembleNamespacePtr, int flags);
MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(
Tcl_Interp *interp,
const char *name,
Tcl_Namespace *nameNamespacePtr,
Tcl_Namespace *ensembleNamespacePtr,
int flags);
MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr);
MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp,
const char *dict, int dictLength,
@@ -2977,9 +2894,9 @@ MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr,
MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr,
Tcl_DString *toAppendPtr);
MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr);
MODULE_SCOPE Tcl_Obj *const *TclFetchEnsembleRoot(Tcl_Interp *interp,
MODULE_SCOPE Tcl_Obj *const * TclFetchEnsembleRoot(Tcl_Interp *interp,
Tcl_Obj *const *objv, int objc, int *objcPtr);
MODULE_SCOPE Tcl_Namespace *TclEnsureNamespace(Tcl_Interp *interp,
MODULE_SCOPE Tcl_Namespace * TclEnsureNamespace(Tcl_Interp *interp,
Tcl_Namespace *namespacePtr);
MODULE_SCOPE void TclFinalizeAllocSubsystem(void);
MODULE_SCOPE void TclFinalizeAsync(void);
@@ -3007,11 +2924,15 @@ MODULE_SCOPE double TclFloor(const mp_int *a);
MODULE_SCOPE void TclFormatNaN(double value, char *buffer);
MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr,
const char *attributeName, int *indexPtr);
MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs(Tcl_Interp *interp,
const char *cmdName, Tcl_Namespace *nsPtr,
Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc,
MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs (
Tcl_Interp *interp,
const char *cmdName,
Tcl_Namespace *nsPtr,
Tcl_ObjCmdProc *proc,
Tcl_ObjCmdProc *nreProc,
ClientData clientData,
Tcl_CmdDeleteProc *deleteProc);
MODULE_SCOPE int TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
const char *encodingName);
MODULE_SCOPE void TclFSUnloadTempFile(Tcl_LoadHandle loadHandle);
@@ -3140,7 +3061,7 @@ MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr,
int stackSize, int flags);
MODULE_SCOPE int TclpFindVariable(const char *name, int *lengthPtr);
MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr,
unsigned int *lengthPtr, Tcl_Encoding *encodingPtr);
size_t *lengthPtr, Tcl_Encoding *encodingPtr);
MODULE_SCOPE void TclpInitLock(void);
MODULE_SCOPE void TclpInitPlatform(void);
MODULE_SCOPE void TclpInitUnlock(void);
@@ -3192,8 +3113,7 @@ MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp,
Tcl_Obj *cmdPrefix);
MODULE_SCOPE void TclSetBignumIntRep(Tcl_Obj *objPtr,
mp_int *bignumValue);
MODULE_SCOPE int TclSetBooleanFromAny(Tcl_Interp *interp,
Tcl_Obj *objPtr);
MODULE_SCOPE int TclSetBooleanFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
MODULE_SCOPE void TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
Command *cmdPtr);
MODULE_SCOPE void TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
@@ -3205,12 +3125,6 @@ MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp,
Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr,
int numBytes);
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
MODULE_SCOPE int TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
int checkEq, int nocase, int reqlength);
MODULE_SCOPE int TclStringCmpOpts(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[], int *nocase,
int *reqlength);
MODULE_SCOPE int TclStringMatch(const char *str, int strLen,
const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj,
@@ -3259,8 +3173,8 @@ MODULE_SCOPE void * TclpThreadCreateKey(void);
MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr);
MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr);
MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr);
MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp,
const char *msg, int length);
MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length);
/*
*----------------------------------------------------------------
@@ -3282,11 +3196,6 @@ MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp);
MODULE_SCOPE int Tcl_BreakObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
MODULE_SCOPE int Tcl_CaseObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
#endif
MODULE_SCOPE int Tcl_CatchObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -4020,6 +3929,7 @@ MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCheckEmptyString(Tcl_Obj *objPtr);
/*
* Routines that provide the [string] ensemble functionality. Possible
@@ -4113,7 +4023,7 @@ typedef enum TclProcessWaitStatus {
TCL_PROCESS_EXITED = 1, /* Process has exited. */
TCL_PROCESS_SIGNALED = 2, /* Child killed because of a signal. */
TCL_PROCESS_STOPPED = 3, /* Child suspended because of a signal. */
TCL_PROCESS_UNKNOWN_STATUS = 4
TCL_PROCESS_UNKNOWN_STATUS = 4
/* Child wait status didn't make sense. */
} TclProcessWaitStatus;
@@ -4224,10 +4134,6 @@ typedef const char *TclDTraceStr;
} \
}
#if TCL_THREADS && !defined(USE_THREAD_ALLOC)
# define USE_THREAD_ALLOC 1
#endif
#if defined(PURIFY)
/*
@@ -4245,7 +4151,7 @@ typedef const char *TclDTraceStr;
#undef USE_THREAD_ALLOC
#undef USE_TCLALLOC
#elif TCL_THREADS && defined(USE_THREAD_ALLOC)
#elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
/*
* The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's from
@@ -4310,7 +4216,7 @@ MODULE_SCOPE void TclpFreeAllocCache(void *);
# define USE_TCLALLOC 0
#endif
#if TCL_THREADS
#ifdef TCL_THREADS
/* declared in tclObj.c */
MODULE_SCOPE Tcl_Mutex tclObjMutex;
#endif
@@ -4570,9 +4476,12 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
*/
MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr);
#define TclIsPureDict(objPtr) \
(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType))
#define TclIsPureList(objPtr) \
(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclListType))
/*
*----------------------------------------------------------------
+82 -202
View File
@@ -28,22 +28,6 @@
# endif
#endif
#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9)
/* Those macro's are especially for Itcl 3.4 compatibility */
# define tclCreateNamespace tcl_CreateNamespace
# define tclDeleteNamespace tcl_DeleteNamespace
# define tclAppendExportList tcl_AppendExportList
# define tclExport tcl_Export
# define tclImport tcl_Import
# define tclForgetImport tcl_ForgetImport
# define tclGetCurrentNamespace_ tcl_GetCurrentNamespace
# define tclGetGlobalNamespace_ tcl_GetGlobalNamespace
# define tclFindNamespace tcl_FindNamespace
# define tclFindCommand tcl_FindCommand
# define tclGetCommandFromObj tcl_GetCommandFromObj
# define tclGetCommandFullName tcl_GetCommandFullName
#endif /* !defined(TCL_NO_DEPRECATED) */
/*
* WARNING: This file is automatically generated by the tools/genStubs.tcl
* script. Any modifications to the function declarations below should be made
@@ -74,11 +58,7 @@ EXTERN void TclCleanupCommand(Command *cmdPtr);
/* 7 */
EXTERN int TclCopyAndCollapse(int count, const char *src,
char *dst);
/* 8 */
TCL_DEPRECATED("")
int TclCopyChannelOld(Tcl_Interp *interp,
Tcl_Channel inChan, Tcl_Channel outChan,
int toRead, Tcl_Obj *cmdPtr);
/* Slot 8 is reserved */
/* 9 */
EXTERN int TclCreatePipeline(Tcl_Interp *interp, int argc,
const char **argv, Tcl_Pid **pidArrayPtr,
@@ -152,7 +132,7 @@ EXTERN int TclGetOpenMode(Tcl_Interp *interp, const char *str,
/* 41 */
EXTERN Tcl_Command TclGetOriginalCommand(Tcl_Command command);
/* 42 */
EXTERN CONST86 char * TclpGetUserHome(const char *name,
EXTERN const char * TclpGetUserHome(const char *name,
Tcl_DString *bufferPtr);
/* Slot 43 is reserved */
/* 44 */
@@ -218,9 +198,7 @@ EXTERN void TclpFree(char *ptr);
EXTERN unsigned long TclpGetClicks(void);
/* 76 */
EXTERN unsigned long TclpGetSeconds(void);
/* 77 */
TCL_DEPRECATED("")
void TclpGetTime(Tcl_Time *time);
/* Slot 77 is reserved */
/* Slot 78 is reserved */
/* Slot 79 is reserved */
/* Slot 80 is reserved */
@@ -232,11 +210,7 @@ EXTERN char * TclpRealloc(char *ptr, unsigned int size);
/* Slot 85 is reserved */
/* Slot 86 is reserved */
/* Slot 87 is reserved */
/* 88 */
TCL_DEPRECATED("")
char * TclPrecTraceProc(ClientData clientData,
Tcl_Interp *interp, const char *name1,
const char *name2, int flags);
/* Slot 88 is reserved */
/* 89 */
EXTERN int TclPreventAliasLoop(Tcl_Interp *interp,
Tcl_Interp *cmdInterp, Tcl_Command cmd);
@@ -263,15 +237,13 @@ EXTERN int TclServiceIdle(void);
/* Slot 99 is reserved */
/* Slot 100 is reserved */
/* 101 */
EXTERN CONST86 char * TclSetPreInitScript(const char *string);
EXTERN const char * TclSetPreInitScript(const char *string);
/* 102 */
EXTERN void TclSetupEnv(Tcl_Interp *interp);
/* 103 */
EXTERN int TclSockGetPort(Tcl_Interp *interp, const char *str,
const char *proto, int *portPtr);
/* 104 */
TCL_DEPRECATED("")
int TclSockMinimumBuffersOld(int sock, int size);
/* Slot 104 is reserved */
/* Slot 105 is reserved */
/* Slot 106 is reserved */
/* Slot 107 is reserved */
@@ -287,25 +259,12 @@ EXTERN void Tcl_AddInterpResolvers(Tcl_Interp *interp,
Tcl_ResolveCmdProc *cmdProc,
Tcl_ResolveVarProc *varProc,
Tcl_ResolveCompiledVarProc *compiledVarProc);
/* 112 */
EXTERN int TclAppendExportList(Tcl_Interp *interp,
Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
/* 113 */
EXTERN Tcl_Namespace * TclCreateNamespace(Tcl_Interp *interp,
const char *name, ClientData clientData,
Tcl_NamespaceDeleteProc *deleteProc);
/* 114 */
EXTERN void TclDeleteNamespace(Tcl_Namespace *nsPtr);
/* 115 */
EXTERN int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
const char *pattern, int resetListFirst);
/* 116 */
EXTERN Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name,
Tcl_Namespace *contextNsPtr, int flags);
/* 117 */
EXTERN Tcl_Namespace * TclFindNamespace(Tcl_Interp *interp,
const char *name,
Tcl_Namespace *contextNsPtr, int flags);
/* Slot 112 is reserved */
/* Slot 113 is reserved */
/* Slot 114 is reserved */
/* Slot 115 is reserved */
/* Slot 116 is reserved */
/* Slot 117 is reserved */
/* 118 */
EXTERN int Tcl_GetInterpResolvers(Tcl_Interp *interp,
const char *name, Tcl_ResolverInfo *resInfo);
@@ -317,25 +276,15 @@ EXTERN int Tcl_GetNamespaceResolvers(
EXTERN Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp,
const char *name,
Tcl_Namespace *contextNsPtr, int flags);
/* 121 */
EXTERN int TclForgetImport(Tcl_Interp *interp,
Tcl_Namespace *nsPtr, const char *pattern);
/* 122 */
EXTERN Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr);
/* 123 */
EXTERN void TclGetCommandFullName(Tcl_Interp *interp,
Tcl_Command command, Tcl_Obj *objPtr);
/* 124 */
EXTERN Tcl_Namespace * TclGetCurrentNamespace_(Tcl_Interp *interp);
/* 125 */
EXTERN Tcl_Namespace * TclGetGlobalNamespace_(Tcl_Interp *interp);
/* Slot 121 is reserved */
/* Slot 122 is reserved */
/* Slot 123 is reserved */
/* Slot 124 is reserved */
/* Slot 125 is reserved */
/* 126 */
EXTERN void Tcl_GetVariableFullName(Tcl_Interp *interp,
Tcl_Var variable, Tcl_Obj *objPtr);
/* 127 */
EXTERN int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
const char *pattern, int allowOverwrite);
/* Slot 127 is reserved */
/* 128 */
EXTERN void Tcl_PopCallFrame(Tcl_Interp *interp);
/* 129 */
@@ -353,9 +302,7 @@ EXTERN void Tcl_SetNamespaceResolvers(
Tcl_ResolveCompiledVarProc *compiledVarProc);
/* 132 */
EXTERN int TclpHasSockets(Tcl_Interp *interp);
/* 133 */
TCL_DEPRECATED("")
struct tm * TclpGetDate(const time_t *time, int useGMT);
/* Slot 133 is reserved */
/* Slot 134 is reserved */
/* Slot 135 is reserved */
/* Slot 136 is reserved */
@@ -403,12 +350,8 @@ EXTERN void TclRegError(Tcl_Interp *interp, const char *msg,
/* 157 */
EXTERN Var * TclVarTraceExists(Tcl_Interp *interp,
const char *varName);
/* 158 */
TCL_DEPRECATED("use public Tcl_SetStartupScript()")
void TclSetStartupScriptFileName(const char *filename);
/* 159 */
TCL_DEPRECATED("use public Tcl_GetStartupScript()")
const char * TclGetStartupScriptFileName(void);
/* Slot 158 is reserved */
/* Slot 159 is reserved */
/* Slot 160 is reserved */
/* 161 */
EXTERN int TclChannelTransform(Tcl_Interp *interp,
@@ -426,12 +369,8 @@ EXTERN void TclpSetInitialEncodings(void);
EXTERN int TclListObjSetElement(Tcl_Interp *interp,
Tcl_Obj *listPtr, int index,
Tcl_Obj *valuePtr);
/* 167 */
TCL_DEPRECATED("use public Tcl_SetStartupScript()")
void TclSetStartupScriptPath(Tcl_Obj *pathPtr);
/* 168 */
TCL_DEPRECATED("use public Tcl_GetStartupScript()")
Tcl_Obj * TclGetStartupScriptPath(void);
/* Slot 167 is reserved */
/* Slot 168 is reserved */
/* 169 */
EXTERN int TclpUtfNcmp2(const char *s1, const char *s2,
unsigned long n);
@@ -463,19 +402,12 @@ EXTERN void TclCleanupVar(Var *varPtr, Var *arrayPtr);
EXTERN void TclVarErrMsg(Tcl_Interp *interp, const char *part1,
const char *part2, const char *operation,
const char *reason);
/* 178 */
EXTERN void TclSetStartupScript(Tcl_Obj *pathPtr,
const char *encodingName);
/* 179 */
EXTERN Tcl_Obj * TclGetStartupScript(const char **encodingNamePtr);
/* Slot 178 is reserved */
/* Slot 179 is reserved */
/* Slot 180 is reserved */
/* Slot 181 is reserved */
/* 182 */
TCL_DEPRECATED("")
struct tm * TclpLocaltime(const time_t *clock);
/* 183 */
TCL_DEPRECATED("")
struct tm * TclpGmtime(const time_t *clock);
/* Slot 182 is reserved */
/* Slot 183 is reserved */
/* Slot 184 is reserved */
/* Slot 185 is reserved */
/* Slot 186 is reserved */
@@ -578,9 +510,7 @@ EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr,
/* 235 */
EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr,
Namespace *nsPtr);
/* 236 */
TCL_DEPRECATED("use Tcl_BackgroundException")
void TclBackgroundException(Tcl_Interp *interp, int code);
/* Slot 236 is reserved */
/* 237 */
EXTERN int TclResetCancellation(Tcl_Interp *interp, int force);
/* 238 */
@@ -662,7 +592,7 @@ typedef struct TclIntStubs {
int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */
void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */
int (*tclCopyAndCollapse) (int count, const char *src, char *dst); /* 7 */
TCL_DEPRECATED_API("") int (*tclCopyChannelOld) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */
void (*reserved8)(void);
int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */
int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */
void (*tclDeleteCompiledLocalVars) (Interp *iPtr, CallFrame *framePtr); /* 11 */
@@ -696,7 +626,7 @@ typedef struct TclIntStubs {
TclObjCmdProcType (*tclGetObjInterpProc) (void); /* 39 */
int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */
Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */
CONST86 char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */
const char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */
void (*reserved43)(void);
int (*tclGuessPackageName) (const char *fileName, Tcl_DString *bufPtr); /* 44 */
int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */
@@ -731,7 +661,7 @@ typedef struct TclIntStubs {
void (*tclpFree) (char *ptr); /* 74 */
unsigned long (*tclpGetClicks) (void); /* 75 */
unsigned long (*tclpGetSeconds) (void); /* 76 */
TCL_DEPRECATED_API("") void (*tclpGetTime) (Tcl_Time *time); /* 77 */
void (*reserved77)(void);
void (*reserved78)(void);
void (*reserved79)(void);
void (*reserved80)(void);
@@ -742,7 +672,7 @@ typedef struct TclIntStubs {
void (*reserved85)(void);
void (*reserved86)(void);
void (*reserved87)(void);
TCL_DEPRECATED_API("") char * (*tclPrecTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 88 */
void (*reserved88)(void);
int (*tclPreventAliasLoop) (Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* 89 */
void (*reserved90)(void);
void (*tclProcCleanupProc) (Proc *procPtr); /* 91 */
@@ -755,10 +685,10 @@ typedef struct TclIntStubs {
int (*tclServiceIdle) (void); /* 98 */
void (*reserved99)(void);
void (*reserved100)(void);
CONST86 char * (*tclSetPreInitScript) (const char *string); /* 101 */
const char * (*tclSetPreInitScript) (const char *string); /* 101 */
void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */
int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */
TCL_DEPRECATED_API("") int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */
void (*reserved104)(void);
void (*reserved105)(void);
void (*reserved106)(void);
void (*reserved107)(void);
@@ -766,28 +696,28 @@ typedef struct TclIntStubs {
int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */
int (*tclSockMinimumBuffers) (void *sock, int size); /* 110 */
void (*tcl_AddInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 111 */
int (*tclAppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */
Tcl_Namespace * (*tclCreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */
void (*tclDeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */
int (*tclExport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */
Tcl_Command (*tclFindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */
Tcl_Namespace * (*tclFindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */
void (*reserved112)(void);
void (*reserved113)(void);
void (*reserved114)(void);
void (*reserved115)(void);
void (*reserved116)(void);
void (*reserved117)(void);
int (*tcl_GetInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); /* 118 */
int (*tcl_GetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo); /* 119 */
Tcl_Var (*tcl_FindNamespaceVar) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 120 */
int (*tclForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 121 */
Tcl_Command (*tclGetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */
void (*tclGetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */
Tcl_Namespace * (*tclGetCurrentNamespace_) (Tcl_Interp *interp); /* 124 */
Tcl_Namespace * (*tclGetGlobalNamespace_) (Tcl_Interp *interp); /* 125 */
void (*reserved121)(void);
void (*reserved122)(void);
void (*reserved123)(void);
void (*reserved124)(void);
void (*reserved125)(void);
void (*tcl_GetVariableFullName) (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 126 */
int (*tclImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 127 */
void (*reserved127)(void);
void (*tcl_PopCallFrame) (Tcl_Interp *interp); /* 128 */
int (*tcl_PushCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 129 */
int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */
void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */
int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */
TCL_DEPRECATED_API("") struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */
void (*reserved133)(void);
void (*reserved134)(void);
void (*reserved135)(void);
void (*reserved136)(void);
@@ -812,8 +742,8 @@ typedef struct TclIntStubs {
void (*reserved155)(void);
void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */
Var * (*tclVarTraceExists) (Tcl_Interp *interp, const char *varName); /* 157 */
TCL_DEPRECATED_API("use public Tcl_SetStartupScript()") void (*tclSetStartupScriptFileName) (const char *filename); /* 158 */
TCL_DEPRECATED_API("use public Tcl_GetStartupScript()") const char * (*tclGetStartupScriptFileName) (void); /* 159 */
void (*reserved158)(void);
void (*reserved159)(void);
void (*reserved160)(void);
int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */
void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */
@@ -821,8 +751,8 @@ typedef struct TclIntStubs {
void (*tclExpandCodeArray) (void *envPtr); /* 164 */
void (*tclpSetInitialEncodings) (void); /* 165 */
int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */
TCL_DEPRECATED_API("use public Tcl_SetStartupScript()") void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */
TCL_DEPRECATED_API("use public Tcl_GetStartupScript()") Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */
void (*reserved167)(void);
void (*reserved168)(void);
int (*tclpUtfNcmp2) (const char *s1, const char *s2, unsigned long n); /* 169 */
int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */
int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */
@@ -832,12 +762,12 @@ typedef struct TclIntStubs {
int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 175 */
void (*tclCleanupVar) (Var *varPtr, Var *arrayPtr); /* 176 */
void (*tclVarErrMsg) (Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 177 */
void (*tclSetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */
Tcl_Obj * (*tclGetStartupScript) (const char **encodingNamePtr); /* 179 */
void (*reserved178)(void);
void (*reserved179)(void);
void (*reserved180)(void);
void (*reserved181)(void);
TCL_DEPRECATED_API("") struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */
TCL_DEPRECATED_API("") struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */
void (*reserved182)(void);
void (*reserved183)(void);
void (*reserved184)(void);
void (*reserved185)(void);
void (*reserved186)(void);
@@ -890,7 +820,7 @@ typedef struct TclIntStubs {
void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */
void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
TCL_DEPRECATED_API("use Tcl_BackgroundException") void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */
void (*reserved236)(void);
int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */
int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */
int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */
@@ -937,8 +867,7 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclCleanupCommand) /* 6 */
#define TclCopyAndCollapse \
(tclIntStubsPtr->tclCopyAndCollapse) /* 7 */
#define TclCopyChannelOld \
(tclIntStubsPtr->tclCopyChannelOld) /* 8 */
/* Slot 8 is reserved */
#define TclCreatePipeline \
(tclIntStubsPtr->tclCreatePipeline) /* 9 */
#define TclCreateProc \
@@ -1045,8 +974,7 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclpGetClicks) /* 75 */
#define TclpGetSeconds \
(tclIntStubsPtr->tclpGetSeconds) /* 76 */
#define TclpGetTime \
(tclIntStubsPtr->tclpGetTime) /* 77 */
/* Slot 77 is reserved */
/* Slot 78 is reserved */
/* Slot 79 is reserved */
/* Slot 80 is reserved */
@@ -1058,8 +986,7 @@ extern const TclIntStubs *tclIntStubsPtr;
/* Slot 85 is reserved */
/* Slot 86 is reserved */
/* Slot 87 is reserved */
#define TclPrecTraceProc \
(tclIntStubsPtr->tclPrecTraceProc) /* 88 */
/* Slot 88 is reserved */
#define TclPreventAliasLoop \
(tclIntStubsPtr->tclPreventAliasLoop) /* 89 */
/* Slot 90 is reserved */
@@ -1085,8 +1012,7 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclSetupEnv) /* 102 */
#define TclSockGetPort \
(tclIntStubsPtr->tclSockGetPort) /* 103 */
#define TclSockMinimumBuffersOld \
(tclIntStubsPtr->tclSockMinimumBuffersOld) /* 104 */
/* Slot 104 is reserved */
/* Slot 105 is reserved */
/* Slot 106 is reserved */
/* Slot 107 is reserved */
@@ -1098,38 +1024,26 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */
#define Tcl_AddInterpResolvers \
(tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */
#define TclAppendExportList \
(tclIntStubsPtr->tclAppendExportList) /* 112 */
#define TclCreateNamespace \
(tclIntStubsPtr->tclCreateNamespace) /* 113 */
#define TclDeleteNamespace \
(tclIntStubsPtr->tclDeleteNamespace) /* 114 */
#define TclExport \
(tclIntStubsPtr->tclExport) /* 115 */
#define TclFindCommand \
(tclIntStubsPtr->tclFindCommand) /* 116 */
#define TclFindNamespace \
(tclIntStubsPtr->tclFindNamespace) /* 117 */
/* Slot 112 is reserved */
/* Slot 113 is reserved */
/* Slot 114 is reserved */
/* Slot 115 is reserved */
/* Slot 116 is reserved */
/* Slot 117 is reserved */
#define Tcl_GetInterpResolvers \
(tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */
#define Tcl_GetNamespaceResolvers \
(tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */
#define Tcl_FindNamespaceVar \
(tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */
#define TclForgetImport \
(tclIntStubsPtr->tclForgetImport) /* 121 */
#define TclGetCommandFromObj \
(tclIntStubsPtr->tclGetCommandFromObj) /* 122 */
#define TclGetCommandFullName \
(tclIntStubsPtr->tclGetCommandFullName) /* 123 */
#define TclGetCurrentNamespace_ \
(tclIntStubsPtr->tclGetCurrentNamespace_) /* 124 */
#define TclGetGlobalNamespace_ \
(tclIntStubsPtr->tclGetGlobalNamespace_) /* 125 */
/* Slot 121 is reserved */
/* Slot 122 is reserved */
/* Slot 123 is reserved */
/* Slot 124 is reserved */
/* Slot 125 is reserved */
#define Tcl_GetVariableFullName \
(tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */
#define TclImport \
(tclIntStubsPtr->tclImport) /* 127 */
/* Slot 127 is reserved */
#define Tcl_PopCallFrame \
(tclIntStubsPtr->tcl_PopCallFrame) /* 128 */
#define Tcl_PushCallFrame \
@@ -1140,8 +1054,7 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */
#define TclpHasSockets \
(tclIntStubsPtr->tclpHasSockets) /* 132 */
#define TclpGetDate \
(tclIntStubsPtr->tclpGetDate) /* 133 */
/* Slot 133 is reserved */
/* Slot 134 is reserved */
/* Slot 135 is reserved */
/* Slot 136 is reserved */
@@ -1182,10 +1095,8 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclRegError) /* 156 */
#define TclVarTraceExists \
(tclIntStubsPtr->tclVarTraceExists) /* 157 */
#define TclSetStartupScriptFileName \
(tclIntStubsPtr->tclSetStartupScriptFileName) /* 158 */
#define TclGetStartupScriptFileName \
(tclIntStubsPtr->tclGetStartupScriptFileName) /* 159 */
/* Slot 158 is reserved */
/* Slot 159 is reserved */
/* Slot 160 is reserved */
#define TclChannelTransform \
(tclIntStubsPtr->tclChannelTransform) /* 161 */
@@ -1199,10 +1110,8 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclpSetInitialEncodings) /* 165 */
#define TclListObjSetElement \
(tclIntStubsPtr->tclListObjSetElement) /* 166 */
#define TclSetStartupScriptPath \
(tclIntStubsPtr->tclSetStartupScriptPath) /* 167 */
#define TclGetStartupScriptPath \
(tclIntStubsPtr->tclGetStartupScriptPath) /* 168 */
/* Slot 167 is reserved */
/* Slot 168 is reserved */
#define TclpUtfNcmp2 \
(tclIntStubsPtr->tclpUtfNcmp2) /* 169 */
#define TclCheckInterpTraces \
@@ -1220,16 +1129,12 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclCleanupVar) /* 176 */
#define TclVarErrMsg \
(tclIntStubsPtr->tclVarErrMsg) /* 177 */
#define TclSetStartupScript \
(tclIntStubsPtr->tclSetStartupScript) /* 178 */
#define TclGetStartupScript \
(tclIntStubsPtr->tclGetStartupScript) /* 179 */
/* Slot 178 is reserved */
/* Slot 179 is reserved */
/* Slot 180 is reserved */
/* Slot 181 is reserved */
#define TclpLocaltime \
(tclIntStubsPtr->tclpLocaltime) /* 182 */
#define TclpGmtime \
(tclIntStubsPtr->tclpGmtime) /* 183 */
/* Slot 182 is reserved */
/* Slot 183 is reserved */
/* Slot 184 is reserved */
/* Slot 185 is reserved */
/* Slot 186 is reserved */
@@ -1310,8 +1215,7 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclVarHashCreateVar) /* 234 */
#define TclInitVarHashTable \
(tclIntStubsPtr->tclInitVarHashTable) /* 235 */
#define TclBackgroundException \
(tclIntStubsPtr->tclBackgroundException) /* 236 */
/* Slot 236 is reserved */
#define TclResetCancellation \
(tclIntStubsPtr->tclResetCancellation) /* 237 */
#define TclNRInterpProc \
@@ -1360,28 +1264,4 @@ extern const TclIntStubs *tclIntStubsPtr;
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
#if defined(USE_TCL_STUBS)
# undef TclGetStartupScriptFileName
# undef TclSetStartupScriptFileName
# undef TclGetStartupScriptPath
# undef TclSetStartupScriptPath
# undef TclBackgroundException
# undef TclSetStartupScript
# undef TclGetStartupScript
# undef TclCreateNamespace
# undef TclDeleteNamespace
# undef TclAppendExportList
# undef TclExport
# undef TclImport
# undef TclForgetImport
# undef TclGetCurrentNamespace_
# undef TclGetGlobalNamespace_
# undef TclFindNamespace
# undef TclFindCommand
# undef TclGetCommandFromObj
# undef TclGetCommandFullName
# undef TclCopyChannelOld
# undef TclSockMinimumBuffersOld
#endif
#endif /* _TCLINTDECLS */
+60 -116
View File
@@ -13,6 +13,11 @@
#ifndef _TCLINTPLATDECLS
#define _TCLINTPLATDECLS
#ifdef _WIN32
# define Tcl_DirEntry void
# define DIR void
#endif
#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
# define TCL_STORAGE_CLASS DLLEXPORT
@@ -66,14 +71,10 @@ EXTERN TclFile TclpOpenFile(const char *fname, int mode);
EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile TclpCreateTempFile(const char *contents);
/* 10 */
EXTERN Tcl_DirEntry * TclpReaddir(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);
/* Slot 10 is reserved */
/* Slot 11 is reserved */
/* Slot 12 is reserved */
/* Slot 13 is reserved */
/* 14 */
EXTERN int TclUnixCopyFile(const char *src, const char *dst,
const Tcl_StatBuf *statBufPtr,
@@ -102,29 +103,19 @@ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
EXTERN void TclWinConvertError(DWORD errCode);
/* 1 */
EXTERN void TclWinConvertWSAError(DWORD errCode);
/* 2 */
EXTERN struct servent * TclWinGetServByName(const char *nm,
const char *proto);
/* 3 */
EXTERN int TclWinGetSockOpt(SOCKET s, int level, int optname,
char *optval, int *optlen);
/* Slot 1 is reserved */
/* Slot 2 is reserved */
/* Slot 3 is reserved */
/* 4 */
EXTERN HINSTANCE TclWinGetTclInstance(void);
/* 5 */
EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
/* 6 */
EXTERN unsigned short TclWinNToHS(unsigned short ns);
/* 7 */
EXTERN int TclWinSetSockOpt(SOCKET s, int level, int optname,
const char *optval, int optlen);
/* Slot 6 is reserved */
/* Slot 7 is reserved */
/* 8 */
EXTERN int TclpGetPid(Tcl_Pid pid);
/* 9 */
EXTERN int TclWinGetPlatformId(void);
/* 10 */
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
/* Slot 9 is reserved */
/* Slot 10 is reserved */
/* 11 */
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
Tcl_Channel chan);
@@ -153,20 +144,17 @@ EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction);
EXTERN TclFile TclpOpenFile(const char *fname, int mode);
/* 20 */
EXTERN void TclWinAddProcess(HANDLE hProcess, DWORD id);
/* 21 */
EXTERN char * TclpInetNtoa(struct in_addr addr);
/* Slot 21 is reserved */
/* 22 */
EXTERN TclFile TclpCreateTempFile(const char *contents);
/* Slot 23 is reserved */
/* 24 */
EXTERN char * TclWinNoBackslash(char *path);
/* Slot 25 is reserved */
/* 26 */
EXTERN void TclWinSetInterfaces(int wide);
/* Slot 26 is reserved */
/* 27 */
EXTERN void TclWinFlushDirtyChannels(void);
/* 28 */
EXTERN void TclWinResetInterfaces(void);
/* Slot 28 is reserved */
/* 29 */
EXTERN int TclWinCPUID(int index, int *regs);
/* 30 */
@@ -200,14 +188,10 @@ EXTERN TclFile TclpOpenFile(const char *fname, int mode);
EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile TclpCreateTempFile(const char *contents);
/* 10 */
EXTERN Tcl_DirEntry * TclpReaddir(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);
/* Slot 10 is reserved */
/* Slot 11 is reserved */
/* Slot 12 is reserved */
/* Slot 13 is reserved */
/* 14 */
EXTERN int TclUnixCopyFile(const char *src, const char *dst,
const Tcl_StatBuf *statBufPtr,
@@ -264,10 +248,10 @@ typedef struct TclIntPlatStubs {
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
Tcl_DirEntry * (*tclpReaddir) (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 */
void (*reserved10)(void);
void (*reserved11)(void);
void (*reserved12)(void);
void (*reserved13)(void);
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
void (*reserved15)(void);
void (*reserved16)(void);
@@ -288,16 +272,16 @@ typedef struct TclIntPlatStubs {
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
void (*tclWinConvertError) (DWORD errCode); /* 0 */
void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */
struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */
int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */
void (*reserved1)(void);
void (*reserved2)(void);
void (*reserved3)(void);
HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */
int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */
void (*reserved6)(void);
void (*reserved7)(void);
int (*tclpGetPid) (Tcl_Pid pid); /* 8 */
int (*tclWinGetPlatformId) (void); /* 9 */
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
void (*reserved9)(void);
void (*reserved10)(void);
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
int (*tclpCloseFile) (TclFile file); /* 12 */
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
@@ -308,14 +292,14 @@ typedef struct TclIntPlatStubs {
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */
char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */
void (*reserved21)(void);
TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
void (*reserved23)(void);
char * (*tclWinNoBackslash) (char *path); /* 24 */
void (*reserved25)(void);
void (*tclWinSetInterfaces) (int wide); /* 26 */
void (*reserved26)(void);
void (*tclWinFlushDirtyChannels) (void); /* 27 */
void (*tclWinResetInterfaces) (void); /* 28 */
void (*reserved28)(void);
int (*tclWinCPUID) (int index, int *regs); /* 29 */
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* WIN */
@@ -330,10 +314,10 @@ typedef struct TclIntPlatStubs {
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
Tcl_DirEntry * (*tclpReaddir) (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 */
void (*reserved10)(void);
void (*reserved11)(void);
void (*reserved12)(void);
void (*reserved13)(void);
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
@@ -386,14 +370,10 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#define TclpCreateTempFile \
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
#define TclpReaddir \
(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
#define TclpLocaltime_unix \
(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
#define TclpGmtime_unix \
(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
#define TclpInetNtoa \
(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
/* Slot 10 is reserved */
/* Slot 11 is reserved */
/* Slot 12 is reserved */
/* Slot 13 is reserved */
#define TclUnixCopyFile \
(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
/* Slot 15 is reserved */
@@ -418,26 +398,19 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
#define TclWinConvertError \
(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
#define TclWinConvertWSAError \
(tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */
#define TclWinGetServByName \
(tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */
#define TclWinGetSockOpt \
(tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */
/* Slot 1 is reserved */
/* Slot 2 is reserved */
/* Slot 3 is reserved */
#define TclWinGetTclInstance \
(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
#define TclUnixWaitForFile \
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
#define TclWinNToHS \
(tclIntPlatStubsPtr->tclWinNToHS) /* 6 */
#define TclWinSetSockOpt \
(tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */
/* Slot 6 is reserved */
/* Slot 7 is reserved */
#define TclpGetPid \
(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
#define TclWinGetPlatformId \
(tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */
#define TclpReaddir \
(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
/* Slot 9 is reserved */
/* Slot 10 is reserved */
#define TclGetAndDetachPids \
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
#define TclpCloseFile \
@@ -458,20 +431,17 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
(tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
#define TclWinAddProcess \
(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
#define TclpInetNtoa \
(tclIntPlatStubsPtr->tclpInetNtoa) /* 21 */
/* Slot 21 is reserved */
#define TclpCreateTempFile \
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
/* Slot 23 is reserved */
#define TclWinNoBackslash \
(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
/* Slot 25 is reserved */
#define TclWinSetInterfaces \
(tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */
/* Slot 26 is reserved */
#define TclWinFlushDirtyChannels \
(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
#define TclWinResetInterfaces \
(tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */
/* Slot 28 is reserved */
#define TclWinCPUID \
(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
@@ -497,14 +467,10 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#define TclpCreateTempFile \
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
#define TclpReaddir \
(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
#define TclpLocaltime_unix \
(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
#define TclpGmtime_unix \
(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
#define TclpInetNtoa \
(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
/* Slot 10 is reserved */
/* Slot 11 is reserved */
/* Slot 12 is reserved */
/* Slot 13 is reserved */
#define TclUnixCopyFile \
(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
#define TclMacOSXGetFileAttribute \
@@ -538,31 +504,9 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
#undef TclpLocaltime_unix
#undef TclpGmtime_unix
#undef TclWinConvertWSAError
#define TclWinConvertWSAError TclWinConvertError
#undef TclpInetNtoa
#define TclpInetNtoa inet_ntoa
#if defined(_WIN32)
# undef TclWinNToHS
# undef TclWinGetServByName
# undef TclWinGetSockOpt
# undef TclWinSetSockOpt
# 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
#if !defined(_WIN32)
# undef TclpGetPid
# define TclpGetPid(pid) ((unsigned long) (pid))
#endif
+9 -9
View File
@@ -25,14 +25,14 @@ static const char *tclPreInitScript = NULL;
struct Target;
/*
* struct Alias:
* Alias:
*
* Stores information about an alias. Is stored in the slave interpreter and
* used by the source command to find the target command in the master when
* the source command is invoked.
*/
typedef struct Alias {
typedef struct {
Tcl_Obj *token; /* Token for the alias command in the slave
* interp. This used to be the command name in
* the slave when the alias was first
@@ -66,14 +66,14 @@ typedef struct Alias {
/*
*
* struct Slave:
* Slave:
*
* Used by the "interp" command to record and find information about slave
* interpreters. Maps from a command name in the master to information about a
* slave interpreter, e.g. what aliases are defined in it.
*/
typedef struct Slave {
typedef struct {
Tcl_Interp *masterInterp; /* Master interpreter for this slave. */
Tcl_HashEntry *slaveEntryPtr;
/* Hash entry in masters slave table for this
@@ -112,7 +112,7 @@ typedef struct Target {
} Target;
/*
* struct Master:
* Master:
*
* This record is used for two purposes: First, slaveTable (a hashtable) maps
* from names of commands to slave interpreters. This hashtable is used to
@@ -127,7 +127,7 @@ typedef struct Target {
* only load safe extensions.
*/
typedef struct Master {
typedef struct {
Tcl_HashTable slaveTable; /* Hash table for slave interpreters. Maps
* from command names to Slave records. */
Target *targetsPtr; /* The head of a doubly-linked list of all the
@@ -144,7 +144,7 @@ typedef struct Master {
* on a per-interp basis.
*/
typedef struct InterpInfo {
typedef struct {
Master master; /* Keeps track of all interps for which this
* interp is the Master. */
Slave slave; /* Information necessary for this interp to
@@ -158,7 +158,7 @@ typedef struct InterpInfo {
* likely to work properly on 64-bit architectures.
*/
typedef struct ScriptLimitCallback {
typedef struct {
Tcl_Interp *interp; /* The interpreter in which to execute the
* callback. */
Tcl_Obj *scriptObj; /* The script to execute to perform the
@@ -171,7 +171,7 @@ typedef struct ScriptLimitCallback {
* table. */
} ScriptLimitCallback;
typedef struct ScriptLimitCallbackKey {
typedef struct {
Tcl_Interp *interp; /* The interpreter that the limit callback was
* attached to. This is not the interpreter
* that the callback runs in! */
+1 -1
View File
@@ -21,7 +21,7 @@
* variable.
*/
typedef struct Link {
typedef struct {
Tcl_Interp *interp; /* Interpreter containing Tcl variable. */
Tcl_Obj *varName; /* Name of variable (must be global). This is
* needed during trace callbacks, since the
+275 -298
View File
@@ -55,20 +55,22 @@ const Tcl_ObjType tclListType = {
*
* NewListIntRep --
*
* Creates a list internal rep with space for objc elements. objc
* must be > 0. If objv!=NULL, initializes with the first objc values
* in that array. If objv==NULL, initalize list internal rep to have
* 0 elements, with space to add objc more. Flag value "p" indicates
* Creates a 'List' structure with space for 'objc' elements. 'objc' must
* be > 0. If 'objv' is not NULL, The list is initialized with first
* 'objc' values in that array. Otherwise the list is initialized to have
* 0 elements, with space to add 'objc' more. Flag value 'p' indicates
* how to behave on failure.
*
* Results:
* A new List struct with refCount 0 is returned. If some failure
* prevents this then if p=0, NULL is returned and otherwise the
* routine panics.
* Value
*
* Side effects:
* The ref counts of the elements in objv are incremented since the
* resulting list now refers to them.
* A new 'List' structure with refCount 0. If some failure
* prevents this NULL is returned if 'p' is 0 , and 'Tcl_Panic'
* is called if it is not.
*
* Effect
*
* The refCount of each value in 'objv' is incremented as it is added
* to the list.
*
*----------------------------------------------------------------------
*/
@@ -132,21 +134,9 @@ NewListIntRep(
/*
*----------------------------------------------------------------------
*
* AttemptNewList --
* AttemptNewList --
*
* Creates a list internal rep with space for objc elements. objc
* must be > 0. If objv!=NULL, initializes with the first objc values
* in that array. If objv==NULL, initalize list internal rep to have
* 0 elements, with space to add objc more.
*
* Results:
* A new List struct with refCount 0 is returned. If some failure
* prevents this then NULL is returned, and an error message is left
* in the interp result, unless interp is NULL.
*
* Side effects:
* The ref counts of the elements in objv are incremented since the
* resulting list now refers to them.
* Like NewListIntRep, but additionally sets an error message on failure.
*
*----------------------------------------------------------------------
*/
@@ -179,23 +169,20 @@ AttemptNewList(
*
* Tcl_NewListObj --
*
* This function is normally called when not debugging: i.e., when
* TCL_MEM_DEBUG is not defined. It creates a new list object from an
* (objc,objv) array: that is, each of the objc elements of the array
* referenced by objv is inserted as an element into a new Tcl object.
* Creates a new list object and adds values to it. When TCL_MEM_DEBUG is
* defined, 'Tcl_DbNewListObj' is called instead.
*
* When TCL_MEM_DEBUG is defined, this function just returns the result
* of calling the debugging version Tcl_DbNewListObj.
* Value
*
* Results:
* A new list object is returned that is initialized from the object
* pointers in objv. If objc is less than or equal to zero, an empty
* object is returned. The new object's string representation is left
* NULL. The resulting new list object has ref count 0.
* A new list 'Tcl_Obj' to which is appended values from 'objv', or if
* 'objc' is less than or equal to zero, a list 'Tcl_Obj' having no
* elements. The string representation of the new 'Tcl_Obj' is set to
* NULL. The refCount of the list is 0.
*
* Side effects:
* The ref counts of the elements in objv are incremented since the
* resulting list now refers to them.
* Effect
*
* The refCount of each elements in 'objv' is incremented as it is added
* to the list.
*
*----------------------------------------------------------------------
*/
@@ -246,28 +233,14 @@ Tcl_NewListObj(
/*
*----------------------------------------------------------------------
*
* Tcl_DbNewListObj --
* Tcl_DbNewListObj --
*
* This function is normally called when debugging: i.e., when
* TCL_MEM_DEBUG is defined. It creates new list objects. It is the same
* as the Tcl_NewListObj function above except that it calls
* Tcl_DbCkalloc directly with the file name and line number from its
* caller. This simplifies debugging since then the [memory active]
* command will report the correct file name and line number when
* reporting objects that haven't been freed.
* Like 'Tcl_NewListObj', but it calls Tcl_DbCkalloc directly with the
* file name and line number from its caller. This simplifies debugging
* since the [memory active] command will report the correct file
* name and line number when reporting objects that haven't been freed.
*
* When TCL_MEM_DEBUG is not defined, this function just returns the
* result of calling Tcl_NewListObj.
*
* Results:
* A new list object is returned that is initialized from the object
* pointers in objv. If objc is less than or equal to zero, an empty
* object is returned. The new object's string representation is left
* NULL. The new list object has ref count 0.
*
* Side effects:
* The ref counts of the elements in objv are incremented since the
* resulting list now refers to them.
* When TCL_MEM_DEBUG is not defined, 'Tcl_NewListObj' is called instead.
*
*----------------------------------------------------------------------
*/
@@ -328,19 +301,8 @@ Tcl_DbNewListObj(
*
* Tcl_SetListObj --
*
* Modify an object to be a list containing each of the objc elements of
* the object array referenced by objv.
*
* Results:
* None.
*
* Side effects:
* The object is made a list object and is initialized from the object
* pointers in objv. If objc is less than or equal to zero, an empty
* object is returned. The new object's string representation is left
* NULL. The ref counts of the elements in objv are incremented since the
* list now refers to them. The object's old string and internal
* representations are freed and its type is set NULL.
* Like 'Tcl_NewListObj', but operates on an existing 'Tcl_Obj'instead of
* creating a new one.
*
*----------------------------------------------------------------------
*/
@@ -384,18 +346,20 @@ Tcl_SetListObj(
*
* TclListObjCopy --
*
* Makes a "pure list" copy of a list value. This provides for the C
* level a counterpart of the [lrange $list 0 end] command, while using
* internals details to be as efficient as possible.
* Creates a new 'Tcl_Obj' which is a pure copy of a list value. This
* provides for the C level a counterpart of the [lrange $list 0 end]
* command, while using internals details to be as efficient as possible.
*
* Results:
* Normally returns a pointer to a new Tcl_Obj, that contains the same
* list value as *listPtr does. The returned Tcl_Obj has a refCount of
* zero. If *listPtr does not hold a list, NULL is returned, and if
* interp is non-NULL, an error message is recorded there.
* Value
*
* Side effects:
* None.
* The address of the new 'Tcl_Obj' which shares its internal
* representation with 'listPtr', and whose refCount is 0. If 'listPtr'
* is not actually a list, the value is NULL, and an error message is left
* in 'interp' if it is not NULL.
*
* Effect
*
* 'listPtr' is converted to a list if it isn't one already.
*
*----------------------------------------------------------------------
*/
@@ -506,27 +470,30 @@ TclListObjRange(
*
* Tcl_ListObjGetElements --
*
* This function returns an (objc,objv) array of the elements in a list
* object.
* Retreive the elements in a list 'Tcl_Obj'.
*
* Results:
* The return value is normally TCL_OK; in this case *objcPtr is set to
* the count of list elements and *objvPtr is set to a pointer to an
* array of (*objcPtr) pointers to each list element. If listPtr does not
* refer to a list object and the object can not be converted to one,
* TCL_ERROR is returned and an error message will be left in the
* interpreter's result if interp is not NULL.
* Value
*
* The objects referenced by the returned array should be treated as
* readonly and their ref counts are _not_ incremented; the caller must
* do that if it holds on to a reference. Furthermore, the pointer and
* length returned by this function may change as soon as any function is
* called on the list object; be careful about retaining the pointer in a
* local data structure.
* TCL_OK
*
* Side effects:
* The possible conversion of the object referenced by listPtr
* to a list object.
* A count of list elements is stored, 'objcPtr', And a pointer to the
* array of elements in the list is stored in 'objvPtr'.
*
* The elements accessible via 'objvPtr' should be treated as readonly
* and the refCount for each object is _not_ incremented; the caller
* must do that if it holds on to a reference. Furthermore, the
* pointer and length returned by this function may change as soon as
* any function is called on the list object. Be careful about
* retaining the pointer in a local data structure.
*
* TCL_ERROR
*
* 'listPtr' is not a valid list. An error message is left in the
* interpreter's result if 'interp' is not NULL.
*
* Effect
*
* 'listPtr' is converted to a list object if it isn't one already.
*
*----------------------------------------------------------------------
*/
@@ -567,20 +534,27 @@ Tcl_ListObjGetElements(
*
* Tcl_ListObjAppendList --
*
* This function appends the elements in the list value referenced by
* elemListPtr to the list value referenced by listPtr.
* Appends the elements of elemListPtr to those of listPtr.
*
* Results:
* The return value is normally TCL_OK. If listPtr or elemListPtr do not
* refer to list values, TCL_ERROR is returned and an error message is
* left in the interpreter's result if interp is not NULL.
* Value
*
* Side effects:
* The reference counts of the elements in elemListPtr are incremented
* since the list now refers to them. listPtr and elemListPtr are
* converted, if necessary, to list objects. Also, appending the new
* elements may cause listObj's array of element pointers to grow.
* listPtr's old string representation, if any, is invalidated.
* TCL_OK
*
* Success.
*
* TCL_ERROR
*
* 'listPtr' or 'elemListPtr' are not valid lists. An error
* message is left in the interpreter's result if 'interp' is not NULL.
*
* Effect
*
* The reference count of each element of 'elemListPtr' as it is added to
* 'listPtr'. 'listPtr' and 'elemListPtr' are converted to 'tclListType'
* if they are not already. Appending the new elements may cause the
* array of element pointers in 'listObj' to grow. If any objects are
* appended to 'listPtr'. Any preexisting string representation of
* 'listPtr' is invalidated.
*
*----------------------------------------------------------------------
*/
@@ -619,24 +593,27 @@ Tcl_ListObjAppendList(
*
* Tcl_ListObjAppendElement --
*
* This function is a special purpose version of Tcl_ListObjAppendList:
* it appends a single object referenced by objPtr to the list object
* referenced by listPtr. If listPtr is not already a list object, an
* attempt will be made to convert it to one.
* Like 'Tcl_ListObjAppendList', but Appends a single value to a list.
*
* Results:
* The return value is normally TCL_OK; in this case objPtr is added to
* the end of listPtr's list. If listPtr does not refer to a list object
* and the object can not be converted to one, TCL_ERROR is returned and
* an error message will be left in the interpreter's result if interp is
* not NULL.
* Value
*
* Side effects:
* The ref count of objPtr is incremented since the list now refers to
* it. listPtr will be converted, if necessary, to a list object. Also,
* appending the new element may cause listObj's array of element
* pointers to grow. listPtr's old string representation, if any, is
* invalidated.
* TCL_OK
*
* 'objPtr' is appended to the elements of 'listPtr'.
*
* TCL_ERROR
*
* listPtr does not refer to a list object and the object can not be
* converted to one. An error message will be left in the
* interpreter's result if interp is not NULL.
*
* Effect
*
* If 'listPtr' is not already of type 'tclListType', it is converted.
* The 'refCount' of 'objPtr' is incremented as it is added to 'listPtr'.
* Appending the new element may cause the the array of element pointers
* in 'listObj' to grow. Any preexisting string representation of
* 'listPtr' is invalidated.
*
*----------------------------------------------------------------------
*/
@@ -787,23 +764,27 @@ Tcl_ListObjAppendElement(
*
* Tcl_ListObjIndex --
*
* This function returns a pointer to the index'th object from the list
* referenced by listPtr. The first element has index 0. If index is
* negative or greater than or equal to the number of elements in the
* list, a NULL is returned. If listPtr is not a list object, an attempt
* will be made to convert it to a list.
* Retrieve a pointer to the element of 'listPtr' at 'index'. The index
* of the first element is 0.
*
* Results:
* The return value is normally TCL_OK; in this case objPtrPtr is set to
* the Tcl_Obj pointer for the index'th list element or NULL if index is
* out of range. This object should be treated as readonly and its ref
* count is _not_ incremented; the caller must do that if it holds on to
* the reference. If listPtr does not refer to a list and can't be
* converted to one, TCL_ERROR is returned and an error message is left
* in the interpreter's result if interp is not NULL.
* Value
*
* Side effects:
* listPtr will be converted, if necessary, to a list object.
* TCL_OK
*
* A pointer to the element at 'index' is stored in 'objPtrPtr'. If
* 'index' is out of range, NULL is stored in 'objPtrPtr'. This
* object should be treated as readonly and its 'refCount' is _not_
* incremented. The caller must do that if it holds on to the
* reference.
*
* TCL_ERROR
*
* 'listPtr' is not a valid list. An an error message is left in the
* interpreter's result if 'interp' is not NULL.
*
* Effect
*
* If 'listPtr' is not already of type 'tclListType', it is converted.
*
*----------------------------------------------------------------------
*/
@@ -845,19 +826,20 @@ Tcl_ListObjIndex(
*
* Tcl_ListObjLength --
*
* This function returns the number of elements in a list object. If the
* object is not already a list object, an attempt will be made to
* convert it to one.
* Retrieve the number of elements in a list.
*
* Results:
* The return value is normally TCL_OK; in this case *intPtr will be set
* to the integer count of list elements. If listPtr does not refer to a
* list object and the object can not be converted to one, TCL_ERROR is
* returned and an error message will be left in the interpreter's result
* if interp is not NULL.
* Value
*
* Side effects:
* The possible conversion of the argument object to a list object.
* TCL_OK
*
* A count of list elements is stored at the address provided by
* 'intPtr'. If 'listPtr' is not already of type 'tclListPtr', it is
* converted.
*
* TCL_ERROR
*
* 'listPtr' is not a valid list. An error message will be left in
* the interpreter's result if 'interp' is not NULL.
*
*----------------------------------------------------------------------
*/
@@ -893,35 +875,36 @@ Tcl_ListObjLength(
*
* Tcl_ListObjReplace --
*
* This function replaces zero or more elements of the list referenced by
* listPtr with the objects from an (objc,objv) array. The objc elements
* of the array referenced by objv replace the count elements in listPtr
* starting at first.
* Replace values in a list.
*
* If the argument first is zero or negative, it refers to the first
* element. If first is greater than or equal to the number of elements
* in the list, then no elements are deleted; the new elements are
* appended to the list. Count gives the number of elements to replace.
* If count is zero or negative then no elements are deleted; the new
* elements are simply inserted before first.
* If 'first' is zero or negative, it refers to the first element. If
* 'first' outside the range of elements in the list, no elements are
* deleted.
*
* The argument objv refers to an array of objc pointers to the new
* elements to be added to listPtr in place of those that were deleted.
* If objv is NULL, no new elements are added. If listPtr is not a list
* object, an attempt will be made to convert it to one.
* If 'count' is zero or negative no elements are deleted, and any new
* elements are inserted at the beginning of the list.
*
* Results:
* The return value is normally TCL_OK. If listPtr does not refer to a
* list object and can not be converted to one, TCL_ERROR is returned and
* an error message will be left in the interpreter's result if interp is
* not NULL.
* Value
*
* Side effects:
* The ref counts of the objc elements in objv are incremented since the
* resulting list now refers to them. Similarly, the ref counts for
* replaced objects are decremented. listPtr is converted, if necessary,
* to a list object. listPtr's old string representation, if any, is
* freed.
* TCL_OK
*
* The first 'objc' values of 'objv' replaced 'count' elements in 'listPtr'
* starting at 'first'. If 'objc' 0, no new elements are added.
*
* TCL_ERROR
*
* 'listPtr' is not a valid list. An error message is left in the
* interpreter's result if 'interp' is not NULL.
*
* Effect
*
* If 'listPtr' is not of type 'tclListType', it is converted if possible.
*
* The 'refCount' of each element appended to the list is incremented.
* Similarly, the 'refCount' for each replaced element is decremented.
*
* If 'listPtr' is modified, any previous string representation is
* invalidated.
*
*----------------------------------------------------------------------
*/
@@ -1082,11 +1065,7 @@ Tcl_ListObjReplace(
if (listRepPtr == NULL) {
for (i = 0; i < objc; i++) {
/* See bug 3598580 */
#if TCL_MAJOR_VERSION > 8
Tcl_DecrRefCount(objv[i]);
#else
objv[i]->refCount--;
#endif
}
return TCL_ERROR;
}
@@ -1179,22 +1158,19 @@ Tcl_ListObjReplace(
*
* TclLindexList --
*
* This procedure handles the 'lindex' command when objc==3.
* Implements the 'lindex' command when objc==3.
*
* Results:
* Returns a pointer to the object extracted, or NULL if an error
* occurred. The returned object already includes one reference count for
* the pointer returned.
* Implemented entirely as a wrapper around 'TclLindexFlat'. Reconfigures
* the argument format into required form while taking care to manage
* shimmering so as to tend to keep the most useful intreps
* and/or avoid the most expensive conversions.
*
* Side effects:
* None.
* Value
*
* Notes:
* This procedure is implemented entirely as a wrapper around
* TclLindexFlat. All it does is reconfigure the argument format into the
* form required by TclLindexFlat, while taking care to manage shimmering
* in such a way that we tend to keep the most useful intreps and/or
* avoid the most expensive conversions.
* A pointer to the specified element, with its 'refCount' incremented, or
* NULL if an error occurred.
*
* Notes
*
*----------------------------------------------------------------------
*/
@@ -1260,25 +1236,20 @@ TclLindexList(
/*
*----------------------------------------------------------------------
*
* TclLindexFlat --
* TclLindexFlat --
*
* This procedure is the core of the 'lindex' command, with all index
* arguments presented as a flat list.
* The core of the 'lindex' command, with all index
* arguments presented as a flat list.
*
* Results:
* Returns a pointer to the object extracted, or NULL if an error
* occurred. The returned object already includes one reference count for
* the pointer returned.
* Value
*
* Side effects:
* None.
* A pointer to the object extracted, with its 'refCount' incremented, or
* NULL if an error occurred. Thus, the calling code will usually do
* something like:
*
* Tcl_SetObjResult(interp, result);
* Tcl_DecrRefCount(result);
*
* Notes:
* The reference count of the returned object includes one reference
* corresponding to the pointer returned. Thus, the calling code will
* usually do something like:
* Tcl_SetObjResult(interp, result);
* Tcl_DecrRefCount(result);
*
*----------------------------------------------------------------------
*/
@@ -1354,23 +1325,16 @@ TclLindexFlat(
*
* TclLsetList --
*
* Core of the 'lset' command when objc == 4. Objv[2] may be either a
* The core of [lset] when objc == 4. Objv[2] may be either a
* scalar index or a list of indices.
*
* Results:
* Returns the new value of the list variable, or NULL if there was an
* error. The returned object includes one reference count for the
* pointer returned.
* Implemented entirely as a wrapper around 'TclLindexFlat', as described
* for 'TclLindexList'.
*
* Side effects:
* None.
* Value
*
* Notes:
* This procedure is implemented entirely as a wrapper around
* TclLsetFlat. All it does is reconfigure the argument format into the
* form required by TclLsetFlat, while taking care to manage shimmering
* in such a way that we tend to keep the most useful intreps and/or
* avoid the most expensive conversions.
* The new list, with the 'refCount' of 'valuPtr' incremented, or NULL if
* there was an error.
*
*----------------------------------------------------------------------
*/
@@ -1432,36 +1396,39 @@ TclLsetList(
*
* Core engine of the 'lset' command.
*
* Results:
* Returns the new value of the list variable, or NULL if an error
* occurred. The returned object includes one reference count for the
* pointer returned.
* Value
*
* Side effects:
* On entry, the reference count of the variable value does not reflect
* any references held on the stack. The first action of this function is
* to determine whether the object is shared, and to duplicate it if it
* is. The reference count of the duplicate is incremented. At this
* point, the reference count will be 1 for either case, so that the
* object will appear to be unshared.
* The resulting list
*
* If an error occurs, and the object has been duplicated, the reference
* count on the duplicate is decremented so that it is now 0: this
* dismisses any memory that was allocated by this function.
* The 'refCount' of 'valuePtr' is incremented. If 'listPtr' was not
* duplicated, its 'refCount' is incremented. The reference count of
* an unduplicated object is therefore 2 (one for the returned pointer
* and one for the variable that holds it). The reference count of a
* duplicate object is 1, reflecting that result is the only active
* reference. The caller is expected to store the result in the
* variable and decrement its reference count. (INST_STORE_* does
* exactly this.)
*
* If no error occurs, the reference count of the original object is
* incremented if the object has not been duplicated, and nothing is done
* to a reference count of the duplicate. Now the reference count of an
* unduplicated object is 2 (the returned pointer, plus the one stored in
* the variable). The reference count of a duplicate object is 1,
* reflecting that the returned pointer is the only active reference. The
* caller is expected to store the returned value back in the variable
* and decrement its reference count. (INST_STORE_* does exactly this.)
* NULL
*
* Surgery is performed on the unshared list value to produce the result.
* TclLsetFlat maintains a linked list of Tcl_Obj's whose string
* An error occurred. If 'listPtr' was duplicated, the reference
* count on the duplicate is decremented so that it is 0, causing any
* memory allocated by this function to be freed.
*
*
* Effect
*
* On entry, the reference count of 'listPtr' does not reflect any
* references held on the stack. The first action of this function is to
* determine whether 'listPtr' is shared and to create a duplicate
* unshared copy if it is. The reference count of the duplicate is
* incremented. At this point, the reference count is 1 in either case so
* that the object is considered unshared.
*
* The unshared list is altered directly to produce the result.
* 'TclLsetFlat' maintains a linked list of 'Tcl_Obj' values whose string
* representations must be spoilt by threading via 'ptr2' of the
* two-pointer internal representation. On entry to TclLsetFlat, the
* two-pointer internal representation. On entry to 'TclLsetFlat', the
* values of 'ptr2' are immaterial; on exit, the 'ptr2' field of any
* Tcl_Obj that has been modified is set to NULL.
*
@@ -1676,26 +1643,38 @@ TclLsetFlat(
*
* TclListObjSetElement --
*
* Set a single element of a list to a specified value
*
* Results:
* The return value is normally TCL_OK. If listPtr does not refer to a
* list object and cannot be converted to one, TCL_ERROR is returned and
* an error message will be left in the interpreter result if interp is
* not NULL. Similarly, if index designates an element outside the range
* [0..listLength-1], where listLength is the count of elements in the
* list object designated by listPtr, TCL_ERROR is returned and an error
* message is left in the interpreter result.
*
* Side effects:
* Tcl_Panic if listPtr designates a shared object. Otherwise, attempts
* to convert it to a list with a non-shared internal rep. Decrements the
* ref count of the object at the specified index within the list,
* replaces with the object designated by valuePtr, and increments the
* ref count of the replacement object.
* Set a single element of a list to a specified value.
*
* It is the caller's responsibility to invalidate the string
* representation of the object.
* representation of the 'listPtr'.
*
* Value
*
* TCL_OK
*
* Success.
*
* TCL_ERROR
*
* 'listPtr' does not refer to a list object and cannot be converted
* to one. An error message will be left in the interpreter result if
* interp is not NULL.
*
* TCL_ERROR
*
* An index designates an element outside the range [0..listLength-1],
* where 'listLength' is the count of elements in the list object
* designated by 'listPtr'. An error message is left in the
* interpreter result.
*
* Effect
*
* If 'listPtr' designates a shared object, 'Tcl_Panic' is called. If
* 'listPtr' is not already of type 'tclListType', it is converted and the
* internal representation is unshared. The 'refCount' of the element at
* 'index' is decremented and replaced in the list with the 'valuePtr',
* whose 'refCount' in turn is incremented.
*
*
*----------------------------------------------------------------------
*/
@@ -1813,16 +1792,14 @@ TclListObjSetElement(
*
* FreeListInternalRep --
*
* Deallocate the storage associated with a list object's internal
* representation.
* Deallocate the storage associated with the internal representation of a
* a list object.
*
* Results:
* None.
* Effect
*
* Side effects:
* Frees listPtr's List* internal representation and sets listPtr's
* internalRep.twoPtrValue.ptr1 to NULL. Decrements the ref counts of all
* element objects, which may free them.
* The storage for the internal 'List' pointer of 'listPtr' is freed, the
* 'internalRep.twoPtrValue.ptr1' of 'listPtr' is set to NULL, and the 'refCount'
* of each element of the list is decremented.
*
*----------------------------------------------------------------------
*/
@@ -1851,14 +1828,12 @@ FreeListInternalRep(
*
* DupListInternalRep --
*
* Initialize the internal representation of a list Tcl_Obj to share the
* Initialize the internal representation of a list 'Tcl_Obj' to share the
* internal representation of an existing list object.
*
* Results:
* None.
* Effect
*
* Side effects:
* The reference count of the List internal rep is incremented.
* The 'refCount' of the List internal rep is incremented.
*
*----------------------------------------------------------------------
*/
@@ -1878,16 +1853,20 @@ DupListInternalRep(
*
* SetListFromAny --
*
* Attempt to generate a list internal form for the Tcl object "objPtr".
* Convert any object to a list.
*
* Results:
* The return value is TCL_OK or TCL_ERROR. If an error occurs during
* conversion, an error message is left in the interpreter's result
* unless "interp" is NULL.
* Value
*
* TCL_OK
*
* Success. The internal representation of 'objPtr' is set, and the type
* of 'objPtr' is 'tclListType'.
*
* TCL_ERROR
*
* An error occured during conversion. An error message is left in the
* interpreter's result if 'interp' is not NULL.
*
* Side effects:
* If no error occurs, a list is stored as "objPtr"s internal
* representation.
*
*----------------------------------------------------------------------
*/
@@ -2012,18 +1991,16 @@ SetListFromAny(
*
* UpdateStringOfList --
*
* Update the string representation for a list object. Note: This
* function does not invalidate an existing old string rep so storage
* will be lost if this has not already been done.
* Update the string representation for a list object.
*
* Results:
* None.
* Any previously-exising string representation is not invalidated, so
* storage is lost if this has not been taken care of.
*
* 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 not be NULL and
* we assume it is not NULL.
* Effect
*
* The string representation of 'listPtr' is set to the resulting string.
* This string will be empty if the list has no elements. It is assumed
* that the list internal representation is not NULL.
*
*----------------------------------------------------------------------
*/
+4 -6
View File
@@ -470,19 +470,17 @@ Tcl_LoadObjCmd(
*/
if (code != TCL_OK) {
#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
Interp *iPtr = (Interp *) target;
if (iPtr->result && *(iPtr->result) && !iPtr->freeProc) {
if (iPtr->legacyResult && *(iPtr->legacyResult) && !iPtr->legacyFreeProc) {
/*
* A call to Tcl_InitStubs() determined the caller extension and
* this interp are incompatible in their stubs mechanisms, and
* recorded the error in the oldest legacy place we have to do so.
*/
Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->result, -1));
iPtr->result = &tclEmptyString;
iPtr->freeProc = NULL;
Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->legacyResult, -1));
iPtr->legacyResult = NULL;
iPtr->legacyFreeProc = (void (*) (void))-1;
}
#endif /* defined(TCL_NO_DEPRECATED) */
Tcl_TransferResult(target, code, interp);
goto done;
}
+2 -2
View File
@@ -32,7 +32,7 @@
*/
typedef struct {
unsigned long numNsCreated; /* Count of the number of namespaces created
size_t numNsCreated; /* Count of the number of namespaces created
* within the thread. This value is used as a
* unique id for each namespace. Cannot be
* per-interp because the nsId is used to
@@ -52,7 +52,7 @@ static Tcl_ThreadDataKey dataKey;
* with some information that is used to check the cached pointer's validity.
*/
typedef struct ResolvedNsName {
typedef struct {
Namespace *nsPtr; /* A cached pointer to the Namespace that the
* name resolved to. */
Namespace *refNsPtr; /* Points to the namespace context in which
+8 -67
View File
@@ -31,7 +31,6 @@ static const struct {
{"export", TclOODefineExportObjCmd, 0},
{"forward", TclOODefineForwardObjCmd, 0},
{"method", TclOODefineMethodObjCmd, 0},
{"private", TclOODefinePrivateObjCmd, 0},
{"renamemethod", TclOODefineRenameMethodObjCmd, 0},
{"self", TclOODefineSelfObjCmd, 0},
{"unexport", TclOODefineUnexportObjCmd, 0},
@@ -42,7 +41,6 @@ static const struct {
{"export", TclOODefineExportObjCmd, 1},
{"forward", TclOODefineForwardObjCmd, 1},
{"method", TclOODefineMethodObjCmd, 1},
{"private", TclOODefinePrivateObjCmd, 1},
{"renamemethod", TclOODefineRenameMethodObjCmd, 1},
{"self", TclOODefineObjSelfObjCmd, 0},
{"unexport", TclOODefineUnexportObjCmd, 1},
@@ -995,7 +993,6 @@ ReleaseClassContents(
Method *mPtr;
Foundation *fPtr = oPtr->fPtr;
Tcl_Obj *variableObj;
PrivateVariableMapping *privateVariable;
/*
* Sanity check!
@@ -1102,14 +1099,6 @@ ReleaseClassContents(
ckfree(clsPtr->variables.list);
}
FOREACH_STRUCT(privateVariable, clsPtr->privateVariables) {
TclDecrRefCount(privateVariable->variableObj);
TclDecrRefCount(privateVariable->fullNameObj);
}
if (i) {
ckfree(clsPtr->privateVariables.list);
}
if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) {
Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command);
}
@@ -1139,7 +1128,6 @@ ObjectNamespaceDeleted(
Class *mixinPtr;
Method *mPtr;
Tcl_Obj *filterObj, *variableObj;
PrivateVariableMapping *privateVariable;
Tcl_Interp *interp = oPtr->fPtr->interp;
int i;
@@ -1174,7 +1162,7 @@ ObjectNamespaceDeleted(
if (!Tcl_InterpDeleted(interp) && !(oPtr->flags & DESTRUCTOR_CALLED)) {
CallContext *contextPtr =
TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL, NULL, NULL);
TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
int result;
Tcl_InterpState state;
@@ -1260,14 +1248,6 @@ ObjectNamespaceDeleted(
ckfree(oPtr->variables.list);
}
FOREACH_STRUCT(privateVariable, oPtr->privateVariables) {
TclDecrRefCount(privateVariable->variableObj);
TclDecrRefCount(privateVariable->fullNameObj);
}
if (i) {
ckfree(oPtr->privateVariables.list);
}
if (oPtr->chainCache) {
TclOODeleteChainCache(oPtr->chainCache);
}
@@ -1651,7 +1631,7 @@ Tcl_NewObjectInstance(
if (objc >= 0) {
CallContext *contextPtr =
TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL, NULL, NULL);
TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);
if (contextPtr != NULL) {
int isRoot, result;
@@ -1724,7 +1704,7 @@ TclNRNewObjectInstance(
*objectPtr = (Tcl_Object) oPtr;
return TCL_OK;
}
contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL, NULL, NULL);
contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);
if (contextPtr == NULL) {
*objectPtr = (Tcl_Object) oPtr;
return TCL_OK;
@@ -1904,7 +1884,6 @@ Tcl_CopyObjectInstance(
Class *mixinPtr;
CallContext *contextPtr;
Tcl_Obj *keyPtr, *filterObj, *variableObj, *args[3];
PrivateVariableMapping *privateVariable;
int i, result;
/*
@@ -1974,7 +1953,7 @@ Tcl_CopyObjectInstance(
}
/*
* Copy the object's variable resolution lists to the new object.
* Copy the object's variable resolution list to the new object.
*/
DUPLICATE(o2Ptr->variables, oPtr->variables, Tcl_Obj *);
@@ -1982,13 +1961,6 @@ Tcl_CopyObjectInstance(
Tcl_IncrRefCount(variableObj);
}
DUPLICATE(o2Ptr->privateVariables, oPtr->privateVariables,
PrivateVariableMapping);
FOREACH_STRUCT(privateVariable, o2Ptr->privateVariables) {
Tcl_IncrRefCount(privateVariable->variableObj);
Tcl_IncrRefCount(privateVariable->fullNameObj);
}
/*
* Copy the object's flags to the new object, clearing those that must be
* kept object-local. The duplicate is never deleted at this point, nor is
@@ -2077,7 +2049,7 @@ Tcl_CopyObjectInstance(
}
/*
* Copy the source class's variable resolution lists.
* Copy the source class's variable resolution list.
*/
DUPLICATE(cls2Ptr->variables, clsPtr->variables, Tcl_Obj *);
@@ -2085,13 +2057,6 @@ Tcl_CopyObjectInstance(
Tcl_IncrRefCount(variableObj);
}
DUPLICATE(cls2Ptr->privateVariables, clsPtr->privateVariables,
PrivateVariableMapping);
FOREACH_STRUCT(privateVariable, cls2Ptr->privateVariables) {
Tcl_IncrRefCount(privateVariable->variableObj);
Tcl_IncrRefCount(privateVariable->fullNameObj);
}
/*
* Duplicate the source class's mixins (which cannot be circular
* references to the duplicate).
@@ -2164,8 +2129,7 @@ Tcl_CopyObjectInstance(
}
TclResetRewriteEnsemble(interp, 1);
contextPtr = TclOOGetCallContext(o2Ptr, oPtr->fPtr->clonedName, 0, NULL,
NULL, NULL);
contextPtr = TclOOGetCallContext(o2Ptr, oPtr->fPtr->clonedName, 0, NULL);
if (contextPtr) {
args[0] = TclOOObjectName(interp, o2Ptr);
args[1] = oPtr->fPtr->clonedName;
@@ -2562,9 +2526,6 @@ TclOOObjectCmdCore(
{
CallContext *contextPtr;
Tcl_Obj *methodNamePtr;
CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
Object *callerObjPtr = NULL;
Class *callerClsPtr = NULL;
int result;
/*
@@ -2578,24 +2539,6 @@ TclOOObjectCmdCore(
goto noMapping;
}
/*
* Determine if we're in a context that can see the extra, private methods
* in this class.
*/
if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
CallContext *callerContextPtr = framePtr->clientData;
Method *callerMethodPtr =
callerContextPtr->callPtr->chain[callerContextPtr->index].mPtr;
if (callerMethodPtr->declaringObjectPtr) {
callerObjPtr = callerMethodPtr->declaringObjectPtr;
}
if (callerMethodPtr->declaringClassPtr) {
callerClsPtr = callerMethodPtr->declaringClassPtr;
}
}
/*
* Give plugged in code a chance to remap the method name.
*/
@@ -2623,8 +2566,7 @@ TclOOObjectCmdCore(
Tcl_IncrRefCount(mappedMethodName);
contextPtr = TclOOGetCallContext(oPtr, mappedMethodName,
flags | (oPtr->flags & FILTER_HANDLING), callerObjPtr,
callerClsPtr, methodNamePtr);
flags | (oPtr->flags & FILTER_HANDLING), methodNamePtr);
TclDecrRefCount(mappedMethodName);
if (contextPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -2641,8 +2583,7 @@ TclOOObjectCmdCore(
noMapping:
contextPtr = TclOOGetCallContext(oPtr, methodNamePtr,
flags | (oPtr->flags & FILTER_HANDLING), callerObjPtr,
callerClsPtr, NULL);
flags | (oPtr->flags & FILTER_HANDLING), NULL);
if (contextPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"impossible to invoke method \"%s\": no defined method or"
+2 -5
View File
@@ -58,12 +58,12 @@ declare 10 {
}
declare 11 {
Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object,
Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr,
Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr,
ClientData clientData)
}
declare 12 {
Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr,
Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr,
ClientData clientData)
}
declare 13 {
@@ -126,9 +126,6 @@ declare 27 {
declare 28 {
Tcl_Obj *Tcl_GetObjectName(Tcl_Interp *interp, Tcl_Object object)
}
declare 29 {
int Tcl_MethodIsPrivate(Tcl_Method method)
}
######################################################################
# Private API, exposed to support advanced OO systems that plug in on top of
+2 -11
View File
@@ -95,19 +95,10 @@ typedef struct {
/*
* The correct value for the version field of the Tcl_MethodType structure.
* This allows new versions of the structure to be introduced without breaking
* binary compatability.
* binary compatibility.
*/
#define TCL_OO_METHOD_VERSION_CURRENT 1
/*
* Visibility constants for the flags parameter to Tcl_NewMethod and
* Tcl_NewInstanceMethod.
*/
#define TCL_OO_METHOD_PUBLIC 1
#define TCL_OO_METHOD_UNEXPORTED 0
#define TCL_OO_METHOD_PRIVATE 0x20
/*
* The type of some object (or class) metadata. This describes how to delete
@@ -131,7 +122,7 @@ typedef struct {
/*
* The correct value for the version field of the Tcl_ObjectMetadataType
* structure. This allows new versions of the structure to be introduced
* without breaking binary compatability.
* without breaking binary compatibility.
*/
#define TCL_OO_METADATA_VERSION_CURRENT 1
+16 -84
View File
@@ -347,8 +347,7 @@ TclOO_Object_Destroy(
}
if (!(oPtr->flags & DESTRUCTOR_CALLED)) {
oPtr->flags |= DESTRUCTOR_CALLED;
contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL, NULL,
NULL);
contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
if (contextPtr != NULL) {
contextPtr->callPtr->flags |= DESTRUCTOR;
contextPtr->skip = 0;
@@ -500,12 +499,9 @@ TclOO_Object_Unknown(
Tcl_Obj *const *objv) /* The actual arguments. */
{
CallContext *contextPtr = (CallContext *) context;
Object *callerObj = NULL;
Class *callerCls = NULL;
Object *oPtr = contextPtr->oPtr;
const char **methodNames;
int numMethodNames, i, skip = Tcl_ObjectContextSkippedArgs(context);
CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
Tcl_Obj *errorMsg;
/*
@@ -519,32 +515,11 @@ TclOO_Object_Unknown(
return TCL_ERROR;
}
/*
* Determine if the calling context should know about extra private
* methods, and if so, which.
*/
if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
CallContext *callerContext = framePtr->clientData;
Method *mPtr = callerContext->callPtr->chain[
callerContext->index].mPtr;
if (mPtr->declaringObjectPtr) {
if (oPtr == mPtr->declaringObjectPtr) {
callerObj = mPtr->declaringObjectPtr;
}
} else {
if (TclOOIsReachable(mPtr->declaringClassPtr, oPtr->selfCls)) {
callerCls = mPtr->declaringClassPtr;
}
}
}
/*
* Get the list of methods that we want to know about.
*/
numMethodNames = TclOOGetSortedMethodList(oPtr, callerObj, callerCls,
numMethodNames = TclOOGetSortedMethodList(oPtr,
contextPtr->callPtr->flags & PUBLIC_METHOD, &methodNames);
/*
@@ -709,7 +684,6 @@ TclOO_Object_VarName(
{
Var *varPtr, *aryVar;
Tcl_Obj *varNamePtr, *argPtr;
CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
const char *arg;
if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
@@ -735,58 +709,6 @@ TclOO_Object_VarName(
Tcl_Namespace *namespacePtr =
Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context));
/*
* Private method handling. [TIP 500]
*
* If we're in a context that can see some private methods of an
* object, we may need to precede a variable name with its prefix.
* This is a little tricky as we need to check through the inheritance
* hierarchy when the method was declared by a class to see if the
* current object is an instance of that class.
*/
if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
CallContext *callerContext = framePtr->clientData;
Method *mPtr = callerContext->callPtr->chain[
callerContext->index].mPtr;
PrivateVariableMapping *pvPtr;
int i;
if (mPtr->declaringObjectPtr == oPtr) {
FOREACH_STRUCT(pvPtr, oPtr->privateVariables) {
if (!strcmp(Tcl_GetString(pvPtr->variableObj),
Tcl_GetString(argPtr))) {
argPtr = pvPtr->fullNameObj;
break;
}
}
} else if (mPtr->declaringClassPtr &&
mPtr->declaringClassPtr->privateVariables.num) {
Class *clsPtr = mPtr->declaringClassPtr;
int isInstance = TclOOIsReachable(clsPtr, oPtr->selfCls);
Class *mixinCls;
if (!isInstance) {
FOREACH(mixinCls, oPtr->mixins) {
if (TclOOIsReachable(clsPtr, mixinCls)) {
isInstance = 1;
break;
}
}
}
if (isInstance) {
FOREACH_STRUCT(pvPtr, clsPtr->privateVariables) {
if (!strcmp(Tcl_GetString(pvPtr->variableObj),
Tcl_GetString(argPtr))) {
argPtr = pvPtr->fullNameObj;
break;
}
}
}
}
}
varNamePtr = Tcl_NewStringObj(namespacePtr->fullName, -1);
Tcl_AppendToObj(varNamePtr, "::", 2);
Tcl_AppendObjToObj(varNamePtr, argPtr);
@@ -807,16 +729,26 @@ TclOO_Object_VarName(
varNamePtr = Tcl_NewObj();
if (aryVar != NULL) {
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
Tcl_GetVariableFullName(interp, (Tcl_Var) aryVar, varNamePtr);
/*
* WARNING! This code pokes inside the implementation of hash tables!
*/
Tcl_AppendToObj(varNamePtr, "(", -1);
Tcl_AppendObjToObj(varNamePtr, ((VarInHash *)
varPtr)->entry.key.objPtr);
Tcl_AppendToObj(varNamePtr, ")", -1);
hPtr = Tcl_FirstHashEntry((Tcl_HashTable *) aryVar->value.tablePtr,
&search);
while (hPtr != NULL) {
if (varPtr == Tcl_GetHashValue(hPtr)) {
Tcl_AppendToObj(varNamePtr, "(", -1);
Tcl_AppendObjToObj(varNamePtr, hPtr->key.objPtr);
Tcl_AppendToObj(varNamePtr, ")", -1);
break;
}
hPtr = Tcl_NextHashEntry(&search);
}
} else {
Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, varNamePtr);
}
+209 -467
View File
@@ -45,28 +45,6 @@ struct ChainBuilder {
(((flags) & OBJECT_MIXIN) || \
!((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN))
/*
* Note that the flag bit PRIVATE_METHOD has a confusing name; it's just for
* Itcl's special type of private.
*/
#define IS_PUBLIC(mPtr) \
(((mPtr)->flags & PUBLIC_METHOD) != 0)
#define IS_UNEXPORTED(mPtr) \
(((mPtr)->flags & SCOPE_FLAGS) == 0)
#define IS_ITCLPRIVATE(mPtr) \
(((mPtr)->flags & PRIVATE_METHOD) != 0)
#define IS_PRIVATE(mPtr) \
(((mPtr)->flags & TRUE_PRIVATE_METHOD) != 0)
#define WANT_PUBLIC(flags) \
(((flags) & PUBLIC_METHOD) != 0)
#define WANT_UNEXPORTED(flags) \
(((flags) & (PRIVATE_METHOD | TRUE_PRIVATE_METHOD)) == 0)
#define WANT_ITCLPRIVATE(flags) \
(((flags) & PRIVATE_METHOD) != 0)
#define WANT_PRIVATE(flags) \
(((flags) & TRUE_PRIVATE_METHOD) != 0)
/*
* Function declarations for things defined in this file.
*/
@@ -81,26 +59,12 @@ static inline void AddMethodToCallChain(Method *const mPtr,
struct ChainBuilder *const cbPtr,
Tcl_HashTable *const doneFilters,
Class *const filterDecl, int flags);
static inline int AddInstancePrivateToCallContext(Object *const oPtr,
Tcl_Obj *const methodNameObj,
struct ChainBuilder *const cbPtr, int flags);
static inline void AddStandardMethodName(int flags, Tcl_Obj *namePtr,
Method *mPtr, Tcl_HashTable *namesPtr);
static inline void AddPrivateMethodNames(Tcl_HashTable *methodsTablePtr,
Tcl_HashTable *namesPtr);
static inline int AddSimpleChainToCallContext(Object *const oPtr,
Class *const contextCls,
static inline void AddSimpleChainToCallContext(Object *const oPtr,
Tcl_Obj *const methodNameObj,
struct ChainBuilder *const cbPtr,
Tcl_HashTable *const doneFilters, int flags,
Class *const filterDecl);
static int AddPrivatesFromClassChainToCallContext(Class *classPtr,
Class *const contextCls,
Tcl_Obj *const methodNameObj,
struct ChainBuilder *const cbPtr,
Tcl_HashTable *const doneFilters, int flags,
Class *const filterDecl);
static int AddSimpleClassChainToCallContext(Class *classPtr,
static void AddSimpleClassChainToCallContext(Class *classPtr,
Tcl_Obj *const methodNameObj,
struct ChainBuilder *const cbPtr,
Tcl_HashTable *const doneFilters, int flags,
@@ -113,8 +77,6 @@ static inline int IsStillValid(CallChain *callPtr, Object *oPtr,
int flags, int reuseMask);
static Tcl_NRPostProc ResetFilterFlags;
static Tcl_NRPostProc SetFilterFlags;
static int SortMethodNames(Tcl_HashTable *namesPtr, int flags,
const char ***stringsPtr);
static inline void StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr);
/*
@@ -404,14 +366,6 @@ FinalizeMethodRefs(
int
TclOOGetSortedMethodList(
Object *oPtr, /* The object to get the method names for. */
Object *contextObj, /* From what context object we are inquiring.
* NULL when the context shouldn't see
* object-level private methods. Note that
* flags can override this. */
Class *contextCls, /* From what context class we are inquiring.
* NULL when the context shouldn't see
* class-level private methods. Note that
* flags can override this. */
int flags, /* Whether we just want the public method
* names. */
const char ***stringsPtr) /* Where to write a pointer to the array of
@@ -424,10 +378,12 @@ TclOOGetSortedMethodList(
* at. Is set-like in nature and keyed by
* pointer to class. */
FOREACH_HASH_DECLS;
int i, numStrings;
int i;
Class *mixinPtr;
Tcl_Obj *namePtr;
Method *mPtr;
int isWantedIn;
void *isWanted;
Tcl_InitObjHashTable(&names);
Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);
@@ -444,13 +400,18 @@ TclOOGetSortedMethodList(
if (oPtr->methodsPtr) {
FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
if (IS_PRIVATE(mPtr)) {
int isNew;
if ((mPtr->flags & PRIVATE_METHOD) && !(flags & PRIVATE_METHOD)) {
continue;
}
if (IS_UNEXPORTED(mPtr) && !WANT_UNEXPORTED(flags)) {
continue;
hPtr = Tcl_CreateHashEntry(&names, (char *) namePtr, &isNew);
if (isNew) {
isWantedIn = ((!(flags & PUBLIC_METHOD)
|| mPtr->flags & PUBLIC_METHOD) ? IN_LIST : 0);
isWantedIn |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn));
}
AddStandardMethodName(flags, namePtr, mPtr, &names);
}
}
@@ -458,26 +419,29 @@ TclOOGetSortedMethodList(
* Process method names due to private methods on the object's class.
*/
if (WANT_UNEXPORTED(flags)) {
if (flags & PRIVATE_METHOD) {
FOREACH_HASH(namePtr, mPtr, &oPtr->selfCls->classMethods) {
if (IS_UNEXPORTED(mPtr)) {
AddStandardMethodName(flags, namePtr, mPtr, &names);
if (mPtr->flags & PRIVATE_METHOD) {
int isNew;
hPtr = Tcl_CreateHashEntry(&names, (char *) namePtr, &isNew);
if (isNew) {
isWantedIn = IN_LIST;
if (mPtr->typePtr == NULL) {
isWantedIn |= NO_IMPLEMENTATION;
}
Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn));
} else if (mPtr->typePtr != NULL) {
isWantedIn = PTR2INT(Tcl_GetHashValue(hPtr));
if (isWantedIn & NO_IMPLEMENTATION) {
isWantedIn &= ~NO_IMPLEMENTATION;
Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn));
}
}
}
}
}
/*
* Process method names due to private methods on the context's object or
* class. Which must be correct if either are not NULL.
*/
if (contextObj && contextObj->methodsPtr) {
AddPrivateMethodNames(contextObj->methodsPtr, &names);
}
if (contextCls) {
AddPrivateMethodNames(&contextCls->classMethods, &names);
}
/*
* Process (normal) method names from the class hierarchy and the mixin
* hierarchy.
@@ -485,19 +449,54 @@ TclOOGetSortedMethodList(
AddClassMethodNames(oPtr->selfCls, flags, &names, &examinedClasses);
FOREACH(mixinPtr, oPtr->mixins) {
AddClassMethodNames(mixinPtr, flags | TRAVERSED_MIXIN, &names,
AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, &names,
&examinedClasses);
}
Tcl_DeleteHashTable(&examinedClasses);
/*
* Tidy up, sort the names and resolve finally whether we really want
* them (processing export layering).
* See how many (visible) method names there are. If none, we do not (and
* should not) try to sort the list of them.
*/
Tcl_DeleteHashTable(&examinedClasses);
numStrings = SortMethodNames(&names, flags, stringsPtr);
i = 0;
if (names.numEntries != 0) {
const char **strings;
/*
* We need to build the list of methods to sort. We will be using
* qsort() for this, because it is very unlikely that the list will be
* heavily sorted when it is long enough to matter.
*/
strings = ckalloc(sizeof(char *) * names.numEntries);
FOREACH_HASH(namePtr, isWanted, &names) {
if (!(flags & PUBLIC_METHOD) || (PTR2INT(isWanted) & IN_LIST)) {
if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
continue;
}
strings[i++] = TclGetString(namePtr);
}
}
/*
* Note that 'i' may well be less than names.numEntries when we are
* dealing with public method names.
*/
if (i > 0) {
if (i > 1) {
qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
}
*stringsPtr = strings;
} else {
ckfree(strings);
}
}
Tcl_DeleteHashTable(&names);
return numStrings;
return i;
}
int
@@ -514,7 +513,10 @@ TclOOGetSortedClassMethodList(
/* Used to track what classes have been looked
* at. Is set-like in nature and keyed by
* pointer to class. */
int numStrings;
FOREACH_HASH_DECLS;
int i;
Tcl_Obj *namePtr;
void *isWanted;
Tcl_InitObjHashTable(&names);
Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);
@@ -526,101 +528,51 @@ TclOOGetSortedClassMethodList(
AddClassMethodNames(clsPtr, flags, &names, &examinedClasses);
Tcl_DeleteHashTable(&examinedClasses);
/*
* Process private method names if we should. [TIP 500]
*/
if (WANT_PRIVATE(flags)) {
AddPrivateMethodNames(&clsPtr->classMethods, &names);
flags &= ~TRUE_PRIVATE_METHOD;
}
/*
* Tidy up, sort the names and resolve finally whether we really want
* them (processing export layering).
*/
numStrings = SortMethodNames(&names, flags, stringsPtr);
Tcl_DeleteHashTable(&names);
return numStrings;
}
/*
* ----------------------------------------------------------------------
*
* SortMethodNames --
*
* Shared helper for TclOOGetSortedMethodList etc. that knows the method
* sorting rules.
*
* Returns:
* The length of the sorted list.
*
* ----------------------------------------------------------------------
*/
static int
SortMethodNames(
Tcl_HashTable *namesPtr, /* The table of names; unsorted, but contains
* whether the names are wanted and under what
* circumstances. */
int flags, /* Whether we are looking for unexported
* methods. Full private methods are handled
* on insertion to the table. */
const char ***stringsPtr) /* Where to store the sorted list of strings
* that we produce. ckalloced() */
{
const char **strings;
FOREACH_HASH_DECLS;
Tcl_Obj *namePtr;
void *isWanted;
int i = 0;
/*
* See how many (visible) method names there are. If none, we do not (and
* should not) try to sort the list of them.
*/
if (namesPtr->numEntries == 0) {
*stringsPtr = NULL;
return 0;
}
i = 0;
if (names.numEntries != 0) {
const char **strings;
/*
* We need to build the list of methods to sort. We will be using qsort()
* for this, because it is very unlikely that the list will be heavily
* sorted when it is long enough to matter.
*/
/*
* We need to build the list of methods to sort. We will be using
* qsort() for this, because it is very unlikely that the list will be
* heavily sorted when it is long enough to matter.
*/
strings = ckalloc(sizeof(char *) * namesPtr->numEntries);
FOREACH_HASH(namePtr, isWanted, namesPtr) {
if (!WANT_PUBLIC(flags) || (PTR2INT(isWanted) & IN_LIST)) {
if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
continue;
strings = ckalloc(sizeof(char *) * names.numEntries);
FOREACH_HASH(namePtr, isWanted, &names) {
if (!(flags & PUBLIC_METHOD) || (PTR2INT(isWanted) & IN_LIST)) {
if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
continue;
}
strings[i++] = TclGetString(namePtr);
}
strings[i++] = TclGetString(namePtr);
}
/*
* Note that 'i' may well be less than names.numEntries when we are
* dealing with public method names.
*/
if (i > 0) {
if (i > 1) {
qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
}
*stringsPtr = strings;
} else {
ckfree(strings);
}
}
/*
* Note that 'i' may well be less than names.numEntries when we are
* dealing with public method names. We don't sort unless there's at least
* two method names.
*/
if (i > 0) {
if (i > 1) {
qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
}
*stringsPtr = strings;
} else {
ckfree(strings);
*stringsPtr = NULL;
}
Tcl_DeleteHashTable(&names);
return i;
}
/* Comparator for SortMethodNames */
/* Comparator for GetSortedMethodList */
static int
CmpStr(
const void *ptr1,
@@ -629,7 +581,7 @@ CmpStr(
const char **strPtr1 = (const char **) ptr1;
const char **strPtr2 = (const char **) ptr2;
return TclpUtfNcmp2(*strPtr1, *strPtr2, strlen(*strPtr1) + 1);
return TclpUtfNcmp2(*strPtr1, *strPtr2, strlen(*strPtr1)+1);
}
/*
@@ -662,8 +614,6 @@ AddClassMethodNames(
* pointers to the classes, and the values are
* immaterial. */
{
int i;
/*
* If we've already started looking at this class, stop working on it now
* to prevent repeated work.
@@ -694,6 +644,7 @@ AddClassMethodNames(
if (clsPtr->mixins.num != 0) {
Class *mixinPtr;
int i;
FOREACH(mixinPtr, clsPtr->mixins) {
if (mixinPtr != clsPtr) {
@@ -704,7 +655,20 @@ AddClassMethodNames(
}
FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
AddStandardMethodName(flags, namePtr, mPtr, namesPtr);
hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
if (isNew) {
int isWanted = (!(flags & PUBLIC_METHOD)
|| (mPtr->flags & PUBLIC_METHOD)) ? IN_LIST : 0;
isWanted |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
} else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION)
&& mPtr->typePtr != NULL) {
int isWanted = PTR2INT(Tcl_GetHashValue(hPtr));
isWanted &= ~NO_IMPLEMENTATION;
Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
}
}
if (clsPtr->superclasses.num != 1) {
@@ -714,6 +678,7 @@ AddClassMethodNames(
}
if (clsPtr->superclasses.num != 0) {
Class *superPtr;
int i;
FOREACH(superPtr, clsPtr->superclasses) {
AddClassMethodNames(superPtr, flags, namesPtr,
@@ -722,105 +687,6 @@ AddClassMethodNames(
}
}
/*
* ----------------------------------------------------------------------
*
* AddPrivateMethodNames, AddStandardMethodName --
*
* Factored-out helpers for the sorted name list production functions.
*
* ----------------------------------------------------------------------
*/
static inline void
AddPrivateMethodNames(
Tcl_HashTable *methodsTablePtr,
Tcl_HashTable *namesPtr)
{
FOREACH_HASH_DECLS;
Method *mPtr;
Tcl_Obj *namePtr;
FOREACH_HASH(namePtr, mPtr, methodsTablePtr) {
if (IS_PRIVATE(mPtr)) {
int isNew;
hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
Tcl_SetHashValue(hPtr, INT2PTR(IN_LIST));
}
}
}
static inline void
AddStandardMethodName(
int flags,
Tcl_Obj *namePtr,
Method *mPtr,
Tcl_HashTable *namesPtr)
{
if (!IS_PRIVATE(mPtr)) {
int isNew;
Tcl_HashEntry *hPtr =
Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
if (isNew) {
int isWanted = (!WANT_PUBLIC(flags) || IS_PUBLIC(mPtr))
? IN_LIST : 0;
isWanted |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
} else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION)
&& mPtr->typePtr != NULL) {
int isWanted = PTR2INT(Tcl_GetHashValue(hPtr));
isWanted &= ~NO_IMPLEMENTATION;
Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
}
}
}
#undef IN_LIST
#undef NO_IMPLEMENTATION
/*
* ----------------------------------------------------------------------
*
* AddInstancePrivateToCallContext --
*
* Add private methods from the instance. Called when the calling Tcl
* context is a TclOO method declared by an object that is the same as
* the current object. Returns true iff a private method was actually
* found and added to the call chain (as this suppresses caching).
*
* ----------------------------------------------------------------------
*/
static inline int
AddInstancePrivateToCallContext(
Object *const oPtr, /* Object to add call chain entries for. */
Tcl_Obj *const methodName, /* Name of method to add the call chain
* entries for. */
struct ChainBuilder *const cbPtr,
/* Where to add the call chain entries. */
int flags) /* What sort of call chain are we building. */
{
Tcl_HashEntry *hPtr;
Method *mPtr;
int donePrivate = 0;
if (oPtr->methodsPtr) {
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodName);
if (hPtr != NULL) {
mPtr = Tcl_GetHashValue(hPtr);
if (IS_PRIVATE(mPtr)) {
AddMethodToCallChain(mPtr, cbPtr, NULL, NULL, flags);
donePrivate = 1;
}
}
}
return donePrivate;
}
/*
* ----------------------------------------------------------------------
*
@@ -829,17 +695,14 @@ AddInstancePrivateToCallContext(
* The core of the call-chain construction engine, this handles calling a
* particular method on a particular object. Note that filters and
* unknown handling are already handled by the logic that uses this
* function. Returns true if a private method was one of those found.
* function.
*
* ----------------------------------------------------------------------
*/
static inline int
static inline void
AddSimpleChainToCallContext(
Object *const oPtr, /* Object to add call chain entries for. */
Class *const contextCls, /* Context class; the currently considered
* class is equal to this, private methods may
* also be added. [TIP 500] */
Tcl_Obj *const methodNameObj,
/* Name of method to add the call chain
* entries for. */
@@ -853,62 +716,44 @@ AddSimpleChainToCallContext(
* NULL, either the filter was declared by the
* object or this isn't a filter. */
{
int i, foundPrivate = 0, blockedUnexported = 0;
Tcl_HashEntry *hPtr;
Method *mPtr;
int i;
if (!(flags & (KNOWN_STATE | SPECIAL)) && oPtr->methodsPtr) {
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodNameObj);
Tcl_HashEntry *hPtr = Tcl_FindHashEntry(oPtr->methodsPtr,
(char *) methodNameObj);
if (hPtr != NULL) {
mPtr = Tcl_GetHashValue(hPtr);
if (!IS_PRIVATE(mPtr)) {
if (WANT_PUBLIC(flags)) {
if (!IS_PUBLIC(mPtr)) {
blockedUnexported = 1;
} else {
flags |= DEFINITE_PUBLIC;
}
Method *mPtr = Tcl_GetHashValue(hPtr);
if (flags & PUBLIC_METHOD) {
if (!(mPtr->flags & PUBLIC_METHOD)) {
return;
} else {
flags |= DEFINITE_PROTECTED;
flags |= DEFINITE_PUBLIC;
}
} else {
flags |= DEFINITE_PROTECTED;
}
}
}
if (!(flags & SPECIAL)) {
Tcl_HashEntry *hPtr;
Class *mixinPtr;
FOREACH(mixinPtr, oPtr->mixins) {
if (contextCls) {
foundPrivate |= AddPrivatesFromClassChainToCallContext(
mixinPtr, contextCls, methodNameObj, cbPtr,
doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
}
foundPrivate |= AddSimpleClassChainToCallContext(mixinPtr,
methodNameObj, cbPtr, doneFilters,
flags | TRAVERSED_MIXIN, filterDecl);
AddSimpleClassChainToCallContext(mixinPtr, methodNameObj, cbPtr,
doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
}
if (oPtr->methodsPtr && !blockedUnexported) {
if (oPtr->methodsPtr) {
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj);
if (hPtr != NULL) {
mPtr = Tcl_GetHashValue(hPtr);
if (!IS_PRIVATE(mPtr)) {
AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
flags);
}
AddMethodToCallChain(Tcl_GetHashValue(hPtr), cbPtr,
doneFilters, filterDecl, flags);
}
}
}
if (contextCls) {
foundPrivate |= AddPrivatesFromClassChainToCallContext(oPtr->selfCls,
contextCls, methodNameObj, cbPtr, doneFilters, flags,
filterDecl);
}
if (!blockedUnexported) {
foundPrivate |= AddSimpleClassChainToCallContext(oPtr->selfCls,
methodNameObj, cbPtr, doneFilters, flags, filterDecl);
}
return foundPrivate;
AddSimpleClassChainToCallContext(oPtr->selfCls, methodNameObj, cbPtr,
doneFilters, flags, filterDecl);
}
/*
@@ -971,8 +816,8 @@ AddMethodToCallChain(
* should be sufficient for [incr Tcl] support though.
*/
if (!WANT_UNEXPORTED(callPtr->flags)
&& IS_UNEXPORTED(mPtr)
if (!(callPtr->flags & PRIVATE_METHOD)
&& (mPtr->flags & PRIVATE_METHOD)
&& (mPtr->declaringClassPtr != NULL)
&& (mPtr->declaringClassPtr != cbPtr->oPtr->selfCls)) {
return;
@@ -1013,7 +858,7 @@ AddMethodToCallChain(
if (callPtr->numChain == CALL_CHAIN_STATIC_SIZE) {
callPtr->chain =
ckalloc(sizeof(struct MInvoke) * (callPtr->numChain + 1));
ckalloc(sizeof(struct MInvoke) * (callPtr->numChain+1));
memcpy(callPtr->chain, callPtr->staticChain,
sizeof(struct MInvoke) * callPtr->numChain);
} else if (callPtr->numChain > CALL_CHAIN_STATIC_SIZE) {
@@ -1112,12 +957,6 @@ TclOOGetCallContext(
* Only the bits PUBLIC_METHOD, CONSTRUCTOR,
* PRIVATE_METHOD, DESTRUCTOR and
* FILTER_HANDLING are useful. */
Object *contextObj, /* Context object; when equal to oPtr, it
* means that private methods may also be
* added. [TIP 500] */
Class *contextCls, /* Context class; the currently considered
* class is equal to this, private methods may
* also be added. [TIP 500] */
Tcl_Obj *cacheInThisObj) /* What object to cache in, or NULL if it is
* to be in the same object as the
* methodNameObj. */
@@ -1125,7 +964,7 @@ TclOOGetCallContext(
CallContext *contextPtr;
CallChain *callPtr;
struct ChainBuilder cb;
int i, count, doFilters, donePrivate = 0;
int i, count, doFilters;
Tcl_HashEntry *hPtr;
Tcl_HashTable doneFilters;
@@ -1165,7 +1004,7 @@ TclOOGetCallContext(
* the object, and in the class).
*/
const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);
const int reuseMask = ((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD);
if (cacheInThisObj->typePtr == &methodNameType) {
callPtr = cacheInThisObj->internalRep.twoPtrValue.ptr1;
@@ -1217,11 +1056,10 @@ TclOOGetCallContext(
*/
if (flags & FORCE_UNKNOWN) {
AddSimpleChainToCallContext(oPtr, NULL,
oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS,
NULL);
AddSimpleChainToCallContext(oPtr, NULL,
oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL);
AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
&cb, NULL, BUILDING_MIXINS, NULL);
AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
&cb, NULL, 0, NULL);
callPtr->flags |= OO_UNKNOWN_METHOD;
callPtr->epoch = -1;
if (callPtr->numChain == 0) {
@@ -1250,10 +1088,10 @@ TclOOGetCallContext(
OBJECT_MIXIN);
}
FOREACH(filterObj, oPtr->filters) {
donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
filterObj, &cb, &doneFilters, BUILDING_MIXINS, NULL);
donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
filterObj, &cb, &doneFilters, 0, NULL);
AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters,
BUILDING_MIXINS, NULL);
AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters, 0,
NULL);
}
AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters,
BUILDING_MIXINS);
@@ -1268,15 +1106,9 @@ TclOOGetCallContext(
* handle class mixins right.
*/
if (oPtr == contextObj) {
donePrivate |= AddInstancePrivateToCallContext(oPtr, methodNameObj,
&cb, flags);
donePrivate |= (contextObj->flags & HAS_PRIVATE_METHODS);
}
donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
methodNameObj, &cb, NULL, flags|BUILDING_MIXINS, NULL);
donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
methodNameObj, &cb, NULL, flags, NULL);
AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL,
flags|BUILDING_MIXINS, NULL);
AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL, flags, NULL);
/*
* Check to see if the method has no implementation. If so, we probably
@@ -1294,18 +1126,17 @@ TclOOGetCallContext(
TclOODeleteChain(callPtr);
return NULL;
}
AddSimpleChainToCallContext(oPtr, NULL,
oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS,
NULL);
AddSimpleChainToCallContext(oPtr, NULL,
oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL);
AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
&cb, NULL, BUILDING_MIXINS, NULL);
AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
&cb, NULL, 0, NULL);
callPtr->flags |= OO_UNKNOWN_METHOD;
callPtr->epoch = -1;
if (count == callPtr->numChain) {
TclOODeleteChain(callPtr);
return NULL;
}
} else if (doFilters && !donePrivate) {
} else if (doFilters) {
if (hPtr == NULL) {
if (oPtr->flags & USE_CLASS_CACHE) {
if (oPtr->selfCls->classChainCache == NULL) {
@@ -1411,7 +1242,8 @@ TclOOGetStereotypeCallChain(
hPtr = Tcl_FindHashEntry(clsPtr->classChainCache,
(char *) methodNameObj);
if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);
const int reuseMask =
((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD);
callPtr = Tcl_GetHashValue(hPtr);
if (IsStillValid(callPtr, &obj, flags, reuseMask)) {
@@ -1455,10 +1287,9 @@ TclOOGetStereotypeCallChain(
* Add the actual method implementations.
*/
AddSimpleChainToCallContext(&obj, NULL, methodNameObj, &cb, NULL,
AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL,
flags|BUILDING_MIXINS, NULL);
AddSimpleChainToCallContext(&obj, NULL, methodNameObj, &cb, NULL, flags,
NULL);
AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL, flags, NULL);
/*
* Check to see if the method has no implementation. If so, we probably
@@ -1467,10 +1298,10 @@ TclOOGetStereotypeCallChain(
*/
if (count == callPtr->numChain) {
AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj,
&cb, NULL, BUILDING_MIXINS, NULL);
AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj,
&cb, NULL, 0, NULL);
AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb,
NULL, BUILDING_MIXINS, NULL);
AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb,
NULL, 0, NULL);
callPtr->flags |= OO_UNKNOWN_METHOD;
callPtr->epoch = -1;
if (count == callPtr->numChain) {
@@ -1550,9 +1381,9 @@ AddClassFiltersToCallContext(
(void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj,
&isNew);
if (isNew) {
AddSimpleChainToCallContext(oPtr, NULL, filterObj, cbPtr,
AddSimpleChainToCallContext(oPtr, filterObj, cbPtr,
doneFilters, clearedFlags|BUILDING_MIXINS, clsPtr);
AddSimpleChainToCallContext(oPtr, NULL, filterObj, cbPtr,
AddSimpleChainToCallContext(oPtr, filterObj, cbPtr,
doneFilters, clearedFlags, clsPtr);
}
}
@@ -1579,22 +1410,18 @@ AddClassFiltersToCallContext(
/*
* ----------------------------------------------------------------------
*
* AddPrivatesFromClassChainToCallContext --
* AddSimpleClassChainToCallContext --
*
* Helper for AddSimpleChainToCallContext that is used to find private
* methds and add them to the call chain. Returns true when a private
* method is found and added. [TIP 500]
* Construct a call-chain from a class hierarchy.
*
* ----------------------------------------------------------------------
*/
static int
AddPrivatesFromClassChainToCallContext(
static void
AddSimpleClassChainToCallContext(
Class *classPtr, /* Class to add the call chain entries for. */
Class *const contextCls, /* Context class; the currently considered
* class is equal to this, private methods may
* also be added. */
Tcl_Obj *const methodName, /* Name of method to add the call chain
Tcl_Obj *const methodNameObj,
/* Name of method to add the call chain
* entries for. */
struct ChainBuilder *const cbPtr,
/* Where to add the call chain entries. */
@@ -1619,86 +1446,8 @@ AddPrivatesFromClassChainToCallContext(
tailRecurse:
FOREACH(superPtr, classPtr->mixins) {
if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls,
methodName, cbPtr, doneFilters, flags|TRAVERSED_MIXIN,
filterDecl)) {
return 1;
}
}
if (classPtr == contextCls) {
Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
(char *) methodName);
if (hPtr != NULL) {
register Method *mPtr = Tcl_GetHashValue(hPtr);
if (IS_PRIVATE(mPtr)) {
AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
flags);
return 1;
}
}
}
switch (classPtr->superclasses.num) {
case 1:
classPtr = classPtr->superclasses.list[0];
goto tailRecurse;
default:
FOREACH(superPtr, classPtr->superclasses) {
if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls,
methodName, cbPtr, doneFilters, flags, filterDecl)) {
return 1;
}
}
case 0:
return 0;
}
}
/*
* ----------------------------------------------------------------------
*
* AddSimpleClassChainToCallContext --
*
* Construct a call-chain from a class hierarchy.
*
* ----------------------------------------------------------------------
*/
static int
AddSimpleClassChainToCallContext(
Class *classPtr, /* Class to add the call chain entries for. */
Tcl_Obj *const methodNameObj,
/* Name of method to add the call chain
* entries for. */
struct ChainBuilder *const cbPtr,
/* Where to add the call chain entries. */
Tcl_HashTable *const doneFilters,
/* Where to record what call chain entries
* have been processed. */
int flags, /* What sort of call chain are we building. */
Class *const filterDecl) /* The class that declared the filter. If
* NULL, either the filter was declared by the
* object or this isn't a filter. */
{
int i, privateDanger = 0;
Class *superPtr;
/*
* We hard-code the tail-recursive form. It's by far the most common case
* *and* it is much more gentle on the stack.
*
* Note that mixins must be processed before the main class hierarchy.
* [Bug 1998221]
*/
tailRecurse:
FOREACH(superPtr, classPtr->mixins) {
privateDanger |= AddSimpleClassChainToCallContext(superPtr,
methodNameObj, cbPtr, doneFilters, flags | TRAVERSED_MIXIN,
filterDecl);
AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr,
doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
}
if (flags & CONSTRUCTOR) {
@@ -1712,26 +1461,21 @@ AddSimpleClassChainToCallContext(
Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
(char *) methodNameObj);
if (classPtr->flags & HAS_PRIVATE_METHODS) {
privateDanger |= 1;
}
if (hPtr != NULL) {
register Method *mPtr = Tcl_GetHashValue(hPtr);
if (!IS_PRIVATE(mPtr)) {
if (!(flags & KNOWN_STATE)) {
if (flags & PUBLIC_METHOD) {
if (!IS_PUBLIC(mPtr)) {
return privateDanger;
}
if (!(flags & KNOWN_STATE)) {
if (flags & PUBLIC_METHOD) {
if (mPtr->flags & PUBLIC_METHOD) {
flags |= DEFINITE_PUBLIC;
} else {
flags |= DEFINITE_PROTECTED;
return;
}
} else {
flags |= DEFINITE_PROTECTED;
}
AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
flags);
}
AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl, flags);
}
}
@@ -1741,11 +1485,11 @@ AddSimpleClassChainToCallContext(
goto tailRecurse;
default:
FOREACH(superPtr, classPtr->superclasses) {
privateDanger |= AddSimpleClassChainToCallContext(superPtr,
methodNameObj, cbPtr, doneFilters, flags, filterDecl);
AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr,
doneFilters, flags, filterDecl);
}
case 0:
return privateDanger;
return;
}
}
@@ -1765,7 +1509,7 @@ TclOORenderCallChain(
Tcl_Interp *interp,
CallChain *callPtr)
{
Tcl_Obj *filterLiteral, *methodLiteral, *objectLiteral, *privateLiteral;
Tcl_Obj *filterLiteral, *methodLiteral, *objectLiteral;
Tcl_Obj *resultObj, *descObjs[4], **objv;
Foundation *fPtr = TclOOGetFoundation(interp);
int i;
@@ -1774,14 +1518,12 @@ TclOORenderCallChain(
* Allocate the literals (potentially) used in our description.
*/
TclNewLiteralStringObj(filterLiteral, "filter");
filterLiteral = Tcl_NewStringObj("filter", -1);
Tcl_IncrRefCount(filterLiteral);
TclNewLiteralStringObj(methodLiteral, "method");
methodLiteral = Tcl_NewStringObj("method", -1);
Tcl_IncrRefCount(methodLiteral);
TclNewLiteralStringObj(objectLiteral, "object");
objectLiteral = Tcl_NewStringObj("object", -1);
Tcl_IncrRefCount(objectLiteral);
TclNewLiteralStringObj(privateLiteral, "private");
Tcl_IncrRefCount(privateLiteral);
/*
* Do the actual construction of the descriptions. They consist of a list
@@ -1799,15 +1541,16 @@ TclOORenderCallChain(
for (i=0 ; i<callPtr->numChain ; i++) {
struct MInvoke *miPtr = &callPtr->chain[i];
descObjs[0] =
miPtr->isFilter ? filterLiteral :
callPtr->flags & OO_UNKNOWN_METHOD ? fPtr->unknownMethodNameObj :
IS_PRIVATE(miPtr->mPtr) ? privateLiteral :
methodLiteral;
descObjs[1] =
callPtr->flags & CONSTRUCTOR ? fPtr->constructorName :
callPtr->flags & DESTRUCTOR ? fPtr->destructorName :
miPtr->mPtr->namePtr;
descObjs[0] = miPtr->isFilter
? filterLiteral
: callPtr->flags & OO_UNKNOWN_METHOD
? fPtr->unknownMethodNameObj
: methodLiteral;
descObjs[1] = callPtr->flags & CONSTRUCTOR
? fPtr->constructorName
: callPtr->flags & DESTRUCTOR
? fPtr->destructorName
: miPtr->mPtr->namePtr;
descObjs[2] = miPtr->mPtr->declaringClassPtr
? Tcl_GetObjectName(interp,
(Tcl_Object) miPtr->mPtr->declaringClassPtr->thisPtr)
@@ -1825,7 +1568,6 @@ TclOORenderCallChain(
Tcl_DecrRefCount(filterLiteral);
Tcl_DecrRefCount(methodLiteral);
Tcl_DecrRefCount(objectLiteral);
Tcl_DecrRefCount(privateLiteral);
/*
* Finish building the description and return it.
+4 -9
View File
@@ -59,11 +59,11 @@ TCLAPI Tcl_Obj * Tcl_MethodName(Tcl_Method method);
/* 11 */
TCLAPI Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp,
Tcl_Object object, Tcl_Obj *nameObj,
int flags, const Tcl_MethodType *typePtr,
int isPublic, const Tcl_MethodType *typePtr,
ClientData clientData);
/* 12 */
TCLAPI Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
Tcl_Obj *nameObj, int flags,
Tcl_Obj *nameObj, int isPublic,
const Tcl_MethodType *typePtr,
ClientData clientData);
/* 13 */
@@ -116,8 +116,6 @@ TCLAPI void Tcl_ClassSetDestructor(Tcl_Interp *interp,
/* 28 */
TCLAPI Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp,
Tcl_Object object);
/* 29 */
TCLAPI int Tcl_MethodIsPrivate(Tcl_Method method);
typedef struct {
const struct TclOOIntStubs *tclOOIntStubs;
@@ -138,8 +136,8 @@ typedef struct TclOOStubs {
int (*tcl_MethodIsPublic) (Tcl_Method method); /* 8 */
int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, ClientData *clientDataPtr); /* 9 */
Tcl_Obj * (*tcl_MethodName) (Tcl_Method method); /* 10 */
Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, ClientData clientData); /* 11 */
Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, ClientData clientData); /* 12 */
Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 11 */
Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 12 */
Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip); /* 13 */
int (*tcl_ObjectDeleted) (Tcl_Object object); /* 14 */
int (*tcl_ObjectContextIsFiltering) (Tcl_ObjectContext context); /* 15 */
@@ -156,7 +154,6 @@ typedef struct TclOOStubs {
void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */
void (*tcl_ClassSetDestructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */
Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */
int (*tcl_MethodIsPrivate) (Tcl_Method method); /* 29 */
} TclOOStubs;
extern const TclOOStubs *tclOOStubsPtr;
@@ -229,8 +226,6 @@ extern const TclOOStubs *tclOOStubsPtr;
(tclOOStubsPtr->tcl_ClassSetDestructor) /* 27 */
#define Tcl_GetObjectName \
(tclOOStubsPtr->tcl_GetObjectName) /* 28 */
#define Tcl_MethodIsPrivate \
(tclOOStubsPtr->tcl_MethodIsPrivate) /* 29 */
#endif /* defined(USE_TCLOO_STUBS) */
+100 -284
View File
@@ -16,12 +16,6 @@
#include "tclInt.h"
#include "tclOOInt.h"
/*
* The actual value used to mark private declaration frames.
*/
#define PRIVATE_FRAME (FRAME_IS_OO_DEFINE | FRAME_IS_PRIVATE_DEFINE)
/*
* The maximum length of fully-qualified object name to use in an errorinfo
* message. Longer than this will be curtailed.
@@ -124,35 +118,6 @@ static const struct DeclaredSlot slots[] = {
SLOT("objdefine::variable", ObjVarsGet, ObjVarsSet),
{NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}
};
/*
* How to build the in-namespace name of a private variable. This is a pattern
* used with Tcl_ObjPrintf().
*/
#define PRIVATE_VARIABLE_PATTERN "%d : %s"
/*
* ----------------------------------------------------------------------
*
* IsPrivateDefine --
*
* Extracts whether the current context is handling private definitions.
*
* ----------------------------------------------------------------------
*/
static inline int
IsPrivateDefine(
Tcl_Interp *interp)
{
Interp *iPtr = (Interp *) interp;
if (!iPtr->varFramePtr) {
return 0;
}
return iPtr->varFramePtr->isProcCallFrame == PRIVATE_FRAME;
}
/*
* ----------------------------------------------------------------------
@@ -451,123 +416,6 @@ TclOOClassSetMixins(
BumpGlobalEpoch(interp, classPtr);
}
/*
* ----------------------------------------------------------------------
*
* InstallStandardVariableMapping, InstallPrivateVariableMapping --
*
* Helpers for installing standard and private variable maps.
*
* ----------------------------------------------------------------------
*/
static inline void
InstallStandardVariableMapping(
VariableNameList *vnlPtr,
int varc,
Tcl_Obj *const *varv)
{
Tcl_Obj *variableObj;
int i, n, created;
Tcl_HashTable uniqueTable;
for (i=0 ; i<varc ; i++) {
Tcl_IncrRefCount(varv[i]);
}
FOREACH(variableObj, *vnlPtr) {
Tcl_DecrRefCount(variableObj);
}
if (i != varc) {
if (varc == 0) {
ckfree(vnlPtr->list);
} else if (i) {
vnlPtr->list = ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * varc);
} else {
vnlPtr->list = ckalloc(sizeof(Tcl_Obj *) * varc);
}
}
vnlPtr->num = 0;
if (varc > 0) {
Tcl_InitObjHashTable(&uniqueTable);
for (i=n=0 ; i<varc ; i++) {
Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
if (created) {
vnlPtr->list[n++] = varv[i];
} else {
Tcl_DecrRefCount(varv[i]);
}
}
vnlPtr->num = n;
/*
* Shouldn't be necessary, but maintain num/list invariant.
*/
if (n != varc) {
vnlPtr->list = ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * n);
}
Tcl_DeleteHashTable(&uniqueTable);
}
}
static inline void
InstallPrivateVariableMapping(
PrivateVariableList *pvlPtr,
int varc,
Tcl_Obj *const *varv,
int creationEpoch)
{
PrivateVariableMapping *privatePtr;
int i, n, created;
Tcl_HashTable uniqueTable;
for (i=0 ; i<varc ; i++) {
Tcl_IncrRefCount(varv[i]);
}
FOREACH_STRUCT(privatePtr, *pvlPtr) {
Tcl_DecrRefCount(privatePtr->variableObj);
Tcl_DecrRefCount(privatePtr->fullNameObj);
}
if (i != varc) {
if (varc == 0) {
ckfree(pvlPtr->list);
} else if (i) {
pvlPtr->list = ckrealloc(pvlPtr->list,
sizeof(PrivateVariableMapping) * varc);
} else {
pvlPtr->list = ckalloc(sizeof(PrivateVariableMapping) * varc);
}
}
pvlPtr->num = 0;
if (varc > 0) {
Tcl_InitObjHashTable(&uniqueTable);
for (i=n=0 ; i<varc ; i++) {
Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
if (created) {
privatePtr = &(pvlPtr->list[n++]);
privatePtr->variableObj = varv[i];
privatePtr->fullNameObj = Tcl_ObjPrintf(
PRIVATE_VARIABLE_PATTERN,
creationEpoch, Tcl_GetString(varv[i]));
Tcl_IncrRefCount(privatePtr->fullNameObj);
} else {
Tcl_DecrRefCount(varv[i]);
}
}
pvlPtr->num = n;
/*
* Shouldn't be necessary, but maintain num/list invariant.
*/
if (n != varc) {
pvlPtr->list = ckrealloc(pvlPtr->list,
sizeof(PrivateVariableMapping) * n);
}
Tcl_DeleteHashTable(&uniqueTable);
}
}
/*
* ----------------------------------------------------------------------
*
@@ -860,8 +708,7 @@ TclOOGetDefineCmdContext(
Tcl_Object object;
if ((iPtr->varFramePtr == NULL)
|| (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE
&& iPtr->varFramePtr->isProcCallFrame != PRIVATE_FRAME)) {
|| (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"this command may only be called from within the context of"
" an ::oo::define or ::oo::objdefine command", -1));
@@ -902,8 +749,7 @@ GetClassInOuterContext(
Object *oPtr;
CallFrame *savedFramePtr = iPtr->varFramePtr;
while (iPtr->varFramePtr->isProcCallFrame == FRAME_IS_OO_DEFINE
|| iPtr->varFramePtr->isProcCallFrame == PRIVATE_FRAME) {
while (iPtr->varFramePtr->isProcCallFrame == FRAME_IS_OO_DEFINE) {
if (iPtr->varFramePtr->callerVarPtr == NULL) {
Tcl_Panic("getting outer context when already in global context");
}
@@ -1192,7 +1038,7 @@ TclOODefineSelfObjCmd(
{
Foundation *fPtr = TclOOGetFoundation(interp);
Object *oPtr;
int result, private;
int result;
oPtr = (Object *) TclOOGetDefineCmdContext(interp);
if (oPtr == NULL) {
@@ -1204,8 +1050,6 @@ TclOODefineSelfObjCmd(
return TCL_OK;
}
private = IsPrivateDefine(interp);
/*
* Make the oo::objdefine namespace the current namespace and evaluate the
* command(s).
@@ -1214,9 +1058,6 @@ TclOODefineSelfObjCmd(
if (InitDefineContext(interp, fPtr->objdefNs, oPtr, objc,objv) != TCL_OK){
return TCL_ERROR;
}
if (private) {
((Interp *) interp)->varFramePtr->isProcCallFrame = PRIVATE_FRAME;
}
AddRef(oPtr);
if (objc == 2) {
@@ -1224,7 +1065,7 @@ TclOODefineSelfObjCmd(
Tcl_IncrRefCount(objNameObj);
result = TclEvalObjEx(interp, objv[1], 0,
((Interp *)interp)->cmdFramePtr, 1);
((Interp *)interp)->cmdFramePtr, 2);
if (result == TCL_ERROR) {
GenerateErrorInfo(interp, oPtr, objNameObj, "class object");
}
@@ -1276,79 +1117,6 @@ TclOODefineObjSelfObjCmd(
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* TclOODefinePrivateObjCmd --
*
* Implementation of the "private" subcommand of the "oo::define"
* and "oo::objdefine" commands.
*
* ----------------------------------------------------------------------
*/
int
TclOODefinePrivateObjCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
int isInstancePrivate = (clientData != NULL);
/* Just so that we can generate the correct
* error message depending on the context of
* usage of this function. */
Interp *iPtr = (Interp *) interp;
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
int saved; /* The saved flag. We restore it on exit so
* that [private private ...] doesn't make
* things go weird. */
int result;
if (oPtr == NULL) {
return TCL_ERROR;
}
if (objc == 1) {
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(IsPrivateDefine(interp)));
return TCL_OK;
}
/*
* Change the frame type flag while evaluating the body.
*/
saved = iPtr->varFramePtr->isProcCallFrame;
iPtr->varFramePtr->isProcCallFrame = PRIVATE_FRAME;
/*
* Evaluate the body; standard pattern.
*/
AddRef(oPtr);
if (objc == 2) {
Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
Tcl_IncrRefCount(objNameObj);
result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
if (result == TCL_ERROR) {
GenerateErrorInfo(interp, oPtr, objNameObj,
isInstancePrivate ? "object" : "class");
}
TclDecrRefCount(objNameObj);
} else {
result = MagicDefinitionInvoke(interp, TclGetCurrentNamespace(interp),
1, objc, objv);
}
TclOODecrRefCount(oPtr);
/*
* Restore the frame type flag to what it was previously.
*/
iPtr->varFramePtr->isProcCallFrame = saved;
return result;
}
/*
* ----------------------------------------------------------------------
*
@@ -1692,9 +1460,8 @@ TclOODefineExportObjCmd(
} else {
mPtr = Tcl_GetHashValue(hPtr);
}
if (isNew || !(mPtr->flags & (PUBLIC_METHOD | PRIVATE_METHOD))) {
if (isNew || !(mPtr->flags & PUBLIC_METHOD)) {
mPtr->flags |= PUBLIC_METHOD;
mPtr->flags &= ~TRUE_PRIVATE_METHOD;
changed = 1;
}
}
@@ -1754,9 +1521,6 @@ TclOODefineForwardObjCmd(
}
isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
? PUBLIC_METHOD : 0;
if (IsPrivateDefine(interp)) {
isPublic = TRUE_PRIVATE_METHOD;
}
/*
* Create the method structure.
@@ -1816,9 +1580,6 @@ TclOODefineMethodObjCmd(
}
isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
? PUBLIC_METHOD : 0;
if (IsPrivateDefine(interp)) {
isPublic = TRUE_PRIVATE_METHOD;
}
/*
* Create the method by using the right back-end API.
@@ -2034,8 +1795,8 @@ TclOODefineUnexportObjCmd(
} else {
mPtr = Tcl_GetHashValue(hPtr);
}
if (isNew || mPtr->flags & (PUBLIC_METHOD | TRUE_PRIVATE_METHOD)) {
mPtr->flags &= ~(PUBLIC_METHOD | TRUE_PRIVATE_METHOD);
if (isNew || mPtr->flags & PUBLIC_METHOD) {
mPtr->flags &= ~PUBLIC_METHOD;
changed = 1;
}
}
@@ -2527,7 +2288,7 @@ ClassVarsGet(
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
Tcl_Obj *resultObj;
Tcl_Obj *resultObj, *variableObj;
int i;
if (Tcl_ObjectContextSkippedArgs(context) != objc) {
@@ -2545,18 +2306,8 @@ ClassVarsGet(
}
resultObj = Tcl_NewObj();
if (IsPrivateDefine(interp)) {
PrivateVariableMapping *privatePtr;
FOREACH_STRUCT(privatePtr, oPtr->classPtr->privateVariables) {
Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
}
} else {
Tcl_Obj *variableObj;
FOREACH(variableObj, oPtr->classPtr->variables) {
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
}
FOREACH(variableObj, oPtr->classPtr->variables) {
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
}
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
@@ -2572,7 +2323,7 @@ ClassVarsSet(
{
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
int varc;
Tcl_Obj **varv;
Tcl_Obj **varv, *variableObj;
int i;
if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
@@ -2613,11 +2364,49 @@ ClassVarsSet(
}
}
if (IsPrivateDefine(interp)) {
InstallPrivateVariableMapping(&oPtr->classPtr->privateVariables,
varc, varv, oPtr->classPtr->thisPtr->creationEpoch);
} else {
InstallStandardVariableMapping(&oPtr->classPtr->variables, varc, varv);
for (i=0 ; i<varc ; i++) {
Tcl_IncrRefCount(varv[i]);
}
FOREACH(variableObj, oPtr->classPtr->variables) {
Tcl_DecrRefCount(variableObj);
}
if (i != varc) {
if (varc == 0) {
ckfree(oPtr->classPtr->variables.list);
} else if (i) {
oPtr->classPtr->variables.list = (Tcl_Obj **)
ckrealloc((char *) oPtr->classPtr->variables.list,
sizeof(Tcl_Obj *) * varc);
} else {
oPtr->classPtr->variables.list = (Tcl_Obj **)
ckalloc(sizeof(Tcl_Obj *) * varc);
}
}
oPtr->classPtr->variables.num = 0;
if (varc > 0) {
int created, n;
Tcl_HashTable uniqueTable;
Tcl_InitObjHashTable(&uniqueTable);
for (i=n=0 ; i<varc ; i++) {
Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
if (created) {
oPtr->classPtr->variables.list[n++] = varv[i];
} else {
Tcl_DecrRefCount(varv[i]);
}
}
oPtr->classPtr->variables.num = n;
/*
* Shouldn't be necessary, but maintain num/list invariant.
*/
oPtr->classPtr->variables.list = (Tcl_Obj **)
ckrealloc((char *) oPtr->classPtr->variables.list,
sizeof(Tcl_Obj *) * n);
Tcl_DeleteHashTable(&uniqueTable);
}
return TCL_OK;
}
@@ -2796,7 +2585,7 @@ ObjVarsGet(
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
Tcl_Obj *resultObj;
Tcl_Obj *resultObj, *variableObj;
int i;
if (Tcl_ObjectContextSkippedArgs(context) != objc) {
@@ -2808,18 +2597,8 @@ ObjVarsGet(
}
resultObj = Tcl_NewObj();
if (IsPrivateDefine(interp)) {
PrivateVariableMapping *privatePtr;
FOREACH_STRUCT(privatePtr, oPtr->privateVariables) {
Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
}
} else {
Tcl_Obj *variableObj;
FOREACH(variableObj, oPtr->variables) {
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
}
FOREACH(variableObj, oPtr->variables) {
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
}
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
@@ -2835,7 +2614,7 @@ ObjVarsSet(
{
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
int varc, i;
Tcl_Obj **varv;
Tcl_Obj **varv, *variableObj;
if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
@@ -2868,12 +2647,49 @@ ObjVarsSet(
return TCL_ERROR;
}
}
for (i=0 ; i<varc ; i++) {
Tcl_IncrRefCount(varv[i]);
}
if (IsPrivateDefine(interp)) {
InstallPrivateVariableMapping(&oPtr->privateVariables, varc, varv,
oPtr->creationEpoch);
} else {
InstallStandardVariableMapping(&oPtr->variables, varc, varv);
FOREACH(variableObj, oPtr->variables) {
Tcl_DecrRefCount(variableObj);
}
if (i != varc) {
if (varc == 0) {
ckfree(oPtr->variables.list);
} else if (i) {
oPtr->variables.list = (Tcl_Obj **)
ckrealloc((char *) oPtr->variables.list,
sizeof(Tcl_Obj *) * varc);
} else {
oPtr->variables.list = (Tcl_Obj **)
ckalloc(sizeof(Tcl_Obj *) * varc);
}
}
oPtr->variables.num = 0;
if (varc > 0) {
int created, n;
Tcl_HashTable uniqueTable;
Tcl_InitObjHashTable(&uniqueTable);
for (i=n=0 ; i<varc ; i++) {
Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
if (created) {
oPtr->variables.list[n++] = varv[i];
} else {
Tcl_DecrRefCount(varv[i]);
}
}
oPtr->variables.num = n;
/*
* Shouldn't be necessary, but maintain num/list invariant.
*/
oPtr->variables.list = (Tcl_Obj **)
ckrealloc((char *) oPtr->variables.list,
sizeof(Tcl_Obj *) * n);
Tcl_DeleteHashTable(&uniqueTable);
}
return TCL_OK;
}
+27 -165
View File
@@ -22,7 +22,6 @@ static Tcl_ObjCmdProc InfoObjectClassCmd;
static Tcl_ObjCmdProc InfoObjectDefnCmd;
static Tcl_ObjCmdProc InfoObjectFiltersCmd;
static Tcl_ObjCmdProc InfoObjectForwardCmd;
static Tcl_ObjCmdProc InfoObjectIdCmd;
static Tcl_ObjCmdProc InfoObjectIsACmd;
static Tcl_ObjCmdProc InfoObjectMethodsCmd;
static Tcl_ObjCmdProc InfoObjectMethodTypeCmd;
@@ -51,7 +50,6 @@ static Tcl_ObjCmdProc InfoClassVariablesCmd;
static const EnsembleImplMap infoObjectCmds[] = {
{"call", InfoObjectCallCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"class", InfoObjectClassCmd, TclCompileInfoObjectClassCmd, NULL, NULL, 0},
{"creationid", InfoObjectIdCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"definition", InfoObjectDefnCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"filters", InfoObjectFiltersCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"forward", InfoObjectForwardCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
@@ -60,7 +58,7 @@ static const EnsembleImplMap infoObjectCmds[] = {
{"methodtype", InfoObjectMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"mixins", InfoObjectMixinsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"namespace", InfoObjectNsCmd, TclCompileInfoObjectNamespaceCmd, NULL, NULL, 0},
{"variables", InfoObjectVariablesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
{"variables", InfoObjectVariablesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"vars", InfoObjectVarsCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
{NULL, NULL, NULL, NULL, NULL, 0}
};
@@ -82,7 +80,7 @@ static const EnsembleImplMap infoClassCmds[] = {
{"mixins", InfoClassMixinsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"subclasses", InfoClassSubsCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
{"superclasses", InfoClassSupersCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"variables", InfoClassVariablesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
{"variables", InfoClassVariablesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{NULL, NULL, NULL, NULL, NULL, 0}
};
@@ -519,22 +517,15 @@ InfoObjectMethodsCmd(
Tcl_Obj *const objv[])
{
Object *oPtr;
int flag = PUBLIC_METHOD, recurse = 0, scope = -1;
int flag = PUBLIC_METHOD, recurse = 0;
FOREACH_HASH_DECLS;
Tcl_Obj *namePtr, *resultObj;
Method *mPtr;
static const char *const options[] = {
"-all", "-localprivate", "-private", "-scope", NULL
"-all", "-localprivate", "-private", NULL
};
enum Options {
OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE, OPT_SCOPE
};
static const char *const scopes[] = {
"private", "public", "unexported"
};
enum Scopes {
SCOPE_PRIVATE, SCOPE_PUBLIC, SCOPE_UNEXPORTED,
SCOPE_LOCALPRIVATE
OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE
};
if (objc < 2) {
@@ -563,45 +554,14 @@ InfoObjectMethodsCmd(
case OPT_PRIVATE:
flag = 0;
break;
case OPT_SCOPE:
if (++i >= objc) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"missing option for -scope"));
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING",
NULL);
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[i], scopes, "scope", 0,
&scope) != TCL_OK) {
return TCL_ERROR;
}
break;
}
}
}
if (scope != -1) {
recurse = 0;
switch (scope) {
case SCOPE_PRIVATE:
flag = TRUE_PRIVATE_METHOD;
break;
case SCOPE_PUBLIC:
flag = PUBLIC_METHOD;
break;
case SCOPE_LOCALPRIVATE:
flag = PRIVATE_METHOD;
break;
case SCOPE_UNEXPORTED:
flag = 0;
break;
}
}
resultObj = Tcl_NewObj();
if (recurse) {
const char **names;
int i, numNames = TclOOGetSortedMethodList(oPtr, NULL, NULL, flag,
&names);
int i, numNames = TclOOGetSortedMethodList(oPtr, flag, &names);
for (i=0 ; i<numNames ; i++) {
Tcl_ListObjAppendElement(NULL, resultObj,
@@ -612,7 +572,7 @@ InfoObjectMethodsCmd(
}
} else if (oPtr->methodsPtr) {
FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) {
if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) {
Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
}
}
@@ -721,38 +681,6 @@ InfoObjectMixinsCmd(
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* InfoObjectIdCmd --
*
* Implements [info object creationid $objName]
*
* ----------------------------------------------------------------------
*/
static int
InfoObjectIdCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Object *oPtr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "objName");
return TCL_ERROR;
}
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
if (oPtr == NULL) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(oPtr->creationEpoch));
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
@@ -791,7 +719,7 @@ InfoObjectNsCmd(
*
* InfoObjectVariablesCmd --
*
* Implements [info object variables $objName ?-private?]
* Implements [info object variables $objName]
*
* ----------------------------------------------------------------------
*/
@@ -804,37 +732,21 @@ InfoObjectVariablesCmd(
Tcl_Obj *const objv[])
{
Object *oPtr;
Tcl_Obj *resultObj;
int i, private = 0;
Tcl_Obj *variableObj, *resultObj;
int i;
if (objc != 2 && objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "objName ?-private?");
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "objName");
return TCL_ERROR;
}
if (objc == 3) {
if (strcmp("-private", Tcl_GetString(objv[2])) != 0) {
return TCL_ERROR;
}
private = 1;
}
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
if (oPtr == NULL) {
return TCL_ERROR;
}
resultObj = Tcl_NewObj();
if (private) {
PrivateVariableMapping *privatePtr;
FOREACH_STRUCT(privatePtr, oPtr->privateVariables) {
Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
}
} else {
Tcl_Obj *variableObj;
FOREACH(variableObj, oPtr->variables) {
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
}
FOREACH(variableObj, oPtr->variables) {
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
}
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
@@ -1216,7 +1128,7 @@ InfoClassInstancesCmd(
*
* InfoClassMethodsCmd --
*
* Implements [info class methods $clsName ?options...?]
* Implements [info class methods $clsName ?-private?]
*
* ----------------------------------------------------------------------
*/
@@ -1228,21 +1140,15 @@ InfoClassMethodsCmd(
int objc,
Tcl_Obj *const objv[])
{
int flag = PUBLIC_METHOD, recurse = 0, scope = -1;
int flag = PUBLIC_METHOD, recurse = 0;
Tcl_Obj *namePtr, *resultObj;
Method *mPtr;
Class *clsPtr;
static const char *const options[] = {
"-all", "-localprivate", "-private", "-scope", NULL
"-all", "-localprivate", "-private", NULL
};
enum Options {
OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE, OPT_SCOPE
};
static const char *const scopes[] = {
"private", "public", "unexported"
};
enum Scopes {
SCOPE_PRIVATE, SCOPE_PUBLIC, SCOPE_UNEXPORTED
OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE
};
if (objc < 2) {
@@ -1271,36 +1177,9 @@ InfoClassMethodsCmd(
case OPT_PRIVATE:
flag = 0;
break;
case OPT_SCOPE:
if (++i >= objc) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"missing option for -scope"));
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING",
NULL);
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[i], scopes, "scope", 0,
&scope) != TCL_OK) {
return TCL_ERROR;
}
break;
}
}
}
if (scope != -1) {
recurse = 0;
switch (scope) {
case SCOPE_PRIVATE:
flag = TRUE_PRIVATE_METHOD;
break;
case SCOPE_PUBLIC:
flag = PUBLIC_METHOD;
break;
case SCOPE_UNEXPORTED:
flag = 0;
break;
}
}
resultObj = Tcl_NewObj();
if (recurse) {
@@ -1318,7 +1197,7 @@ InfoClassMethodsCmd(
FOREACH_HASH_DECLS;
FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) {
if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) {
Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
}
}
@@ -1520,7 +1399,7 @@ InfoClassSupersCmd(
*
* InfoClassVariablesCmd --
*
* Implements [info class variables $clsName ?-private?]
* Implements [info class variables $clsName]
*
* ----------------------------------------------------------------------
*/
@@ -1533,37 +1412,21 @@ InfoClassVariablesCmd(
Tcl_Obj *const objv[])
{
Class *clsPtr;
Tcl_Obj *resultObj;
int i, private = 0;
Tcl_Obj *variableObj, *resultObj;
int i;
if (objc != 2 && objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "className ?-private?");
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "className");
return TCL_ERROR;
}
if (objc == 3) {
if (strcmp("-private", Tcl_GetString(objv[2])) != 0) {
return TCL_ERROR;
}
private = 1;
}
clsPtr = GetClassFromObj(interp, objv[1]);
if (clsPtr == NULL) {
return TCL_ERROR;
}
resultObj = Tcl_NewObj();
if (private) {
PrivateVariableMapping *privatePtr;
FOREACH_STRUCT(privatePtr, clsPtr->privateVariables) {
Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
}
} else {
Tcl_Obj *variableObj;
FOREACH(variableObj, clsPtr->variables) {
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
}
FOREACH(variableObj, clsPtr->variables) {
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
}
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
@@ -1602,8 +1465,7 @@ InfoObjectCallCmd(
* Get the call context and render its call chain.
*/
contextPtr = TclOOGetCallContext(oPtr, objv[2], PUBLIC_METHOD, NULL, NULL,
NULL);
contextPtr = TclOOGetCallContext(oPtr, objv[2], PUBLIC_METHOD, NULL);
if (contextPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"cannot construct any call chain", -1));
+4 -54
View File
@@ -124,18 +124,6 @@ typedef struct ForwardMethod {
* non-empty list. */
} ForwardMethod;
/*
* Structure used in private variable mappings. Describes the mapping of a
* single variable from the user's local name to the system's storage name.
* [TIP #500]
*/
typedef struct {
Tcl_Obj *variableObj; /* Name used within methods. This is the part
* that is properly under user control. */
Tcl_Obj *fullNameObj; /* Name used at the instance namespace level. */
} PrivateVariableMapping;
/*
* Helper definitions that declare a "list" array. The two varieties are
* either optimized for simplicity (in the case that the whole array is
@@ -153,13 +141,6 @@ typedef struct {
#define LIST_DYNAMIC(listType_t) \
struct { int num, size; listType_t *list; }
/*
* These types are needed in function arguments.
*/
typedef LIST_STATIC(Tcl_Obj *) VariableNameList;
typedef LIST_STATIC(PrivateVariableMapping) PrivateVariableList;
/*
* Now, the definition of what an object actually is.
*/
@@ -205,10 +186,7 @@ typedef struct Object {
Tcl_ObjectMapMethodNameProc *mapMethodNameProc;
/* Function to allow remapping of method
* names. For itcl-ng. */
VariableNameList variables;
PrivateVariableList privateVariables;
/* Configurations for the variable resolver
* used inside methods. */
LIST_STATIC(Tcl_Obj *) variables;
} Object;
#define OBJECT_DELETED 1 /* Flag to say that an object has been
@@ -236,10 +214,6 @@ typedef struct Object {
* other spots). */
#define FORCE_UNKNOWN 0x10000 /* States that we are *really* looking up the
* unknown method handler at that point. */
#define HAS_PRIVATE_METHODS 0x20000
/* Object/class has (or had) private methods,
* and so shouldn't be cached so
* aggressively. */
/*
* And the definition of a class. Note that every class also has an associated
@@ -294,10 +268,7 @@ typedef struct Class {
* object doesn't override with its own mixins
* (and filters and method implementations for
* when getting method chains). */
VariableNameList variables;
PrivateVariableList privateVariables;
/* Configurations for the variable resolver
* used inside methods. */
LIST_STATIC(Tcl_Obj *) variables;
} Class;
/*
@@ -399,15 +370,10 @@ typedef struct CallContext {
#define PUBLIC_METHOD 0x01 /* This is a public (exported) method. */
#define PRIVATE_METHOD 0x02 /* This is a private (class's direct instances
* only) method. Supports itcl. */
* only) method. */
#define OO_UNKNOWN_METHOD 0x04 /* This is an unknown method. */
#define CONSTRUCTOR 0x08 /* This is a constructor. */
#define DESTRUCTOR 0x10 /* This is a destructor. */
#define TRUE_PRIVATE_METHOD 0x20
/* This is a private method only accessible
* from other methods defined on this class
* or instance. [TIP #500] */
#define SCOPE_FLAGS (PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD)
/*
* Structure containing definition information about basic class methods.
@@ -465,9 +431,6 @@ MODULE_SCOPE int TclOODefineSelfObjCmd(ClientData clientData,
MODULE_SCOPE int TclOODefineObjSelfObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
MODULE_SCOPE int TclOODefinePrivateObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
MODULE_SCOPE int TclOOUnknownDefinition(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
@@ -541,7 +504,6 @@ MODULE_SCOPE void TclOODeleteContext(CallContext *contextPtr);
MODULE_SCOPE void TclOODelMethodRef(Method *method);
MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
Tcl_Obj *methodNameObj, int flags,
Object *contextObjPtr, Class *contextClsPtr,
Tcl_Obj *cacheInThisObj);
MODULE_SCOPE CallChain *TclOOGetStereotypeCallChain(Class *clsPtr,
Tcl_Obj *methodNameObj, int flags);
@@ -551,8 +513,7 @@ MODULE_SCOPE Proc * TclOOGetProcFromMethod(Method *mPtr);
MODULE_SCOPE Tcl_Obj * TclOOGetMethodBody(Method *mPtr);
MODULE_SCOPE int TclOOGetSortedClassMethodList(Class *clsPtr,
int flags, const char ***stringsPtr);
MODULE_SCOPE int TclOOGetSortedMethodList(Object *oPtr,
Object *contextObj, Class *contextCls, int flags,
MODULE_SCOPE int TclOOGetSortedMethodList(Object *oPtr, int flags,
const char ***stringsPtr);
MODULE_SCOPE int TclOOInit(Tcl_Interp *interp);
MODULE_SCOPE void TclOOInitInfo(Tcl_Interp *interp);
@@ -599,22 +560,11 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);
continue; \
} else if (var = (ary).list[i], 1)
/*
* A variation where the array is an array of structs. There's no issue with
* possible NULLs; every element of the array will be iterated over and the
* varable set to a pointer to each of those elements in turn.
* REQUIRES DECLARATION: int i;
*/
#define FOREACH_STRUCT(var,ary) \
for(i=0 ; var=&((ary).list[i]), i<(ary).num; i++)
/*
* Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS
* sets up the declarations needed for the main macro, FOREACH_HASH, which
* does the actual iteration. FOREACH_HASH_VALUE is a restricted version that
* only iterates over values.
* REQUIRES DECLARATION: FOREACH_HASH_DECLS;
*/
#define FOREACH_HASH_DECLS \
+3 -36
View File
@@ -186,11 +186,7 @@ Tcl_NewInstanceMethod(
mPtr->declaringObjectPtr = oPtr;
mPtr->declaringClassPtr = NULL;
if (flags) {
mPtr->flags |= flags &
(PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD);
if (flags & TRUE_PRIVATE_METHOD) {
oPtr->flags |= HAS_PRIVATE_METHODS;
}
mPtr->flags |= flags & (PUBLIC_METHOD | PRIVATE_METHOD);
}
oPtr->epoch++;
return (Tcl_Method) mPtr;
@@ -254,11 +250,7 @@ Tcl_NewMethod(
mPtr->declaringObjectPtr = NULL;
mPtr->declaringClassPtr = clsPtr;
if (flags) {
mPtr->flags |= flags &
(PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD);
if (flags & TRUE_PRIVATE_METHOD) {
clsPtr->flags |= HAS_PRIVATE_METHODS;
}
mPtr->flags |= flags & (PUBLIC_METHOD | PRIVATE_METHOD);
}
return (Tcl_Method) mPtr;
@@ -936,7 +928,7 @@ PushMethodCallFrame(
* variables used in methods. The compiled variable resolver is more
* important, but both are needed as it is possible to have a variable
* that is only referred to in ways that aren't compilable and we can't
* force LVT presence. [TIP #320, #500]
* force LVT presence. [TIP #320]
*
* ----------------------------------------------------------------------
*/
@@ -994,7 +986,6 @@ ProcedureMethodCompiledVarConnect(
CallFrame *framePtr = iPtr->varFramePtr;
CallContext *contextPtr;
Tcl_Obj *variableObj;
PrivateVariableMapping *privateVar;
Tcl_HashEntry *hPtr;
int i, isNew, cacheIt, varLen, len;
const char *match, *varName;
@@ -1028,15 +1019,6 @@ ProcedureMethodCompiledVarConnect(
varName = TclGetStringFromObj(infoPtr->variableObj, &varLen);
if (contextPtr->callPtr->chain[contextPtr->index]
.mPtr->declaringClassPtr != NULL) {
FOREACH_STRUCT(privateVar, contextPtr->callPtr->chain[contextPtr->index]
.mPtr->declaringClassPtr->privateVariables) {
match = TclGetStringFromObj(privateVar->variableObj, &len);
if ((len == varLen) && !memcmp(match, varName, len)) {
variableObj = privateVar->fullNameObj;
cacheIt = 0;
goto gotMatch;
}
}
FOREACH(variableObj, contextPtr->callPtr->chain[contextPtr->index]
.mPtr->declaringClassPtr->variables) {
match = TclGetStringFromObj(variableObj, &len);
@@ -1046,14 +1028,6 @@ ProcedureMethodCompiledVarConnect(
}
}
} else {
FOREACH_STRUCT(privateVar, contextPtr->oPtr->privateVariables) {
match = TclGetStringFromObj(privateVar->variableObj, &len);
if ((len == varLen) && !memcmp(match, varName, len)) {
variableObj = privateVar->fullNameObj;
cacheIt = 1;
goto gotMatch;
}
}
FOREACH(variableObj, contextPtr->oPtr->variables) {
match = TclGetStringFromObj(variableObj, &len);
if ((len == varLen) && !memcmp(match, varName, len)) {
@@ -1699,13 +1673,6 @@ Tcl_MethodIsPublic(
{
return (((Method *)method)->flags & PUBLIC_METHOD) ? 1 : 0;
}
int
Tcl_MethodIsPrivate(
Tcl_Method method)
{
return (((Method *)method)->flags & TRUE_PRIVATE_METHOD) ? 1 : 0;
}
/*
* Extended method construction for itcl-ng.
-1
View File
@@ -73,7 +73,6 @@ const TclOOStubs tclOOStubs = {
Tcl_ClassSetConstructor, /* 26 */
Tcl_ClassSetDestructor, /* 27 */
Tcl_GetObjectName, /* 28 */
Tcl_MethodIsPrivate, /* 29 */
};
/* !END!: Do not edit above this line. */
+37 -474
View File
@@ -37,7 +37,7 @@ Tcl_Obj *tclFreeObjList = NULL;
* TclNewObj macro, however, so must be visible.
*/
#if TCL_THREADS
#ifdef TCL_THREADS
MODULE_SCOPE Tcl_Mutex tclObjMutex;
Tcl_Mutex tclObjMutex;
#endif
@@ -50,14 +50,14 @@ Tcl_Mutex tclObjMutex;
char tclEmptyString = '\0';
#if TCL_THREADS && defined(TCL_MEM_DEBUG)
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
/*
* Structure for tracking the source file and line number where a given
* Tcl_Obj was allocated. We also track the pointer to the Tcl_Obj itself,
* for sanity checking purposes.
*/
typedef struct ObjData {
typedef struct {
Tcl_Obj *objPtr; /* The pointer to the allocated Tcl_Obj. */
const char *file; /* The name of the source file calling this
* function; used for debugging. */
@@ -87,7 +87,7 @@ typedef struct {
* tclCompile.h for the definition of this
* structure, and for references to all
* related places in the core. */
#if TCL_THREADS && defined(TCL_MEM_DEBUG)
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
Tcl_HashTable *objThreadMap;/* Thread local table that is used to check
* that a Tcl_Obj was not allocated by some
* other thread. */
@@ -156,7 +156,7 @@ typedef struct PendingObjData {
/*
* Macro to set up the local reference to the deletion context.
*/
#if !TCL_THREADS
#ifndef TCL_THREADS
static PendingObjData pendingObjData;
#define ObjInitDeletionContext(contextPtr) \
PendingObjData *const contextPtr = &pendingObjData
@@ -210,9 +210,6 @@ static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void UpdateStringOfDouble(Tcl_Obj *objPtr);
static void UpdateStringOfInt(Tcl_Obj *objPtr);
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
static void UpdateStringOfOldInt(Tcl_Obj *objPtr);
#endif
static void FreeBignum(Tcl_Obj *objPtr);
static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static void UpdateStringOfBignum(Tcl_Obj *objPtr);
@@ -241,17 +238,8 @@ static int SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
* implementations.
*/
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
static const Tcl_ObjType oldBooleanType = {
"boolean", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
TclSetBooleanFromAny /* setFromAnyProc */
};
#endif
const Tcl_ObjType tclBooleanType = {
"booleanString", /* name */
"boolean", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
@@ -265,25 +253,12 @@ const Tcl_ObjType tclDoubleType = {
SetDoubleFromAny /* setFromAnyProc */
};
const Tcl_ObjType tclIntType = {
#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 || defined(TCL_WIDE_INT_IS_LONG)
"int", /* name */
#else
"wideInt", /* name, keeping maximum compatibility with Tcl 8.6 on 32-bit platforms*/
#endif
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfInt, /* updateStringProc */
SetIntFromAny /* setFromAnyProc */
};
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
static const Tcl_ObjType oldIntType = {
"int", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfOldInt, /* updateStringProc */
SetIntFromAny /* setFromAnyProc */
};
#endif
const Tcl_ObjType tclBignumType = {
"bignum", /* name */
FreeBignum, /* freeIntRepProc */
@@ -349,17 +324,17 @@ typedef struct ResolvedCmdName {
* reference (not the namespace that contains
* the referenced command). NULL if the name
* is fully qualified.*/
unsigned long refNsId; /* refNsPtr's unique namespace id. Used to
size_t refNsId; /* refNsPtr's unique namespace id. Used to
* verify that refNsPtr is still valid (e.g.,
* it's possible that the cmd's containing
* namespace was deleted and a new one created
* at the same address). */
unsigned int refNsCmdEpoch; /* Value of the referencing namespace's
size_t refNsCmdEpoch; /* Value of the referencing namespace's
* cmdRefEpoch when the pointer was cached.
* Before using the cached pointer, we check
* if the namespace's epoch was incremented;
* if so, this cached pointer is invalid. */
unsigned int cmdEpoch; /* Value of the command's cmdEpoch when this
size_t cmdEpoch; /* Value of the command's cmdEpoch when this
* pointer was cached. Before using the cached
* pointer, we check if the cmd's epoch was
* incremented; if so, the cmd was renamed,
@@ -408,15 +383,6 @@ TclInitObjSubsystem(void)
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;
@@ -452,7 +418,7 @@ TclInitObjSubsystem(void)
void
TclFinalizeThreadObjects(void)
{
#if TCL_THREADS && defined(TCL_MEM_DEBUG)
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
Tcl_HashEntry *hPtr;
Tcl_HashSearch hSearch;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -1009,7 +975,7 @@ void
TclDbDumpActiveObjects(
FILE *outFile)
{
#if TCL_THREADS && defined(TCL_MEM_DEBUG)
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
Tcl_HashSearch hSearch;
Tcl_HashEntry *hPtr;
Tcl_HashTable *tablePtr;
@@ -1069,7 +1035,7 @@ TclDbInitNewObj(
objPtr->length = 0;
objPtr->typePtr = NULL;
#if TCL_THREADS
#ifdef TCL_THREADS
/*
* Add entry to a thread local map used to check if a Tcl_Obj was
* allocated by the currently executing thread.
@@ -1305,7 +1271,7 @@ TclFreeObj(
ObjInitDeletionContext(context);
#if TCL_THREADS
# ifdef TCL_THREADS
/*
* Check to make sure that the Tcl_Obj was allocated by the current
* thread. Don't do this check when shutting down since thread local
@@ -1727,146 +1693,6 @@ Tcl_InvalidateStringRep(
TclInvalidateStringRep(objPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_NewBooleanObj --
*
* This function is normally called when not debugging: i.e., when
* TCL_MEM_DEBUG is not defined. It creates a new Tcl_Obj and
* initializes it from the argument boolean value. A nonzero "boolValue"
* is coerced to 1.
*
* When TCL_MEM_DEBUG is defined, this function just returns the result
* of calling the debugging version Tcl_DbNewLongObj.
*
* Results:
* The newly created object is returned. This object will have an invalid
* string representation. The returned object has ref count 0.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
#undef Tcl_NewBooleanObj
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_NewBooleanObj(
register int boolValue) /* Boolean used to initialize new object. */
{
return Tcl_DbNewLongObj(boolValue!=0, "unknown", 0);
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_NewBooleanObj(
register int boolValue) /* Boolean used to initialize new object. */
{
register Tcl_Obj *objPtr;
TclNewIntObj(objPtr, boolValue!=0);
return objPtr;
}
#endif /* TCL_MEM_DEBUG */
/*
*----------------------------------------------------------------------
*
* Tcl_DbNewBooleanObj --
*
* This function is normally called when debugging: i.e., when
* TCL_MEM_DEBUG is defined. It creates new boolean objects. It is the
* same as the Tcl_NewBooleanObj function above except that it calls
* Tcl_DbCkalloc directly with the file name and line number from its
* caller. This simplifies debugging since then the [memory active]
* command will report the correct file name and line number when
* reporting objects that haven't been freed.
*
* When TCL_MEM_DEBUG is not defined, this function just returns the
* result of calling Tcl_NewBooleanObj.
*
* Results:
* The newly created object is returned. This object will have an invalid
* string representation. The returned object has ref count 0.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
#ifndef TCL_NO_DEPRECATED
#undef Tcl_DbNewBooleanObj
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_DbNewBooleanObj(
register int boolValue, /* Boolean used to initialize new object. */
const char *file, /* The name of the source file calling this
* function; used for debugging. */
int line) /* Line number in the source file; used for
* debugging. */
{
register Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
objPtr->bytes = NULL;
objPtr->internalRep.wideValue = (boolValue != 0);
objPtr->typePtr = &tclIntType;
return objPtr;
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_DbNewBooleanObj(
register int boolValue, /* Boolean used to initialize new object. */
const char *file, /* The name of the source file calling this
* function; used for debugging. */
int line) /* Line number in the source file; used for
* debugging. */
{
return Tcl_NewBooleanObj(boolValue);
}
#endif /* TCL_MEM_DEBUG */
/*
*----------------------------------------------------------------------
*
* Tcl_SetBooleanObj --
*
* Modify an object to be a boolean object and to have the specified
* boolean value. A nonzero "boolValue" is coerced to 1.
*
* Results:
* None.
*
* Side effects:
* The object's old string rep, if any, is freed. Also, any old internal
* rep is freed.
*
*----------------------------------------------------------------------
*/
#undef Tcl_SetBooleanObj
void
Tcl_SetBooleanObj(
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
register int boolValue) /* Boolean used to set object's value. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj");
}
TclSetIntObj(objPtr, boolValue!=0);
}
#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
*
@@ -1893,14 +1719,10 @@ Tcl_GetBooleanFromObj(
register int *boolPtr) /* Place to store resulting boolean. */
{
do {
if (objPtr->typePtr == &tclIntType) {
if (objPtr->typePtr == &tclIntType || objPtr->typePtr == &tclBooleanType) {
*boolPtr = (objPtr->internalRep.wideValue != 0);
return TCL_OK;
}
if (objPtr->typePtr == &tclBooleanType) {
*boolPtr = objPtr->internalRep.longValue != 0;
return TCL_OK;
}
if (objPtr->typePtr == &tclDoubleType) {
/*
* Caution: Don't be tempted to check directly for the "double"
@@ -1942,12 +1764,7 @@ Tcl_GetBooleanFromObj(
*
* Side effects:
* If no error occurs, an integer 1 or 0 is stored as "objPtr"s internal
* representation and the type of "objPtr" is set to boolean or int/wideInt.
*
* Warning: If the returned type is "wideInt" (32-bit platforms) and your
* platform is bigendian, you cannot use internalRep.longValue to distinguish
* between false and true. On Windows and most other platforms this still will
* work fine, but basically it is non-portable.
* representation and the type of "objPtr" is set to boolean or int.
*
*----------------------------------------------------------------------
*/
@@ -2105,7 +1922,7 @@ ParseBoolean(
goodBoolean:
TclFreeIntRep(objPtr);
objPtr->internalRep.longValue = newBool;
objPtr->internalRep.wideValue = newBool;
objPtr->typePtr = &tclBooleanType;
return TCL_OK;
@@ -2341,8 +2158,7 @@ SetDoubleFromAny(
* UpdateStringOfDouble --
*
* Update the string representation for a double-precision floating point
* object. This must obey the current tcl_precision value for
* double-to-string conversions. Note: This function does not free an
* object. Note: This function does not free an
* existing old string rep so storage will be lost if this has not
* already been done.
*
@@ -2371,112 +2187,31 @@ UpdateStringOfDouble(
objPtr->length = len;
}
/*
*----------------------------------------------------------------------
*
* Tcl_NewIntObj --
*
* If a client is compiled with TCL_MEM_DEBUG defined, calls to
* Tcl_NewIntObj to create a new integer object end up calling the
* debugging function Tcl_DbNewLongObj instead.
*
* Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
* calls to Tcl_NewIntObj result in a call to one of the two
* Tcl_NewIntObj implementations below. We provide two implementations so
* that the Tcl core can be compiled to do memory debugging of the core
* even if a client does not request it for itself.
*
* Integer and long integer objects share the same "integer" type
* implementation. We store all integers as longs and Tcl_GetIntFromObj
* checks whether the current value of the long can be represented by an
* int.
*
* Results:
* The newly created object is returned. This object will have an invalid
* string representation. The returned object has ref count 0.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
#undef Tcl_NewIntObj
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_NewIntObj(
register int intValue) /* Int used to initialize the new object. */
{
return Tcl_DbNewLongObj((long)intValue, "unknown", 0);
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_NewIntObj(
register int intValue) /* Int used to initialize the new object. */
{
register Tcl_Obj *objPtr;
TclNewIntObj(objPtr, intValue);
return objPtr;
}
#endif /* if TCL_MEM_DEBUG */
/*
*----------------------------------------------------------------------
*
* Tcl_SetIntObj --
*
* Modify an object to be an integer and to have the specified integer
* value.
*
* Results:
* None.
*
* Side effects:
* The object's old string rep, if any, is freed. Also, any old internal
* rep is freed.
*
*----------------------------------------------------------------------
*/
#undef Tcl_SetIntObj
void
Tcl_SetIntObj(
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
register int intValue) /* Integer used to set object's value. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetIntObj");
}
TclSetIntObj(objPtr, intValue);
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetIntFromObj --
*
* Attempt to return an int from the Tcl object "objPtr". If the object
* is not already an int, an attempt will be made to convert it to one.
* Retrieve the integer value of 'objPtr'.
*
* Integer and long integer objects share the same "integer" type
* implementation. We store all integers as longs and Tcl_GetIntFromObj
* checks whether the current value of the long can be represented by an
* int.
* Value
*
* Results:
* The return value is a standard Tcl object result. If an error occurs
* during conversion or if the long integer held by the object can not be
* represented by an int, an error message is left in the interpreter's
* result unless "interp" is NULL.
* TCL_OK
*
* Side effects:
* If the object is not already an int, the conversion will free any old
* internal representation.
* Success.
*
* TCL_ERROR
*
* An error occurred during conversion or the integral value can not
* be represented as an integer (it might be too large). An error
* message is left in the interpreter's result if 'interp' is not
* NULL.
*
* Effect
*
* 'objPtr' is converted to an integer if necessary if it is not one
* already. The conversion frees any previously-existing internal
* representation.
*
*----------------------------------------------------------------------
*/
@@ -2566,178 +2301,6 @@ UpdateStringOfInt(
memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
objPtr->length = len;
}
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
static void
UpdateStringOfOldInt(
register Tcl_Obj *objPtr) /* Int object whose string rep to update. */
{
char buffer[TCL_INTEGER_SPACE];
register int len;
len = TclFormatInt(buffer, objPtr->internalRep.longValue);
objPtr->bytes = ckalloc(len + 1);
memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
objPtr->length = len;
}
#endif
/*
*----------------------------------------------------------------------
*
* Tcl_NewLongObj --
*
* If a client is compiled with TCL_MEM_DEBUG defined, calls to
* Tcl_NewLongObj to create a new long integer object end up calling the
* debugging function Tcl_DbNewLongObj instead.
*
* Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
* calls to Tcl_NewLongObj result in a call to one of the two
* Tcl_NewLongObj implementations below. We provide two implementations
* so that the Tcl core can be compiled to do memory debugging of the
* core even if a client does not request it for itself.
*
* Integer and long integer objects share the same "integer" type
* implementation. We store all integers as longs and Tcl_GetIntFromObj
* checks whether the current value of the long can be represented by an
* int.
*
* Results:
* The newly created object is returned. This object will have an invalid
* string representation. The returned object has ref count 0.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
#undef Tcl_NewLongObj
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_NewLongObj(
register long longValue) /* Long integer used to initialize the
* new object. */
{
return Tcl_DbNewLongObj(longValue, "unknown", 0);
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_NewLongObj(
register long longValue) /* Long integer used to initialize the
* new object. */
{
register Tcl_Obj *objPtr;
TclNewIntObj(objPtr, longValue);
return objPtr;
}
#endif /* if TCL_MEM_DEBUG */
/*
*----------------------------------------------------------------------
*
* Tcl_DbNewLongObj --
*
* If a client is compiled with TCL_MEM_DEBUG defined, calls to
* Tcl_NewIntObj and Tcl_NewLongObj to create new integer or long integer
* objects end up calling the debugging function Tcl_DbNewLongObj
* instead. We provide two implementations of Tcl_DbNewLongObj so that
* whether the Tcl core is compiled to do memory debugging of the core is
* independent of whether a client requests debugging for itself.
*
* When the core is compiled with TCL_MEM_DEBUG defined, Tcl_DbNewLongObj
* calls Tcl_DbCkalloc directly with the file name and line number from
* its caller. This simplifies debugging since then the [memory active]
* command will report the caller's file name and line number when
* reporting objects that haven't been freed.
*
* Otherwise, when the core is compiled without TCL_MEM_DEBUG defined,
* this function just returns the result of calling Tcl_NewLongObj.
*
* Results:
* The newly created long integer object is returned. This object will
* have an invalid string representation. The returned object has ref
* count 0.
*
* Side effects:
* Allocates memory.
*
*----------------------------------------------------------------------
*/
#undef Tcl_DbNewLongObj
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_DbNewLongObj(
register long longValue, /* Long integer used to initialize the new
* object. */
const char *file, /* The name of the source file calling this
* function; used for debugging. */
int line) /* Line number in the source file; used for
* debugging. */
{
register Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
objPtr->bytes = NULL;
objPtr->internalRep.wideValue = longValue;
objPtr->typePtr = &tclIntType;
return objPtr;
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_DbNewLongObj(
register long longValue, /* Long integer used to initialize the new
* object. */
const char *file, /* The name of the source file calling this
* function; used for debugging. */
int line) /* Line number in the source file; used for
* debugging. */
{
return Tcl_NewLongObj(longValue);
}
#endif /* TCL_MEM_DEBUG */
/*
*----------------------------------------------------------------------
*
* Tcl_SetLongObj --
*
* Modify an object to be an integer object and to have the specified
* long integer value.
*
* Results:
* None.
*
* Side effects:
* The object's old string rep, if any, is freed. Also, any old internal
* rep is freed.
*
*----------------------------------------------------------------------
*/
#undef Tcl_SetLongObj
void
Tcl_SetLongObj(
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
register long longValue) /* Long integer used to initialize the
* object's value. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetLongObj");
}
TclSetIntObj(objPtr, longValue);
}
/*
*----------------------------------------------------------------------
@@ -3598,7 +3161,7 @@ Tcl_DbIncrRefCount(
Tcl_Panic("incrementing refCount of previously disposed object");
}
#if TCL_THREADS
# ifdef TCL_THREADS
/*
* Check to make sure that the Tcl_Obj was allocated by the current
* thread. Don't do this check when shutting down since thread local
@@ -3661,7 +3224,7 @@ Tcl_DbDecrRefCount(
Tcl_Panic("decrementing refCount of previously disposed object");
}
#if TCL_THREADS
# ifdef TCL_THREADS
/*
* Check to make sure that the Tcl_Obj was allocated by the current
* thread. Don't do this check when shutting down since thread local
@@ -3726,7 +3289,7 @@ Tcl_DbIsShared(
Tcl_Panic("checking whether previously disposed object is shared");
}
#if TCL_THREADS
# ifdef TCL_THREADS
/*
* Check to make sure that the Tcl_Obj was allocated by the current
* thread. Don't do this check when shutting down since thread local
-2
View File
@@ -287,8 +287,6 @@ ConvertZeroEffectToNOP(
case INST_INCR_ARRAY_STK:
case INST_INCR_SCALAR_STK:
case INST_INCR_STK:
case INST_LOR:
case INST_LAND:
case INST_EQ:
case INST_NEQ:
case INST_LT:
+17 -44
View File
@@ -23,8 +23,8 @@
* procedure.
*/
#if defined(__CYGWIN__) || (defined(_WIN32) && (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8))
static TCL_NORETURN1 Tcl_PanicProc *panicProc = tclWinDebugPanic;
#if defined(__CYGWIN__)
static TCL_NORETURN Tcl_PanicProc *panicProc = tclWinDebugPanic;
#else
static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL;
#endif
@@ -45,7 +45,6 @@ static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL;
*----------------------------------------------------------------------
*/
#undef Tcl_SetPanicProc
void
Tcl_SetPanicProc(
TCL_NORETURN1 Tcl_PanicProc *proc)
@@ -64,7 +63,7 @@ Tcl_SetPanicProc(
/*
*----------------------------------------------------------------------
*
* Tcl_PanicVA --
* Tcl_Panic --
*
* Print an error message and kill the process.
*
@@ -77,16 +76,25 @@ Tcl_SetPanicProc(
*----------------------------------------------------------------------
*/
/* ARGSUSED */
/*
* The following comment is here so that Coverity's static analizer knows that
* a Tcl_Panic() call can never return and avoids lots of false positives.
*/
/* coverity[+kill] */
void
Tcl_PanicVA(
const char *format, /* Format string, suitable for passing to
* fprintf. */
va_list argList) /* Variable argument list. */
Tcl_Panic(
const char *format,
...)
{
va_list argList;
char *arg1, *arg2, *arg3; /* Additional arguments (variable in number)
* to pass to fprintf. */
char *arg4, *arg5, *arg6, *arg7, *arg8;
va_start(argList, format);
arg1 = va_arg(argList, char *);
arg2 = va_arg(argList, char *);
arg3 = va_arg(argList, char *);
@@ -95,6 +103,7 @@ Tcl_PanicVA(
arg6 = va_arg(argList, char *);
arg7 = va_arg(argList, char *);
arg8 = va_arg(argList, char *);
va_end (argList);
if (panicProc != NULL) {
panicProc(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
@@ -126,42 +135,6 @@ Tcl_PanicVA(
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_Panic --
*
* Print an error message and kill the process.
*
* Results:
* None.
*
* Side effects:
* The process dies, entering the debugger if possible.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
/*
* The following comment is here so that Coverity's static analizer knows that
* a Tcl_Panic() call can never return and avoids lots of false positives.
*/
/* coverity[+kill] */
void
Tcl_Panic(
const char *format,
...)
{
va_list argList;
va_start(argList, format);
Tcl_PanicVA(format, argList);
va_end (argList);
}
/*
* Local Variables:
* mode: c
+2 -2
View File
@@ -72,7 +72,7 @@ static const Tcl_ObjType tclFsPathType = {
*
*/
typedef struct FsPath {
typedef struct {
Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. If this
* is NULL, then this is a pure normalized,
* absolute path object, in which the parent
@@ -91,7 +91,7 @@ typedef struct FsPath {
* below. */
ClientData nativePathPtr; /* Native representation of this path, which
* is filesystem dependent. */
int filesystemEpoch; /* Used to ensure the path representation was
size_t filesystemEpoch; /* Used to ensure the path representation was
* generated during the correct filesystem
* epoch. The epoch changes when
* filesystem-mounts are changed. */
+1 -1
View File
@@ -55,7 +55,7 @@ typedef struct PkgFiles {
* "Tk" (no version number).
*/
typedef struct Package {
typedef struct {
char *version; /* Version that has been supplied in this
* interpreter via "package provide"
* (malloc'ed). NULL means the package doesn't
+1 -1
View File
@@ -40,7 +40,7 @@
* configuration information.
*/
#if TCL_THREADS
#ifdef TCL_THREADS
# define CFG_THREADED "1"
#else
# define CFG_THREADED "0"
+1 -1
View File
@@ -53,7 +53,7 @@ TCL_DECLARE_MUTEX(preserveMutex)/* To protect the above statics */
* objects that we don't want to live any longer than necessary.
*/
typedef struct HandleStruct {
typedef struct {
void *ptr; /* Pointer to the memory block being tracked.
* This field will become NULL when the memory
* block is deleted. This field must be the
+1 -5
View File
@@ -1051,11 +1051,7 @@ ProcWrongNumArgs(
if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
} else {
#ifdef AVOID_HACKS_FOR_ITCL
desiredObjs[0] = framePtr->objv[skip-1];
#else
desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1);
#endif /* AVOID_HACKS_FOR_ITCL */
}
Tcl_IncrRefCount(desiredObjs[0]);
@@ -1314,7 +1310,7 @@ InitLocalCache(
*namePtr = NULL;
} else {
*namePtr = TclCreateLiteral(iPtr, localPtr->name,
localPtr->nameLength, /* hash */ (unsigned int) -1,
localPtr->nameLength, /* hash */ -1,
&new, /* nsPtr */ NULL, 0, NULL);
Tcl_IncrRefCount(*namePtr);
}
+49 -420
View File
@@ -27,9 +27,6 @@ enum returnKeys {
static Tcl_Obj ** GetKeys(void);
static void ReleaseKeys(ClientData clientData);
static void ResetObjResult(Interp *iPtr);
#ifndef TCL_NO_DEPRECATED
static void SetupAppendBuffer(Interp *iPtr, int newSpace);
#endif /* !TCL_NO_DEPRECATED */
/*
* This structure is used to take a snapshot of the interpreter state in
@@ -247,47 +244,9 @@ Tcl_SaveResult(
* reference. Put an empty object into the interpreter.
*/
statePtr->objResultPtr = iPtr->objResultPtr;
*statePtr = iPtr->objResultPtr;
iPtr->objResultPtr = Tcl_NewObj();
Tcl_IncrRefCount(iPtr->objResultPtr);
/*
* Save the string result.
*/
statePtr->freeProc = iPtr->freeProc;
if (iPtr->result == iPtr->resultSpace) {
/*
* Copy the static string data out of the interp buffer.
*/
statePtr->result = statePtr->resultSpace;
strcpy(statePtr->result, iPtr->result);
statePtr->appendResult = NULL;
} else if (iPtr->result == iPtr->appendResult) {
/*
* Move the append buffer out of the interp.
*/
statePtr->appendResult = iPtr->appendResult;
statePtr->appendAvl = iPtr->appendAvl;
statePtr->appendUsed = iPtr->appendUsed;
statePtr->result = statePtr->appendResult;
iPtr->appendResult = NULL;
iPtr->appendAvl = 0;
iPtr->appendUsed = 0;
} else {
/*
* Move the dynamic or static string out of the interpreter.
*/
statePtr->result = iPtr->result;
statePtr->appendResult = NULL;
}
iPtr->result = iPtr->resultSpace;
iPtr->resultSpace[0] = 0;
iPtr->freeProc = 0;
}
/*
@@ -318,45 +277,12 @@ Tcl_RestoreResult(
Tcl_ResetResult(interp);
/*
* Restore the string result.
*/
iPtr->freeProc = statePtr->freeProc;
if (statePtr->result == statePtr->resultSpace) {
/*
* Copy the static string data into the interp buffer.
*/
iPtr->result = iPtr->resultSpace;
strcpy(iPtr->result, statePtr->result);
} else if (statePtr->result == statePtr->appendResult) {
/*
* Move the append buffer back into the interp.
*/
if (iPtr->appendResult != NULL) {
ckfree(iPtr->appendResult);
}
iPtr->appendResult = statePtr->appendResult;
iPtr->appendAvl = statePtr->appendAvl;
iPtr->appendUsed = statePtr->appendUsed;
iPtr->result = iPtr->appendResult;
} else {
/*
* Move the dynamic or static string back into the interpreter.
*/
iPtr->result = statePtr->result;
}
/*
* Restore the object result.
*/
Tcl_DecrRefCount(iPtr->objResultPtr);
iPtr->objResultPtr = statePtr->objResultPtr;
iPtr->objResultPtr = *statePtr;
}
/*
@@ -382,15 +308,7 @@ void
Tcl_DiscardResult(
Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */
{
TclDecrRefCount(statePtr->objResultPtr);
if (statePtr->result == statePtr->appendResult) {
ckfree(statePtr->appendResult);
} else if (statePtr->freeProc == TCL_DYNAMIC) {
ckfree(statePtr->result);
} else if (statePtr->freeProc) {
statePtr->freeProc(statePtr->result);
}
Tcl_DecrRefCount(*statePtr);
}
/*
@@ -420,49 +338,15 @@ Tcl_SetResult(
* TCL_STATIC, TCL_VOLATILE, or the address of
* a Tcl_FreeProc such as free. */
{
Interp *iPtr = (Interp *) interp;
register Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
char *oldResult = iPtr->result;
if (result == NULL) {
iPtr->resultSpace[0] = 0;
iPtr->result = iPtr->resultSpace;
iPtr->freeProc = 0;
} else if (freeProc == TCL_VOLATILE) {
int length = strlen(result);
if (length > TCL_RESULT_SIZE) {
iPtr->result = ckalloc(length + 1);
iPtr->freeProc = TCL_DYNAMIC;
} else {
iPtr->result = iPtr->resultSpace;
iPtr->freeProc = 0;
}
memcpy(iPtr->result, result, (unsigned) length+1);
Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
if (result == NULL || freeProc == NULL || freeProc == TCL_VOLATILE) {
return;
}
if (freeProc == TCL_DYNAMIC) {
ckfree(result);
} else {
iPtr->result = (char *) result;
iPtr->freeProc = freeProc;
(*freeProc)(result);
}
/*
* If the old result was dynamically-allocated, free it up. Do it here,
* rather than at the beginning, in case the new result value was part of
* the old result value.
*/
if (oldFreeProc != 0) {
if (oldFreeProc == TCL_DYNAMIC) {
ckfree(oldResult);
} else {
oldFreeProc(oldResult);
}
}
/*
* Reset the object result since we just set the string result.
*/
ResetObjResult(iPtr);
}
#endif /* !TCL_NO_DEPRECATED */
@@ -488,20 +372,8 @@ Tcl_GetStringResult(
register Tcl_Interp *interp)/* Interpreter whose result to return. */
{
Interp *iPtr = (Interp *) interp;
#ifdef TCL_NO_DEPRECATED
return Tcl_GetString(iPtr->objResultPtr);
#else
/*
* If the string result is empty, move the object result to the string
* result, then reset the object result.
*/
if (*(iPtr->result) == 0) {
Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
TCL_VOLATILE);
}
return iPtr->result;
#endif
return Tcl_GetString(iPtr->objResultPtr);
}
/*
@@ -542,23 +414,6 @@ Tcl_SetObjResult(
*/
TclDecrRefCount(oldObjResult);
#ifndef TCL_NO_DEPRECATED
/*
* Reset the string result since we just set the result object.
*/
if (iPtr->freeProc != NULL) {
if (iPtr->freeProc == TCL_DYNAMIC) {
ckfree(iPtr->result);
} else {
iPtr->freeProc(iPtr->result);
}
iPtr->freeProc = 0;
}
iPtr->result = iPtr->resultSpace;
iPtr->resultSpace[0] = 0;
#endif
}
/*
@@ -587,72 +442,10 @@ Tcl_GetObjResult(
Tcl_Interp *interp) /* Interpreter whose result to return. */
{
register Interp *iPtr = (Interp *) interp;
#ifndef TCL_NO_DEPRECATED
Tcl_Obj *objResultPtr;
int length;
/*
* If the string result is non-empty, move the string result to the object
* result, then reset the string result.
*/
if (iPtr->result[0] != 0) {
ResetObjResult(iPtr);
objResultPtr = iPtr->objResultPtr;
length = strlen(iPtr->result);
TclInitStringRep(objResultPtr, iPtr->result, length);
if (iPtr->freeProc != NULL) {
if (iPtr->freeProc == TCL_DYNAMIC) {
ckfree(iPtr->result);
} else {
iPtr->freeProc(iPtr->result);
}
iPtr->freeProc = 0;
}
iPtr->result = iPtr->resultSpace;
iPtr->result[0] = 0;
}
#endif /* !TCL_NO_DEPRECATED */
return iPtr->objResultPtr;
}
/*
*----------------------------------------------------------------------
*
* Tcl_AppendResultVA --
*
* Append a variable number of strings onto the interpreter's result.
*
* Results:
* None.
*
* Side effects:
* The result of the interpreter given by the first argument is extended
* by the strings in the va_list (up to a terminating NULL argument).
*
* If the string result is non-empty, the object result forced to be a
* duplicate of it first. There will be a string result afterwards.
*
*----------------------------------------------------------------------
*/
void
Tcl_AppendResultVA(
Tcl_Interp *interp, /* Interpreter with which to associate the
* return value. */
va_list argList) /* Variable argument list. */
{
Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
if (Tcl_IsShared(objPtr)) {
objPtr = Tcl_DuplicateObj(objPtr);
}
Tcl_AppendStringsToObjVA(objPtr, argList);
Tcl_SetObjResult(interp, objPtr);
}
/*
*----------------------------------------------------------------------
*
@@ -679,9 +472,23 @@ Tcl_AppendResult(
Tcl_Interp *interp, ...)
{
va_list argList;
Tcl_Obj *objPtr;
va_start(argList, interp);
Tcl_AppendResultVA(interp, argList);
objPtr = Tcl_GetObjResult(interp);
if (Tcl_IsShared(objPtr)) {
objPtr = Tcl_DuplicateObj(objPtr);
}
while (1) {
const char *bytes = va_arg(argList, char *);
if (bytes == NULL) {
break;
}
Tcl_AppendToObj(objPtr, bytes, -1);
}
Tcl_SetObjResult(interp, objPtr);
va_end(argList);
}
@@ -716,7 +523,6 @@ Tcl_AppendElement(
* to result. */
{
Interp *iPtr = (Interp *) interp;
#ifdef TCL_NO_DEPRECATED
Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1);
Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr);
const char *bytes;
@@ -730,153 +536,25 @@ Tcl_AppendElement(
}
Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr);
Tcl_DecrRefCount(listPtr);
#else
char *dst;
int size;
int flags;
/*
* If the string result is empty, move the object result to the string
* result, then reset the object result.
*/
(void) Tcl_GetStringResult(interp);
/*
* See how much space is needed, and grow the append buffer if needed to
* accommodate the list element.
*/
size = Tcl_ScanElement(element, &flags) + 1;
if ((iPtr->result != iPtr->appendResult)
|| (iPtr->appendResult[iPtr->appendUsed] != 0)
|| ((size + iPtr->appendUsed) >= iPtr->appendAvl)) {
SetupAppendBuffer(iPtr, size+iPtr->appendUsed);
}
/*
* Convert the string into a list element and copy it to the buffer that's
* forming, with a space separator if needed.
*/
dst = iPtr->appendResult + iPtr->appendUsed;
if (TclNeedSpace(iPtr->appendResult, dst)) {
iPtr->appendUsed++;
*dst = ' ';
dst++;
/*
* If we need a space to separate this element from preceding stuff,
* then this element will not lead a list, and need not have it's
* leading '#' quoted.
*/
flags |= TCL_DONT_QUOTE_HASH;
}
iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags);
#endif /* !TCL_NO_DEPRECATED */
}
/*
*----------------------------------------------------------------------
*
* SetupAppendBuffer --
*
* This function makes sure that there is an append buffer properly
* initialized, if necessary, from the interpreter's result, and that it
* has at least enough room to accommodate newSpace new bytes of
* information.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
#ifndef TCL_NO_DEPRECATED
static void
SetupAppendBuffer(
Interp *iPtr, /* Interpreter whose result is being set up. */
int newSpace) /* Make sure that at least this many bytes of
* new information may be added. */
{
int totalSpace;
/*
* Make the append buffer larger, if that's necessary, then copy the
* result into the append buffer and make the append buffer the official
* Tcl result.
*/
if (iPtr->result != iPtr->appendResult) {
/*
* If an oversized buffer was used recently, then free it up so we go
* back to a smaller buffer. This avoids tying up memory forever after
* a large operation.
*/
if (iPtr->appendAvl > 500) {
ckfree(iPtr->appendResult);
iPtr->appendResult = NULL;
iPtr->appendAvl = 0;
}
iPtr->appendUsed = strlen(iPtr->result);
} else if (iPtr->result[iPtr->appendUsed] != 0) {
/*
* Most likely someone has modified a result created by
* Tcl_AppendResult et al. so that it has a different size. Just
* recompute the size.
*/
iPtr->appendUsed = strlen(iPtr->result);
}
totalSpace = newSpace + iPtr->appendUsed;
if (totalSpace >= iPtr->appendAvl) {
char *new;
if (totalSpace < 100) {
totalSpace = 200;
} else {
totalSpace *= 2;
}
new = ckalloc(totalSpace);
strcpy(new, iPtr->result);
if (iPtr->appendResult != NULL) {
ckfree(iPtr->appendResult);
}
iPtr->appendResult = new;
iPtr->appendAvl = totalSpace;
} else if (iPtr->result != iPtr->appendResult) {
strcpy(iPtr->appendResult, iPtr->result);
}
Tcl_FreeResult((Tcl_Interp *) iPtr);
iPtr->result = iPtr->appendResult;
}
#endif /* !TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
*
* Tcl_FreeResult --
*
* This function frees up the memory associated with an interpreter's
* string result. It also resets the interpreter's result object.
* Tcl_FreeResult is most commonly used when a function is about to
* replace one result value with another.
* result, resetting the interpreter's result object. Tcl_FreeResult is
* most commonly used when a function is about to replace one result
* value with another.
*
* Results:
* None.
*
* Side effects:
* Frees the memory associated with interp's string result and sets
* interp->freeProc to zero, but does not change interp->result or clear
* error state. Resets interp's result object to an unshared empty
* object.
* Frees the memory associated with interp's result but does not change
* any part of the error dictionary (i.e., the errorinfo and errorcode
* remain the same).
*
*----------------------------------------------------------------------
*/
@@ -887,17 +565,6 @@ Tcl_FreeResult(
{
register Interp *iPtr = (Interp *) interp;
#ifndef TCL_NO_DEPRECATED
if (iPtr->freeProc != NULL) {
if (iPtr->freeProc == TCL_DYNAMIC) {
ckfree(iPtr->result);
} else {
iPtr->freeProc(iPtr->result);
}
iPtr->freeProc = 0;
}
#endif /* !TCL_NO_DEPRECATED */
ResetObjResult(iPtr);
}
@@ -927,18 +594,6 @@ Tcl_ResetResult(
register Interp *iPtr = (Interp *) interp;
ResetObjResult(iPtr);
#ifndef TCL_NO_DEPRECATED
if (iPtr->freeProc != NULL) {
if (iPtr->freeProc == TCL_DYNAMIC) {
ckfree(iPtr->result);
} else {
iPtr->freeProc(iPtr->result);
}
iPtr->freeProc = 0;
}
iPtr->result = iPtr->resultSpace;
iPtr->resultSpace[0] = 0;
#endif /* !TCL_NO_DEPRECATED */
if (iPtr->errorCode) {
/* Legacy support */
if (iPtr->flags & ERR_LEGACY_COPY) {
@@ -1009,48 +664,6 @@ ResetObjResult(
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_SetErrorCodeVA --
*
* This function is called to record machine-readable information about
* an error that is about to be returned.
*
* Results:
* None.
*
* Side effects:
* The errorCode field of the interp is modified to hold all of the
* arguments to this function, in a list form with each argument becoming
* one element of the list.
*
*----------------------------------------------------------------------
*/
void
Tcl_SetErrorCodeVA(
Tcl_Interp *interp, /* Interpreter in which to set errorCode */
va_list argList) /* Variable argument list. */
{
Tcl_Obj *errorObj = Tcl_NewObj();
/*
* Scan through the arguments one at a time, appending them to the
* errorCode field as list elements.
*/
while (1) {
char *elem = va_arg(argList, char *);
if (elem == NULL) {
break;
}
Tcl_ListObjAppendElement(NULL, errorObj, Tcl_NewStringObj(elem, -1));
}
Tcl_SetObjErrorCode(interp, errorObj);
}
/*
*----------------------------------------------------------------------
*
@@ -1075,6 +688,7 @@ Tcl_SetErrorCode(
Tcl_Interp *interp, ...)
{
va_list argList;
Tcl_Obj *errorObj;
/*
* Scan through the arguments one at a time, appending them to the
@@ -1082,7 +696,22 @@ Tcl_SetErrorCode(
*/
va_start(argList, interp);
Tcl_SetErrorCodeVA(interp, argList);
errorObj = Tcl_NewObj();
/*
* Scan through the arguments one at a time, appending them to the
* errorCode field as list elements.
*/
while (1) {
char *elem = va_arg(argList, char *);
if (elem == NULL) {
break;
}
Tcl_ListObjAppendElement(NULL, errorObj, Tcl_NewStringObj(elem, -1));
}
Tcl_SetObjErrorCode(interp, errorObj);
va_end(argList);
}
+1 -1
View File
@@ -29,7 +29,7 @@
* character set.
*/
typedef struct CharSet {
typedef struct {
int exclude; /* 1 if this is an exclusion set. */
int nchars;
Tcl_UniChar *chars;
+6 -70
View File
@@ -483,7 +483,7 @@ TclParseNumber(
enum State {
INITIAL, SIGNUM, ZERO, ZERO_X,
ZERO_O, ZERO_B, ZERO_D, BINARY,
HEXADECIMAL, OCTAL, BAD_OCTAL, DECIMAL,
HEXADECIMAL, OCTAL, DECIMAL,
LEADING_RADIX_POINT, FRACTION,
EXPONENT_START, EXPONENT_SIGNUM, EXPONENT,
sI, sIN, sINF, sINFI, sINFIN, sINFINI, sINFINIT, sINFINITY
@@ -528,7 +528,6 @@ TclParseNumber(
char d = 0; /* Last hexadecimal digit scanned; initialized
* to avoid a compiler warning. */
int shift = 0; /* Amount to shift when accumulating binary */
int explicitOctal = 0;
#define ALL_BITS (~(Tcl_WideUInt)0)
#define MOST_BITS (ALL_BITS >> 1)
@@ -660,7 +659,6 @@ TclParseNumber(
goto zerob;
}
if (c == 'o' || c == 'O') {
explicitOctal = 1;
state = ZERO_O;
break;
}
@@ -668,10 +666,7 @@ TclParseNumber(
state = ZERO_D;
break;
}
#ifdef TCL_NO_DEPRECATED
goto decimal;
#endif
/* FALLTHROUGH */
case OCTAL:
/*
@@ -734,58 +729,6 @@ TclParseNumber(
state = OCTAL;
break;
}
/* FALLTHROUGH */
case BAD_OCTAL:
if (explicitOctal) {
/*
* No forgiveness for bad digits in explicitly octal numbers.
*/
goto endgame;
}
if (flags & TCL_PARSE_INTEGER_ONLY) {
/*
* No seeking floating point when parsing only integer.
*/
goto endgame;
}
#ifndef TCL_NO_DEPRECATED
/*
* Scanned a number with a leading zero that contains an 8, 9,
* radix point or E. This is an invalid octal number, but might
* still be floating point.
*/
if (c == '0') {
numTrailZeros++;
state = BAD_OCTAL;
break;
} else if (isdigit(UCHAR(c))) {
if (objPtr != NULL) {
significandOverflow = AccumulateDecimalDigit(
(unsigned)(c-'0'), numTrailZeros,
&significandWide, &significandBig,
significandOverflow);
}
if (numSigDigs != 0) {
numSigDigs += (numTrailZeros + 1);
} else {
numSigDigs = 1;
}
numTrailZeros = 0;
state = BAD_OCTAL;
break;
} else if (c == '.') {
state = FRACTION;
break;
} else if (c == 'E' || c == 'e') {
state = EXPONENT_START;
break;
}
#endif
goto endgame;
/*
@@ -900,9 +843,7 @@ TclParseNumber(
* digits.
*/
#ifdef TCL_NO_DEPRECATED
decimal:
#endif
acceptState = state;
acceptPoint = p;
acceptLen = len;
@@ -1186,7 +1127,6 @@ TclParseNumber(
TclFreeIntRep(objPtr);
switch (acceptState) {
case SIGNUM:
case BAD_OCTAL:
case ZERO_X:
case ZERO_O:
case ZERO_B:
@@ -1384,9 +1324,6 @@ TclParseNumber(
Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, "");
Tcl_AppendToObj(msg, "\"", -1);
if (state == BAD_OCTAL) {
Tcl_AppendToObj(msg, " (looks like invalid octal number)", -1);
}
Tcl_SetObjResult(interp, msg);
Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
}
@@ -4031,8 +3968,8 @@ StrictBignumConversion(
* This function is a service routine that produces the string of digits for
* floating-point-to-decimal conversion. It can do a number of things
* according to the 'flags' argument. Valid values for 'flags' include:
* TCL_DD_SHORTEST - This is the default for floating point conversion if
* ::tcl_precision is 0. It constructs the shortest string of
* TCL_DD_SHORTEST - This is the default for floating point conversion.
* It constructs the shortest string of
* digits that will reconvert to the given number when scanned.
* For floating point numbers that are exactly between two
* decimal numbers, it resolves using the 'round to even' rule.
@@ -4047,8 +3984,7 @@ StrictBignumConversion(
* subsequent input conversion is 'round up' or 'round down'
* rather than 'round to nearest', but is surprising otherwise.
* TCL_DD_E_FORMAT - This value is used to prepare numbers for %e format
* conversion (or for default floating->string if tcl_precision
* is not 0). It constructs a string of at most 'ndigits' digits,
* conversion. It constructs a string of at most 'ndigits' digits,
* choosing the one that is closest to the given number (and
* resolving ties with 'round to even'). It is allowed to return
* fewer than 'ndigits' if the number converts exactly; if the
@@ -4543,7 +4479,7 @@ Tcl_InitBignumFromDouble(
return TCL_ERROR;
}
fract = frexp(d, &expt);
fract = frexp(d,&expt);
if (expt <= 0) {
mp_init(b);
mp_zero(b);
@@ -4883,7 +4819,7 @@ Pow10TimesFrExp(
* Multiply by 10**exponent.
*/
retval = frexp(retval * pow10vals[exponent & 0xf], &j);
retval = frexp(retval * pow10vals[exponent&0xf], &j);
expt += j;
for (i=4; i<9; ++i) {
if (exponent & (1<<i)) {
+105 -351
View File
@@ -436,6 +436,7 @@ Tcl_GetCharLength(
return length;
}
/*
* OK, need to work with the object as a string.
*/
@@ -454,6 +455,8 @@ Tcl_GetCharLength(
}
return numChars;
}
/*
*----------------------------------------------------------------------
@@ -472,16 +475,16 @@ Tcl_GetCharLength(
*----------------------------------------------------------------------
*/
int
TclCheckEmptyString(
Tcl_Obj *objPtr)
{
TclCheckEmptyString (
Tcl_Obj *objPtr
) {
int length = -1;
if (objPtr->bytes == &tclEmptyString) {
if (objPtr->bytes == tclEmptyStringRep) {
return TCL_EMPTYSTRING_YES;
}
if (TclListObjIsCanonical(objPtr)) {
if (TclIsPureList(objPtr)) {
Tcl_ListObjLength(NULL, objPtr, &length);
return length == 0;
}
@@ -567,22 +570,20 @@ Tcl_GetUniChar(
if (index >= stringPtr->numChars) {
return -1;
}
ch = stringPtr->unicode[index];
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 */
/* 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;
}
} 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;
}
@@ -688,8 +689,7 @@ Tcl_GetRange(
if (first < 0) {
first = 0;
}
}
/*
* Optimize the case where we're really dealing with a bytearray object
* we don't need to convert to a string to perform the substring operation.
@@ -697,14 +697,13 @@ Tcl_GetRange(
if (TclIsPureByteArray(objPtr)) {
unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
if (last >= length) {
last = length - 1;
}
if (last < first) {
return Tcl_NewObj();
}
return Tcl_NewByteArrayObj(bytes + first, last - first + 1);
return Tcl_NewByteArrayObj(bytes+first, last-first+1);
}
/*
@@ -743,25 +742,24 @@ Tcl_GetRange(
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
if (last > stringPtr->numChars) {
last = stringPtr->numChars;
}
if (last < first) {
return Tcl_NewObj();
}
if (last > stringPtr->numChars) {
last = stringPtr->numChars;
}
if (last < first) {
return Tcl_NewObj();
}
#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;
}
/* 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);
return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1);
}
/*
@@ -1319,51 +1317,45 @@ Tcl_AppendObjToObj(
/*
* Handle append of one bytearray object to another as a special case.
* Note that we only do this when the objects are pure so that the
* bytearray faithfully represent the true value; Otherwise appending the
* byte arrays together could lose information;
* bytearray faithfully represent the true value; Otherwise
* appending the byte arrays together could lose information;
*/
if ((TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString)
&& TclIsPureByteArray(appendObjPtr)) {
/*
* You might expect the code here to be
*
* bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length);
* TclAppendBytesToByteArray(objPtr, bytes, length);
*
* and essentially all of the time that would be fine. However, it
* would run into trouble in the case where objPtr and appendObjPtr
* point to the same thing. That may never be a good idea. It seems to
* violate Copy On Write, and we don't have any tests for the
* situation, since making any Tcl commands that call
* Tcl_AppendObjToObj() do that appears impossible (They honor Copy On
* Write!). For the sake of extensions that go off into that realm,
* though, here's a more complex approach that can handle all the
* cases.
*
* First, get the lengths.
* and essentially all of the time that would be fine. However,
* it would run into trouble in the case where objPtr and
* appendObjPtr point to the same thing. That may never be a
* good idea. It seems to violate Copy On Write, and we don't
* have any tests for the situation, since making any Tcl commands
* that call Tcl_AppendObjToObj() do that appears impossible
* (They honor Copy On Write!). For the sake of extensions that
* go off into that realm, though, here's a more complex approach
* that can handle all the cases.
*/
/* Get lengths */
int lengthSrc;
(void) Tcl_GetByteArrayFromObj(objPtr, &length);
(void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc);
/*
* Grow buffer enough for the append.
*/
/* Grow buffer enough for the append */
TclAppendBytesToByteArray(objPtr, NULL, lengthSrc);
/*
* Reset objPtr back to the original value.
*/
/* Reset objPtr back to the original value */
Tcl_SetByteArrayLength(objPtr, length);
/*
* Now do the append knowing that buffer growth cannot cause any
* trouble.
* Now do the append knowing that buffer growth cannot cause
* any trouble.
*/
TclAppendBytesToByteArray(objPtr,
@@ -1411,7 +1403,6 @@ Tcl_AppendObjToObj(
numChars = stringPtr->numChars;
if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
String *appendStringPtr = GET_STRING(appendObjPtr);
appendNumChars = appendStringPtr->numChars;
}
@@ -1669,43 +1660,6 @@ AppendUtfToUtfRep(
objPtr->length = newLength;
}
/*
*----------------------------------------------------------------------
*
* Tcl_AppendStringsToObjVA --
*
* This function appends one or more null-terminated strings to an
* object.
*
* Results:
* None.
*
* Side effects:
* The contents of all the string arguments are appended to the string
* representation of objPtr.
*
*----------------------------------------------------------------------
*/
void
Tcl_AppendStringsToObjVA(
Tcl_Obj *objPtr, /* Points to the object to append to. */
va_list argList) /* Variable argument list. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_AppendStringsToObj");
}
while (1) {
const char *bytes = va_arg(argList, char *);
if (bytes == NULL) {
break;
}
Tcl_AppendToObj(objPtr, bytes, -1);
}
}
/*
*----------------------------------------------------------------------
*
@@ -1732,7 +1686,18 @@ Tcl_AppendStringsToObj(
va_list argList;
va_start(argList, objPtr);
Tcl_AppendStringsToObjVA(objPtr, argList);
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_AppendStringsToObj");
}
while (1) {
const char *bytes = va_arg(argList, char *);
if (bytes == NULL) {
break;
}
Tcl_AppendToObj(objPtr, bytes, -1);
}
va_end(argList);
}
@@ -1997,8 +1962,7 @@ Tcl_AppendFormatToObj(
format += step;
step = TclUtfToUniChar(format, &ch);
}
} else if ((ch == 't') || (ch == 'z') || (ch == 'q') || (ch == 'j')
|| (ch == 'L')) {
} else if ((ch == 't') || (ch == 'z') || (ch == 'q') || (ch == 'j') || (ch == 'L')) {
format += step;
step = TclUtfToUniChar(format, &ch);
useBig = 1;
@@ -2159,14 +2123,6 @@ Tcl_AppendFormatToObj(
Tcl_AppendToObj(segment, "0b", 2);
segmentLimit -= 2;
break;
#if TCL_MAJOR_VERSION < 9
case 'd':
if (gotZero) {
Tcl_AppendToObj(segment, "0d", 2);
segmentLimit -= 2;
}
break;
#endif
}
}
@@ -2523,7 +2479,7 @@ Tcl_AppendFormatToObj(
/*
*---------------------------------------------------------------------------
*
* Tcl_Format --
* Tcl_Format--
*
* Results:
* A refcount zero Tcl_Obj.
@@ -2914,10 +2870,7 @@ TclStringRepeat(
Tcl_GetByteArrayFromObj(objResultPtr, NULL),
(count - done) * length);
} else if (unichar) {
/*
* Efficiently produce a pure Tcl_UniChar array result.
*/
/* Efficiently produce a pure Tcl_UniChar array result */
if (!inPlace || Tcl_IsShared(objPtr)) {
objResultPtr = Tcl_NewUnicodeObj(Tcl_GetUnicode(objPtr), length);
} else {
@@ -2943,10 +2896,7 @@ TclStringRepeat(
Tcl_AppendUnicodeToObj(objResultPtr, Tcl_GetUnicode(objResultPtr),
(count - done) * length);
} else {
/*
* Efficiently concatenate string reps.
*/
/* Efficiently concatenate string reps */
if (!inPlace || Tcl_IsShared(objPtr)) {
objResultPtr = Tcl_NewStringObj(Tcl_GetString(objPtr), length);
} else {
@@ -3030,10 +2980,9 @@ TclStringCat(
/* Value has a string rep. */
if (objPtr->length) {
/*
* Non-empty string rep. Not a pure bytearray, so we won't
* create a pure bytearray.
* Non-empty string rep. Not a pure bytearray, so we
* won't create a pure bytearray
*/
binary = 0;
if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
/* Prevent shimmer of non-string types. */
@@ -3054,12 +3003,8 @@ TclStringCat(
} while (--oc && (binary || allowUniChar));
if (binary) {
/*
* Result will be pure byte array. Pre-size it
*/
ov = objv;
oc = objc;
/* Result will be pure byte array. Pre-size it */
ov = objv; oc = objc;
do {
Tcl_Obj *objPtr = *ov++;
@@ -3079,12 +3024,8 @@ TclStringCat(
}
} while (--oc);
} else if (allowUniChar && requestUniChar) {
/*
* Result will be pure Tcl_UniChar array. Pre-size it.
*/
ov = objv;
oc = objc;
/* Result will be pure Tcl_UniChar array. Pre-size it. */
ov = objv; oc = objc;
do {
Tcl_Obj *objPtr = *ov++;
@@ -3129,9 +3070,9 @@ TclStringCat(
} while (--oc && (length == 0) && (pendingPtr == NULL));
/*
* Either we found a possibly non-empty value, and we remember
* this index as the first and last such value so far seen,
* or (oc == 0) and all values are known empty,
* Either we found a possibly non-empty value, and we
* remember this index as the first and last such value so
* far seen, or (oc == 0) and all values are known empty,
* so first = last = objc - 1 signals the right quick return.
*/
@@ -3143,9 +3084,10 @@ TclStringCat(
/* assert ( pendingPtr != NULL ) */
/*
* There's a pending value followed by more values. Loop over
* remaining values generating strings until a non-empty value
* is found, or the pending value gets its string generated.
* There's a pending value followed by more values.
* Loop over remaining values generating strings until
* a non-empty value is found, or the pending value gets
* its string generated.
*/
do {
@@ -3201,10 +3143,10 @@ TclStringCat(
unsigned char *dst;
/*
* Broken interface! Byte array value routines offer no way to handle
* failure to allocate enough space. Following stanza may panic.
* Broken interface! Byte array value routines offer no way
* to handle failure to allocate enough space. Following
* stanza may panic.
*/
if (inPlace && !Tcl_IsShared(*objv)) {
int start;
@@ -3319,7 +3261,6 @@ TclStringCat(
if ((objPtr->bytes == NULL) || (objPtr->length)) {
int more;
char *src = Tcl_GetStringFromObj(objPtr, &more);
memcpy(dst, src, (size_t) more);
dst += more;
}
@@ -3338,187 +3279,6 @@ TclStringCat(
return NULL;
}
/*
*---------------------------------------------------------------------------
*
* TclStringCmp --
* Compare two Tcl_Obj values as strings.
*
* Results:
* Like memcmp, return -1, 0, or 1.
*
* Side effects:
* String representations may be generated. Internal representation may
* be changed.
*
*---------------------------------------------------------------------------
*/
int TclStringCmp(
Tcl_Obj *value1Ptr,
Tcl_Obj *value2Ptr,
int checkEq, /* comparison is only for equality */
int nocase, /* comparison is not case sensitive */
int reqlength) /* requested length */
{
char *s1, *s2;
int empty, length, match, s1len, s2len;
memCmpFn_t memCmpFn;
if ((reqlength == 0) || (value1Ptr == value2Ptr)) {
/*
* Always match at 0 chars of if it is the same obj.
*/
match = 0;
} else {
if (!nocase && TclIsPureByteArray(value1Ptr)
&& TclIsPureByteArray(value2Ptr)) {
/*
* Use binary versions of comparisons since that won't cause undue
* type conversions and it is much faster. Only do this if we're
* case-sensitive (which is all that really makes sense with byte
* arrays anyway, and we have no memcasecmp() for some reason... :^)
*/
s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len);
s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
memCmpFn = memcmp;
} else if ((value1Ptr->typePtr == &tclStringType)
&& (value2Ptr->typePtr == &tclStringType)) {
/*
* Do a unicode-specific comparison if both of the args are of
* String type. If the char length == byte length, we can do a
* memcmp. In benchmark testing this proved the most efficient
* check between the unicode and string comparison operations.
*/
if (nocase) {
s1 = (char *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len);
s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len);
memCmpFn = (memCmpFn_t)Tcl_UniCharNcasecmp;
} else {
s1len = Tcl_GetCharLength(value1Ptr);
s2len = Tcl_GetCharLength(value2Ptr);
if ((s1len == value1Ptr->length)
&& (value1Ptr->bytes != NULL)
&& (s2len == value2Ptr->length)
&& (value2Ptr->bytes != NULL)) {
s1 = value1Ptr->bytes;
s2 = value2Ptr->bytes;
memCmpFn = memcmp;
} else {
s1 = (char *) Tcl_GetUnicode(value1Ptr);
s2 = (char *) Tcl_GetUnicode(value2Ptr);
if (
#ifdef WORDS_BIGENDIAN
1
#else
checkEq
#endif
) {
memCmpFn = memcmp;
s1len *= sizeof(Tcl_UniChar);
s2len *= sizeof(Tcl_UniChar);
} else {
memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp;
}
}
}
} else {
if ((empty = TclCheckEmptyString(value1Ptr)) > 0) {
switch (TclCheckEmptyString(value2Ptr)) {
case -1:
s1 = 0;
s1len = 0;
s2 = TclGetStringFromObj(value2Ptr, &s2len);
break;
case 0:
match = -1;
goto matchdone;
case 1:
default: /* avoid warn: `s2` may be used uninitialized */
match = 0;
goto matchdone;
}
} else if (TclCheckEmptyString(value2Ptr) > 0) {
switch (empty) {
case -1:
s2 = 0;
s2len = 0;
s1 = TclGetStringFromObj(value1Ptr, &s1len);
break;
case 0:
match = 1;
goto matchdone;
case 1:
default: /* avoid warn: `s1` may be used uninitialized */
match = 0;
goto matchdone;
}
} else {
s1 = TclGetStringFromObj(value1Ptr, &s1len);
s2 = TclGetStringFromObj(value2Ptr, &s2len);
}
if (!nocase && checkEq) {
/*
* When we have equal-length we can check only for
* (in)equality. We can use memcmp in all (n)eq cases because
* we don't need to worry about lexical LE/BE variance.
*/
memCmpFn = memcmp;
} else {
/*
* As a catch-all we will work with UTF-8. We cannot use
* memcmp() as that is unsafe with any string containing NUL
* (\xC0\x80 in Tcl's utf rep). We can use the more efficient
* TclpUtfNcmp2 if we are case-sensitive and no specific
* length was requested.
*/
if ((reqlength < 0) && !nocase) {
memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
} else {
s1len = Tcl_NumUtfChars(s1, s1len);
s2len = Tcl_NumUtfChars(s2, s2len);
memCmpFn = (memCmpFn_t)
(nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
}
}
}
length = (s1len < s2len) ? s1len : s2len;
if (reqlength > 0 && reqlength < length) {
length = reqlength;
} else if (reqlength < 0) {
/*
* The requested length is negative, so we ignore it by setting it
* to length + 1 so we correct the match var.
*/
reqlength = length + 1;
}
if (checkEq && (s1len != s2len)) {
match = 1; /* This will be reversed below. */
} else {
/*
* The comparison function should compare up to the minimum byte
* length only.
*/
match = memCmpFn(s1, s2, (size_t) length);
}
if ((match == 0) && (reqlength > length)) {
match = s1len - s2len;
}
match = (match > 0) ? 1 : (match < 0) ? -1 : 0;
}
matchdone:
return match;
}
/*
*---------------------------------------------------------------------------
*
@@ -3713,20 +3473,18 @@ static void
ReverseBytes(
unsigned char *to, /* Copy bytes into here... */
unsigned char *from, /* ...from here... */
int count) /* Until this many are copied, */
int count) /* Until this many are copied, */
/* reversing as you go. */
{
unsigned char *src = from + count;
if (to == from) {
/* Reversing in place */
while (--src > to) {
unsigned char c = *src;
*src = *to;
*to++ = c;
}
} else {
} else {
while (--src >= from) {
*to++ = *src;
}
@@ -3775,10 +3533,7 @@ TclStringReverse(
*to++ = *src;
}
} else {
/*
* Reversing in place.
*/
/* Reversing in place */
while (--src > from) {
ch = *src;
*src = *from;
@@ -3802,22 +3557,20 @@ TclStringReverse(
/*
* Either numChars == -1 and we don't know how many chars are
* represented by objPtr->bytes and we need Pass 1 just in case,
* or numChars >= 0 and we know we have fewer chars than bytes, so
* we know there's a multibyte character needing Pass 1.
* or numChars >= 0 and we know we have fewer chars than bytes,
* so we know there's a multibyte character needing Pass 1.
*
* Pass 1. Reverse the bytes of each multi-byte character.
*/
int charCount = 0;
int bytesLeft = numBytes;
while (bytesLeft) {
/*
* NOTE: We know that the from buffer is NUL-terminated. It's
* part of the contract for objPtr->bytes values. Thus, we can
* skip calling Tcl_UtfCharComplete() here.
* NOTE: We know that the from buffer is NUL-terminated.
* It's part of the contract for objPtr->bytes values.
* Thus, we can skip calling Tcl_UtfCharComplete() here.
*/
int bytesInChar = TclUtfToUniChar(from, &ch);
ReverseBytes((unsigned char *)to, (unsigned char *)from,
@@ -3847,18 +3600,19 @@ TclStringReverse(
*
* The result is a concatenation of a prefix from objPtr, characters
* 0 through first-1, the insertPtr string value, and a suffix from
* objPtr, characters from first + count to the end. The effect is as if
* the inner substring of characters first through first+count-1 are
* removed and replaced with insertPtr. If insertPtr is NULL, it is
* treated as an empty string. When passed the flag TCL_STRING_IN_PLACE,
* this routine will try to do the work within objPtr, so long as no
* sharing forbids it. Without that request, or as needed, a new Tcl
* value will be allocated to be the result.
* objPtr, characters from first + count to the end. The effect is
* as if the inner substring of characters first through first+count-1
* are removed and replaced with insertPtr.
* If insertPtr is NULL, it is treated as an empty string.
* When passed the flag TCL_STRING_IN_PLACE, this routine will try
* to do the work within objPtr, so long as no sharing forbids it.
* Without that request, or as needed, a new Tcl value will be allocated
* to be the result.
*
* Results:
* A Tcl value that is the result of the substring replacement. May
* return NULL in case of an error. When NULL is returned and interp is
* non-NULL, error information is left in interp
* A Tcl value that is the result of the substring replacement.
* May return NULL in case of an error. When NULL is returned and
* interp is non-NULL, error information is left in interp
*
*---------------------------------------------------------------------------
*/
+73 -287
View File
@@ -40,125 +40,24 @@
#undef Tcl_CreateHashEntry
#undef Tcl_Panic
#undef Tcl_FindExecutable
#undef Tcl_SetPanicProc
#undef TclpGetPid
#undef TclSockMinimumBuffers
#undef Tcl_SetIntObj
#undef Tcl_SetLongObj
#undef TclpInetNtoa
#undef TclWinGetServByName
#undef TclWinGetSockOpt
#undef TclWinSetSockOpt
#undef TclWinNToHS
/* See bug 510001: TclSockMinimumBuffers needs plat imp */
#if defined(_WIN64) || defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
# define TclSockMinimumBuffersOld 0
#else
#define TclSockMinimumBuffersOld sockMinimumBuffersOld
static int TclSockMinimumBuffersOld(int sock, int size)
{
return TclSockMinimumBuffers(INT2PTR(sock), size);
}
#endif
#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
# define TclSetStartupScriptPath 0
# define TclGetStartupScriptPath 0
# define TclSetStartupScriptFileName 0
# define TclGetStartupScriptFileName 0
# define TclPrecTraceProc 0
# define TclpInetNtoa 0
# define TclWinGetServByName 0
# define TclWinGetSockOpt 0
# define TclWinSetSockOpt 0
# define TclWinNToHS 0
# define TclWinGetPlatformId 0
# define TclWinResetInterfaces 0
# define TclWinSetInterfaces 0
# define TclWinGetPlatformId 0
# define TclBNInitBignumFromWideUInt 0
# define TclBNInitBignumFromWideInt 0
# define TclBNInitBignumFromLong 0
# define Tcl_Backslash 0
# define Tcl_GetDefaultEncodingDir 0
# define Tcl_SetDefaultEncodingDir 0
# define Tcl_EvalTokens 0
# define Tcl_CreateMathFunc 0
# define Tcl_GetMathFuncInfo 0
# define Tcl_ListMathFuncs 0
#else
#define TclSetStartupScriptPath setStartupScriptPath
static void TclSetStartupScriptPath(Tcl_Obj *path)
{
Tcl_SetStartupScript(path, NULL);
}
#define TclGetStartupScriptPath getStartupScriptPath
static Tcl_Obj *TclGetStartupScriptPath(void)
{
return Tcl_GetStartupScript(NULL);
}
#define TclSetStartupScriptFileName setStartupScriptFileName
static void TclSetStartupScriptFileName(
const char *fileName)
{
Tcl_SetStartupScript(Tcl_NewStringObj(fileName,-1), NULL);
}
#define TclGetStartupScriptFileName getStartupScriptFileName
static const char *TclGetStartupScriptFileName(void)
{
Tcl_Obj *path = Tcl_GetStartupScript(NULL);
if (path == NULL) {
return NULL;
}
return Tcl_GetString(path);
}
#if defined(_WIN32) || defined(__CYGWIN__)
#undef TclWinNToHS
#undef TclWinGetPlatformId
#undef TclWinResetInterfaces
#undef TclWinSetInterfaces
static void
doNothing(void)
{
/* dummy implementation, no need to do anything */
}
#define TclWinNToHS winNToHS
static unsigned short TclWinNToHS(unsigned short ns) {
return ntohs(ns);
}
#define TclWinGetPlatformId winGetPlatformId
static int
TclWinGetPlatformId(void)
{
return 2; /* VER_PLATFORM_WIN32_NT */;
}
#define TclWinResetInterfaces doNothing
#define TclWinSetInterfaces (void (*) (int)) doNothing
#endif
# define TclBNInitBignumFromWideUInt TclInitBignumFromWideUInt
# define TclBNInitBignumFromWideInt TclInitBignumFromWideInt
# define TclBNInitBignumFromLong TclInitBignumFromLong
#endif /* TCL_NO_DEPRECATED */
#ifdef _WIN32
# define TclUnixWaitForFile 0
# define TclUnixCopyFile 0
# define TclUnixOpenTemporaryFile 0
# define TclpReaddir 0
# define TclpIsAtty 0
#elif defined(__CYGWIN__)
# define TclpIsAtty TclPlatIsAtty
#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
static void
doNothing(void)
{
/* dummy implementation, no need to do anything */
}
#endif
# define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing
# define TclWinFlushDirtyChannels doNothing
static int
TclpIsAtty(int fd)
{
@@ -173,31 +72,6 @@ void *TclWinGetTclInstance()
return hInstance;
}
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#define TclWinSetSockOpt winSetSockOpt
static int
TclWinSetSockOpt(SOCKET s, int level, int optname,
const char *optval, int optlen)
{
return setsockopt((int) s, level, optname, optval, optlen);
}
#define TclWinGetSockOpt winGetSockOpt
static int
TclWinGetSockOpt(SOCKET s, int level, int optname,
char *optval, int *optlen)
{
return getsockopt((int) s, level, optname, optval, optlen);
}
#define TclWinGetServByName winGetServByName
static struct servent *
TclWinGetServByName(const char *name, const char *proto)
{
return getservbyname(name, proto);
}
#endif /* TCL_NO_DEPRECATED */
#define TclWinNoBackslash winNoBackslash
static char *
TclWinNoBackslash(char *path)
@@ -320,8 +194,6 @@ static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsig
#endif /* __CYGWIN__ */
#if defined(TCL_NO_DEPRECATED)
# define Tcl_SeekOld 0
# define Tcl_TellOld 0
# undef Tcl_SetBooleanObj
# define Tcl_SetBooleanObj 0
# undef Tcl_PkgPresent
@@ -367,83 +239,6 @@ static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsig
# define Tcl_DiscardResult 0
# undef Tcl_SetResult
# define Tcl_SetResult 0
# undef Tcl_EvalObj
# define Tcl_EvalObj 0
# undef Tcl_GlobalEvalObj
# define Tcl_GlobalEvalObj 0
# define TclBackgroundException 0
# undef TclpReaddir
# define TclpReaddir 0
# define TclSetStartupScript 0
# define TclGetStartupScript 0
# define TclCreateNamespace 0
# define TclDeleteNamespace 0
# define TclAppendExportList 0
# define TclExport 0
# define TclImport 0
# define TclForgetImport 0
# define TclGetCurrentNamespace_ 0
# define TclGetGlobalNamespace_ 0
# define TclFindNamespace 0
# define TclFindCommand 0
# define TclGetCommandFromObj 0
# define TclGetCommandFullName 0
# define TclCopyChannelOld 0
# define Tcl_AppendResultVA 0
# define Tcl_AppendStringsToObjVA 0
# define Tcl_SetErrorCodeVA 0
# define Tcl_PanicVA 0
# define Tcl_VarEvalVA 0
# undef TclpGetDate
# define TclpGetDate 0
# undef TclpLocaltime
# define TclpLocaltime 0
# undef TclpGmtime
# define TclpGmtime 0
# define TclpLocaltime_unix 0
# define TclpGmtime_unix 0
#else /* TCL_NO_DEPRECATED */
# define Tcl_SeekOld seekOld
# define Tcl_TellOld tellOld
# define TclBackgroundException Tcl_BackgroundException
# define TclSetStartupScript Tcl_SetStartupScript
# define TclGetStartupScript Tcl_GetStartupScript
# define TclCreateNamespace Tcl_CreateNamespace
# define TclDeleteNamespace Tcl_DeleteNamespace
# define TclAppendExportList Tcl_AppendExportList
# define TclExport Tcl_Export
# define TclImport Tcl_Import
# define TclForgetImport Tcl_ForgetImport
# define TclGetCurrentNamespace_ Tcl_GetCurrentNamespace
# define TclGetGlobalNamespace_ Tcl_GetGlobalNamespace
# define TclFindNamespace Tcl_FindNamespace
# define TclFindCommand Tcl_FindCommand
# define TclGetCommandFromObj Tcl_GetCommandFromObj
# define TclGetCommandFullName Tcl_GetCommandFullName
# define TclpLocaltime_unix TclpLocaltime
# define TclpGmtime_unix TclpGmtime
static int
seekOld(
Tcl_Channel chan, /* The channel on which to seek. */
int offset, /* Offset to seek to. */
int mode) /* Relative to which location to seek? */
{
Tcl_WideInt wOffset, wResult;
wOffset = Tcl_LongAsWide((long) offset);
wResult = Tcl_Seek(chan, wOffset, mode);
return (int) Tcl_WideAsLong(wResult);
}
static int
tellOld(
Tcl_Channel chan) /* The channel to return pos for. */
{
Tcl_WideInt wResult = Tcl_Tell(chan);
return (int) Tcl_WideAsLong(wResult);
}
#endif /* !TCL_NO_DEPRECATED */
/*
@@ -455,15 +250,6 @@ tellOld(
MODULE_SCOPE const TclStubs tclStubs;
MODULE_SCOPE const TclTomMathStubs tclTomMathStubs;
#ifdef __GNUC__
/*
* The rest of this file shouldn't warn about deprecated functions; they're
* there because we intend them to be so and know that this file is OK to
* touch those fields.
*/
#pragma GCC diagnostic ignored "-Wdeprecated-declarations"
#endif
/* !BEGIN!: Do not edit below this line. */
static const TclIntStubs tclIntStubs = {
@@ -477,7 +263,7 @@ static const TclIntStubs tclIntStubs = {
TclCleanupChildren, /* 5 */
TclCleanupCommand, /* 6 */
TclCopyAndCollapse, /* 7 */
TclCopyChannelOld, /* 8 */
0, /* 8 */
TclCreatePipeline, /* 9 */
TclCreateProc, /* 10 */
TclDeleteCompiledLocalVars, /* 11 */
@@ -546,7 +332,7 @@ static const TclIntStubs tclIntStubs = {
TclpFree, /* 74 */
TclpGetClicks, /* 75 */
TclpGetSeconds, /* 76 */
TclpGetTime, /* 77 */
0, /* 77 */
0, /* 78 */
0, /* 79 */
0, /* 80 */
@@ -557,7 +343,7 @@ static const TclIntStubs tclIntStubs = {
0, /* 85 */
0, /* 86 */
0, /* 87 */
TclPrecTraceProc, /* 88 */
0, /* 88 */
TclPreventAliasLoop, /* 89 */
0, /* 90 */
TclProcCleanupProc, /* 91 */
@@ -573,7 +359,7 @@ static const TclIntStubs tclIntStubs = {
TclSetPreInitScript, /* 101 */
TclSetupEnv, /* 102 */
TclSockGetPort, /* 103 */
TclSockMinimumBuffersOld, /* 104 */
0, /* 104 */
0, /* 105 */
0, /* 106 */
0, /* 107 */
@@ -581,28 +367,28 @@ static const TclIntStubs tclIntStubs = {
TclUpdateReturnInfo, /* 109 */
TclSockMinimumBuffers, /* 110 */
Tcl_AddInterpResolvers, /* 111 */
TclAppendExportList, /* 112 */
TclCreateNamespace, /* 113 */
TclDeleteNamespace, /* 114 */
TclExport, /* 115 */
TclFindCommand, /* 116 */
TclFindNamespace, /* 117 */
0, /* 112 */
0, /* 113 */
0, /* 114 */
0, /* 115 */
0, /* 116 */
0, /* 117 */
Tcl_GetInterpResolvers, /* 118 */
Tcl_GetNamespaceResolvers, /* 119 */
Tcl_FindNamespaceVar, /* 120 */
TclForgetImport, /* 121 */
TclGetCommandFromObj, /* 122 */
TclGetCommandFullName, /* 123 */
TclGetCurrentNamespace_, /* 124 */
TclGetGlobalNamespace_, /* 125 */
0, /* 121 */
0, /* 122 */
0, /* 123 */
0, /* 124 */
0, /* 125 */
Tcl_GetVariableFullName, /* 126 */
TclImport, /* 127 */
0, /* 127 */
Tcl_PopCallFrame, /* 128 */
Tcl_PushCallFrame, /* 129 */
Tcl_RemoveInterpResolvers, /* 130 */
Tcl_SetNamespaceResolvers, /* 131 */
TclpHasSockets, /* 132 */
TclpGetDate, /* 133 */
0, /* 133 */
0, /* 134 */
0, /* 135 */
0, /* 136 */
@@ -627,8 +413,8 @@ static const TclIntStubs tclIntStubs = {
0, /* 155 */
TclRegError, /* 156 */
TclVarTraceExists, /* 157 */
TclSetStartupScriptFileName, /* 158 */
TclGetStartupScriptFileName, /* 159 */
0, /* 158 */
0, /* 159 */
0, /* 160 */
TclChannelTransform, /* 161 */
TclChannelEventScriptInvoker, /* 162 */
@@ -636,8 +422,8 @@ static const TclIntStubs tclIntStubs = {
TclExpandCodeArray, /* 164 */
TclpSetInitialEncodings, /* 165 */
TclListObjSetElement, /* 166 */
TclSetStartupScriptPath, /* 167 */
TclGetStartupScriptPath, /* 168 */
0, /* 167 */
0, /* 168 */
TclpUtfNcmp2, /* 169 */
TclCheckInterpTraces, /* 170 */
TclCheckExecutionTraces, /* 171 */
@@ -647,12 +433,12 @@ static const TclIntStubs tclIntStubs = {
TclCallVarTraces, /* 175 */
TclCleanupVar, /* 176 */
TclVarErrMsg, /* 177 */
TclSetStartupScript, /* 178 */
TclGetStartupScript, /* 179 */
0, /* 178 */
0, /* 179 */
0, /* 180 */
0, /* 181 */
TclpLocaltime, /* 182 */
TclpGmtime, /* 183 */
0, /* 182 */
0, /* 183 */
0, /* 184 */
0, /* 185 */
0, /* 186 */
@@ -705,7 +491,7 @@ static const TclIntStubs tclIntStubs = {
TclGetSrcInfoForPc, /* 233 */
TclVarHashCreateVar, /* 234 */
TclInitVarHashTable, /* 235 */
TclBackgroundException, /* 236 */
0, /* 236 */
TclResetCancellation, /* 237 */
TclNRInterpProc, /* 238 */
TclNRInterpProcCore, /* 239 */
@@ -742,10 +528,10 @@ static const TclIntPlatStubs tclIntPlatStubs = {
TclpOpenFile, /* 7 */
TclUnixWaitForFile, /* 8 */
TclpCreateTempFile, /* 9 */
TclpReaddir, /* 10 */
TclpLocaltime_unix, /* 11 */
TclpGmtime_unix, /* 12 */
TclpInetNtoa, /* 13 */
0, /* 10 */
0, /* 11 */
0, /* 12 */
0, /* 13 */
TclUnixCopyFile, /* 14 */
0, /* 15 */
0, /* 16 */
@@ -766,16 +552,16 @@ static const TclIntPlatStubs tclIntPlatStubs = {
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
TclWinConvertError, /* 0 */
TclWinConvertWSAError, /* 1 */
TclWinGetServByName, /* 2 */
TclWinGetSockOpt, /* 3 */
0, /* 1 */
0, /* 2 */
0, /* 3 */
TclWinGetTclInstance, /* 4 */
TclUnixWaitForFile, /* 5 */
TclWinNToHS, /* 6 */
TclWinSetSockOpt, /* 7 */
0, /* 6 */
0, /* 7 */
TclpGetPid, /* 8 */
TclWinGetPlatformId, /* 9 */
TclpReaddir, /* 10 */
0, /* 9 */
0, /* 10 */
TclGetAndDetachPids, /* 11 */
TclpCloseFile, /* 12 */
TclpCreateCommandChannel, /* 13 */
@@ -786,14 +572,14 @@ static const TclIntPlatStubs tclIntPlatStubs = {
TclpMakeFile, /* 18 */
TclpOpenFile, /* 19 */
TclWinAddProcess, /* 20 */
TclpInetNtoa, /* 21 */
0, /* 21 */
TclpCreateTempFile, /* 22 */
0, /* 23 */
TclWinNoBackslash, /* 24 */
0, /* 25 */
TclWinSetInterfaces, /* 26 */
0, /* 26 */
TclWinFlushDirtyChannels, /* 27 */
TclWinResetInterfaces, /* 28 */
0, /* 28 */
TclWinCPUID, /* 29 */
TclUnixOpenTemporaryFile, /* 30 */
#endif /* WIN */
@@ -808,10 +594,10 @@ static const TclIntPlatStubs tclIntPlatStubs = {
TclpOpenFile, /* 7 */
TclUnixWaitForFile, /* 8 */
TclpCreateTempFile, /* 9 */
TclpReaddir, /* 10 */
TclpLocaltime_unix, /* 11 */
TclpGmtime_unix, /* 12 */
TclpInetNtoa, /* 13 */
0, /* 10 */
0, /* 11 */
0, /* 12 */
0, /* 13 */
TclUnixCopyFile, /* 14 */
TclMacOSXGetFileAttribute, /* 15 */
TclMacOSXSetFileAttribute, /* 16 */
@@ -912,9 +698,9 @@ const TclTomMathStubs tclTomMathStubs = {
TclBN_mp_init_set_int, /* 61 */
TclBN_mp_set_int, /* 62 */
TclBN_mp_cnt_lsb, /* 63 */
TclBNInitBignumFromLong, /* 64 */
TclBNInitBignumFromWideInt, /* 65 */
TclBNInitBignumFromWideUInt, /* 66 */
0, /* 64 */
0, /* 65 */
0, /* 66 */
TclBN_mp_expt_d_ex, /* 67 */
TclBN_mp_set_long_long, /* 68 */
TclBN_mp_get_long_long, /* 69 */
@@ -969,11 +755,11 @@ const TclStubs tclStubs = {
Tcl_DbDecrRefCount, /* 19 */
Tcl_DbIncrRefCount, /* 20 */
Tcl_DbIsShared, /* 21 */
Tcl_DbNewBooleanObj, /* 22 */
0, /* 22 */
Tcl_DbNewByteArrayObj, /* 23 */
Tcl_DbNewDoubleObj, /* 24 */
Tcl_DbNewListObj, /* 25 */
Tcl_DbNewLongObj, /* 26 */
0, /* 26 */
Tcl_DbNewObj, /* 27 */
Tcl_DbNewStringObj, /* 28 */
Tcl_DuplicateObj, /* 29 */
@@ -996,21 +782,21 @@ const TclStubs tclStubs = {
Tcl_ListObjIndex, /* 46 */
Tcl_ListObjLength, /* 47 */
Tcl_ListObjReplace, /* 48 */
Tcl_NewBooleanObj, /* 49 */
0, /* 49 */
Tcl_NewByteArrayObj, /* 50 */
Tcl_NewDoubleObj, /* 51 */
Tcl_NewIntObj, /* 52 */
0, /* 52 */
Tcl_NewListObj, /* 53 */
Tcl_NewLongObj, /* 54 */
0, /* 54 */
Tcl_NewObj, /* 55 */
Tcl_NewStringObj, /* 56 */
Tcl_SetBooleanObj, /* 57 */
0, /* 57 */
Tcl_SetByteArrayLength, /* 58 */
Tcl_SetByteArrayObj, /* 59 */
Tcl_SetDoubleObj, /* 60 */
Tcl_SetIntObj, /* 61 */
0, /* 61 */
Tcl_SetListObj, /* 62 */
Tcl_SetLongObj, /* 63 */
0, /* 63 */
Tcl_SetObjLength, /* 64 */
Tcl_SetStringObj, /* 65 */
Tcl_AddErrorInfo, /* 66 */
@@ -1024,7 +810,7 @@ const TclStubs tclStubs = {
Tcl_AsyncMark, /* 74 */
Tcl_AsyncReady, /* 75 */
Tcl_BackgroundError, /* 76 */
Tcl_Backslash, /* 77 */
0, /* 77 */
Tcl_BadChannelOption, /* 78 */
Tcl_CallWhenDeleted, /* 79 */
Tcl_CancelIdleCall, /* 80 */
@@ -1042,7 +828,7 @@ const TclStubs tclStubs = {
Tcl_CreateEventSource, /* 92 */
Tcl_CreateExitHandler, /* 93 */
Tcl_CreateInterp, /* 94 */
Tcl_CreateMathFunc, /* 95 */
0, /* 95 */
Tcl_CreateObjCommand, /* 96 */
Tcl_CreateSlave, /* 97 */
Tcl_CreateTimerHandler, /* 98 */
@@ -1078,7 +864,7 @@ const TclStubs tclStubs = {
Tcl_ErrnoMsg, /* 128 */
Tcl_Eval, /* 129 */
Tcl_EvalFile, /* 130 */
Tcl_EvalObj, /* 131 */
0, /* 131 */
Tcl_EventuallyFree, /* 132 */
Tcl_Exit, /* 133 */
Tcl_ExposeCommand, /* 134 */
@@ -1133,7 +919,7 @@ const TclStubs tclStubs = {
Tcl_GetVar, /* 175 */
Tcl_GetVar2, /* 176 */
Tcl_GlobalEval, /* 177 */
Tcl_GlobalEvalObj, /* 178 */
0, /* 178 */
Tcl_HideCommand, /* 179 */
Tcl_Init, /* 180 */
Tcl_InitHashTable, /* 181 */
@@ -1175,7 +961,7 @@ const TclStubs tclStubs = {
Tcl_ResetResult, /* 217 */
Tcl_ScanElement, /* 218 */
Tcl_ScanCountedElement, /* 219 */
Tcl_SeekOld, /* 220 */
0, /* 220 */
Tcl_ServiceAll, /* 221 */
Tcl_ServiceEvent, /* 222 */
Tcl_SetAssocData, /* 223 */
@@ -1201,7 +987,7 @@ const TclStubs tclStubs = {
Tcl_SplitPath, /* 243 */
Tcl_StaticPackage, /* 244 */
Tcl_StringMatch, /* 245 */
Tcl_TellOld, /* 246 */
0, /* 246 */
Tcl_TraceVar, /* 247 */
Tcl_TraceVar2, /* 248 */
Tcl_TranslateFileName, /* 249 */
@@ -1222,18 +1008,18 @@ const TclStubs tclStubs = {
Tcl_WrongNumArgs, /* 264 */
Tcl_DumpActiveMemory, /* 265 */
Tcl_ValidateAllMemory, /* 266 */
Tcl_AppendResultVA, /* 267 */
Tcl_AppendStringsToObjVA, /* 268 */
0, /* 267 */
0, /* 268 */
Tcl_HashStats, /* 269 */
Tcl_ParseVar, /* 270 */
Tcl_PkgPresent, /* 271 */
Tcl_PkgPresentEx, /* 272 */
Tcl_PkgProvide, /* 273 */
Tcl_PkgRequire, /* 274 */
Tcl_SetErrorCodeVA, /* 275 */
Tcl_VarEvalVA, /* 276 */
0, /* 275 */
0, /* 276 */
Tcl_WaitPid, /* 277 */
Tcl_PanicVA, /* 278 */
0, /* 278 */
Tcl_GetVersion, /* 279 */
Tcl_InitMemory, /* 280 */
Tcl_StackChannel, /* 281 */
@@ -1296,8 +1082,8 @@ const TclStubs tclStubs = {
Tcl_WriteChars, /* 338 */
Tcl_WriteObj, /* 339 */
Tcl_GetString, /* 340 */
Tcl_GetDefaultEncodingDir, /* 341 */
Tcl_SetDefaultEncodingDir, /* 342 */
0, /* 341 */
0, /* 342 */
Tcl_AlertNotifier, /* 343 */
Tcl_ServiceModeHook, /* 344 */
Tcl_UniCharIsAlnum, /* 345 */
@@ -1312,7 +1098,7 @@ const TclStubs tclStubs = {
Tcl_UniCharToUtfDString, /* 354 */
Tcl_UtfToUniCharDString, /* 355 */
Tcl_GetRegExpFromObj, /* 356 */
Tcl_EvalTokens, /* 357 */
0, /* 357 */
Tcl_FreeParse, /* 358 */
Tcl_LogCommandInfo, /* 359 */
Tcl_ParseBraces, /* 360 */
@@ -1376,8 +1162,8 @@ const TclStubs tclStubs = {
Tcl_IsChannelExisting, /* 418 */
Tcl_UniCharNcasecmp, /* 419 */
Tcl_UniCharCaseMatch, /* 420 */
Tcl_FindHashEntry, /* 421 */
Tcl_CreateHashEntry, /* 422 */
0, /* 421 */
0, /* 422 */
Tcl_InitCustomHashTable, /* 423 */
Tcl_InitObjHashTable, /* 424 */
Tcl_CommandTraceInfo, /* 425 */
@@ -1390,8 +1176,8 @@ const TclStubs tclStubs = {
Tcl_AttemptSetObjLength, /* 432 */
Tcl_GetChannelThread, /* 433 */
Tcl_GetUnicodeFromObj, /* 434 */
Tcl_GetMathFuncInfo, /* 435 */
Tcl_ListMathFuncs, /* 436 */
0, /* 435 */
0, /* 436 */
Tcl_SubstObj, /* 437 */
Tcl_DetachChannel, /* 438 */
Tcl_IsStandardChannel, /* 439 */
+2 -2
View File
@@ -66,8 +66,8 @@ Tcl_InitStubs(
*/
if (!stubsPtr || (stubsPtr->magic != (((exact&0xff00) >= 0x900) ? magic : TCL_STUB_MAGIC))) {
iPtr->result = (char *)"interpreter uses an incompatible stubs mechanism";
iPtr->freeProc = 0;
iPtr->legacyResult = "interpreter uses an incompatible stubs mechanism";
iPtr->legacyFreeProc = 0; /* TCL_STATIC */
return NULL;
}
+6 -10
View File
@@ -161,7 +161,7 @@ static TestChannel *firstDetached;
static int AsyncHandlerProc(ClientData clientData,
Tcl_Interp *interp, int code);
#if TCL_THREADS
#ifdef TCL_THREADS
static Tcl_ThreadCreateType AsyncThreadProc(ClientData);
#endif
static void CleanupTestSetassocdataTests(
@@ -722,7 +722,7 @@ Tcltest_Init(
if (Procbodytest_Init(interp) != TCL_OK) {
return TCL_ERROR;
}
#if TCL_THREADS
#ifdef TCL_THREADS
if (TclThread_Init(interp) != TCL_OK) {
return TCL_ERROR;
}
@@ -902,7 +902,7 @@ TestasyncCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], -1));
Tcl_MutexUnlock(&asyncTestMutex);
return code;
#if TCL_THREADS
#ifdef TCL_THREADS
} else if (strcmp(argv[1], "marklater") == 0) {
if (argc != 3) {
goto wrongNumArgs;
@@ -999,7 +999,7 @@ AsyncHandlerProc(
*----------------------------------------------------------------------
*/
#if TCL_THREADS
#ifdef TCL_THREADS
static Tcl_ThreadCreateType
AsyncThreadProc(
ClientData clientData) /* Parameter is the id of a
@@ -5075,7 +5075,6 @@ TestsaveresultCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
Interp* iPtr = (Interp*) interp;
int discard, result, index;
Tcl_SavedResult state;
Tcl_Obj *objPtr;
@@ -5143,12 +5142,9 @@ TestsaveresultCmd(
}
switch ((enum options) index) {
case RESULT_DYNAMIC: {
int presentOrFreed = (iPtr->freeProc == TestsaveresultFree) ^ freeCount;
Tcl_AppendElement(interp, presentOrFreed ? "presentOrFreed" : "missingOrLeak");
case RESULT_DYNAMIC:
Tcl_AppendElement(interp, freeCount ? "freed" : "leak");
break;
}
case RESULT_OBJECT:
Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr
? "same" : "different");
+1 -1
View File
@@ -34,7 +34,7 @@ static const char procCommand[] = "proc";
* procs
*/
typedef struct CmdTable {
typedef struct {
const char *cmdName; /* command name */
Tcl_ObjCmdProc *proc; /* command proc */
int exportIt; /* if 1, export the command */

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