diff options
53 files changed, 4220 insertions, 3639 deletions
@@ -1,7 +1,57 @@ +2007-11-19 Don Porter <dgp@users.sourceforge.net> + + *** 8.5b3 TAGGED FOR RELEASE *** + + * README: Bump version number to 8.5b3. + * generic/tcl.h: + * library/init.tcl: + * tools/tcl.wse.in: + * unix/configure.in: + * unix/tcl.spec: + * win/configure.in: + + * unix/configure: autoconf (2.59) + * win/configure: + + * changes: Updated for 8.5b3 release. + +2007-11-19 Kevin Kenny <kennykb@users.sourceforge.net> + + * library/tzdata/Africa/Cairo: + * library/tzdata/America/Campo_Grande: + * library/tzdata/America/Caracas: + * library/tzdata/America/Cuiaba: + * library/tzdata/America/Havana: + * library/tzdata/America/Sao_Paulo: + * library/tzdata/Asia/Damascus: + * library/tzdata/Asia/Gaza: + * library/tzdata/Asia/Tehran: Olson's tzdata2007i imported. + +2007-11-18 Daniel Steffen <das@users.sourceforge.net> + + * generic/tclExecute.c (TclExecuteByteCode:INST_EXIST_*): Fix read + traces not firing on non-existent array elements. [Bug 1833522] + +2007-11-16 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * generic/tclCmdIL.c (TclInitInfoCmd): Rename the implementation + commands for [info] to be something more "expected". + + * generic/tclCompCmds.c (TclCompileInfoExistsCmd): Compiler for the + [info exists] subcommand. + (TclCompileEnsemble): Cleaned up version of ensemble compiler that was + in TclCompileInfoCmd, but which is now much more generally applicable. + + * generic/tclInt.h (ENSEMBLE_COMPILE): Added flag to allow for cleaner + turning on and off of ensemble bytecode compilation. + + * generic/tclCompile.c (TclCompileScript): Add the cmdPtr to the list + of arguments passed to command compilers. + 2007-11-15 Don Porter <dgp@users.sourceforge.net> * generic/regc_nfa.c: Fixed infinite loop in the regexp compiler. - [Bug 1810038]. + [Bug 1810038] * generic/regc_nfa.c: Corrected looping logic in fixempties() to avoid wasting time walking a list of dead states. [Bug 1832612] @@ -20,8 +70,8 @@ 2007-11-15 Pat Thoyts <patthoyts@users.sourceforge.net> - * win/tclWin32Dll.c: Prefer UINT_PTR to DWORD_PTR when casting - pointers to integer types for greater portability. [Bug 1831253] + * win/tclWin32Dll.c: Prefer UINT_PTR to DWORD_PTR when casting pointers + to integer types for greater portability. [Bug 1831253] 2007-11-15 Daniel Steffen <das@users.sourceforge.net> @@ -30,9 +80,9 @@ 2007-11-14 Donal K. Fellows <donal.k.fellows@man.ac.uk> - * generic/tclCompile.c (TclCompileScript): Ensure that we get our - count in our INST_START_CMD calls right, even when there's a failure - to compile a command directly. + * generic/tclCompile.c (TclCompileScript): Ensure that we get our count + in our INST_START_CMD calls right, even when there's a failure to + compile a command directly. * generic/tclNamesp.c (Tcl_SetEnsembleSubcommandList) (Tcl_SetEnsembleMappingDict): Special code to make sure that @@ -41,6 +91,7 @@ * generic/tclCompCmds.c (TclCompileInfoCmd): Simple compiler for the [info] command that only handles [info exists]. + * generic/tclExecute.c (TclExecuteByteCode:INST_EXIST_*): New instructions to allow the testing of whether a variable exists. @@ -59,8 +110,8 @@ 2007-11-13 Jeff Hobbs <jeffh@ActiveState.com> - * generic/tclCompCmds.c (TclCompileRegexpCmd): clean up comments, - only free dstring on OK from TclReToGlob. + * generic/tclCompCmds.c (TclCompileRegexpCmd): clean up comments, only + free dstring on OK from TclReToGlob. (TclCompileSwitchCmd): simplify TclReToGlob usage. 2007-11-14 Donal K. Fellows <dkf@users.sf.net> @@ -86,9 +137,9 @@ 2007-11-13 Pat Thoyts <patthoyts@users.sourceforge.net> - * unix/tcl.m4: Added autoconf goo to detect and make use of - * unix/configure.in: getaddrinfo and friends. - * unix/configure: (regenerated) + * unix/tcl.m4: Added autoconf goo to detect and make use of + * unix/configure.in: getaddrinfo and friends. + * unix/configure: (regenerated) 2007-11-13 Donal K. Fellows <donal.k.fellows@man.ac.uk> @@ -104,61 +155,59 @@ 2007-11-13 Donal K. Fellows <donal.k.fellows@man.ac.uk> * unix/tclUnixChan.c (CreateSocketAddress): Rewrote to use the - thread-safe version of gethostbyname() by forward-porting the code - used in 8.4, and added rudimentary support for getaddrinfo() (not - enabled by default, as no autoconf-ery written). Part of fix for [Bug - 1618235] + thread-safe version of gethostbyname() by forward-porting the code used + in 8.4, and added rudimentary support for getaddrinfo() (not enabled by + default, as no autoconf-ery written). Part of fix for [Bug 1618235]. 2007-11-12 Jeff Hobbs <jeffh@ActiveState.com> - * generic/tclGet.c (Tcl_Get, Tcl_GetInt): revert use of TclGet* - macros due to compiler warning. These cases won't save time either. + * generic/tclGet.c (Tcl_Get, Tcl_GetInt): revert use of TclGet* macros + due to compiler warning. These cases won't save time either. - * generic/tclUtil.c (TclReToGlob): add more comments, set interp - result if specified on error. + * generic/tclUtil.c (TclReToGlob): add more comments, set interp result + if specified on error. 2007-11-12 Miguel Sofer <msofer@users.sf.net> - * generic/tclBasic.c: New macro TclResetResult, new iPtr flag - * generic/tclExecute.c: bit INTERP_RESULT_UNCLEAN: shortcut for - * generic/tclInt.h: Tcl_ResetResult for the "normal" case: - * generic/tclProc.c: TCL_OK, no return options, no errorCode - * generic/tclResult.c: nor errorInfo, return at normal level. - * generic/tclStubLib.c: [Patch 1830184] + * generic/tclBasic.c: New macro TclResetResult, new iPtr flag + * generic/tclExecute.c: bit INTERP_RESULT_UNCLEAN: shortcut for + * generic/tclInt.h: Tcl_ResetResult for the "normal" case: + * generic/tclProc.c: TCL_OK, no return options, no errorCode + * generic/tclResult.c: nor errorInfo, return at normal level. + * generic/tclStubLib.c: [Patch 1830184] * generic/tclUtil.c: THIS PATCH WAS REVERTED: initial (mis)measurements overstated the - perfomance wins, which turn out to be tiny. Not worth the - complication. + perfomance wins, which turn out to be tiny. Not worth the complication. 2007-11-11 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclCompCmds.c, generic/tclCompile.c, generic/tclCompile.h: * generic/tclExecute.c, generic/tclInt.decls, generic/tclIntDecls.h: - * generic/tclRegexp.c, generic/tclRegexp.h: Add INST_REGEXP and fully - * generic/tclStubInit.c, generic/tclUtil.c: compiled [regexp] for the - * tests/regexpComp.test: [Bug 1830166] simple cases. Also - added TclReToGlob function to convert RE to glob patterns and use - these in the possible cases. + * generic/tclRegexp.c, generic/tclRegexp.h: Add INST_REGEXP and + * generic/tclStubInit.c, generic/tclUtil.c: fully compiled [regexp] + * tests/regexpComp.test: for the simple cases. + Also added TclReToGlob function to convert RE to glob patterns and use + these in the possible cases. [Bug 1830166] 2007-11-11 Miguel Sofer <msofer@users.sf.net> * generic/tclResult.c (ResetObjResult): clarify the logic. - * generic/tclBasic.c: Increased usage of macros to detect - * generic/tclBinary.c: and take advantage of objTypes. Added - * generic/tclClock.c: macros TclGet(Int|Long)FromObj, - * generic/tclCmdAH.c: TclGetIntForIndexM and TclListObjLength, - * generic/tclCmdIL.c: modified TclListObjGetElements. + * generic/tclBasic.c: Increased usage of macros to detect + * generic/tclBinary.c: and take advantage of objTypes. Added + * generic/tclClock.c: macros TclGet(Int|Long)FromObj, + * generic/tclCmdAH.c: TclGetIntForIndexM & TclListObjLength, + * generic/tclCmdIL.c: modified TclListObjGetElements. * generic/tclCmdMZ.c: - * generic/tclCompCmds.c: The TclGetInt* macros are only a shortcut - * generic/tclCompExpr.c: on platforms where 'long' is 'int'; it may - * generic/tclCompile.c: be worthwhile to extend their functionality - * generic/tclDictObj.c: also to other cases. + * generic/tclCompCmds.c: The TclGetInt* macros are only a + * generic/tclCompExpr.c: shortcut on platforms where 'long' is + * generic/tclCompile.c: 'int'; it may be worthwhile to extend + * generic/tclDictObj.c: their functionality to other cases. * generic/tclExecute.c: - * generic/tclGet.c: As this patch touches many files it has - * generic/tclIO.c: been recorded as [Patch 1830038] in order - * generic/tclIOCmd.c: to facilitate reviewing. + * generic/tclGet.c: As this patch touches many files it has + * generic/tclIO.c: been recorded as [Patch 1830038] in + * generic/tclIOCmd.c: order to facilitate reviewing. * generic/tclIOGT.c: * generic/tclIndexObj.c: * generic/tclInt.h: @@ -189,8 +238,8 @@ 2007-11-10 Miguel Sofer <msofer@users.sf.net> - * generic/tclExecute.c: Fast path for INST_LIST_INDEX when the index - is not a list. + * generic/tclExecute.c: Fast path for INST_LIST_INDEX when the index is + not a list. * generic/tclBasic.c: * unix/configure.in: @@ -204,8 +253,8 @@ * tests/interp.test: * unix/tclUnixInit.c: * win/tclWin32Dll.c: Restore simpler behaviour for stack checking, not - adaptive to stack size changes after a thread is launched. Consensus - is that "nobody does that", and so it is not worth the cost. Improved + adaptive to stack size changes after a thread is launched. Consensus is + that "nobody does that", and so it is not worth the cost. Improved failure comments (mistachkin). 2007-11-10 Kevin Kenny <kennykb@acm.org> @@ -214,10 +263,10 @@ use information from VirtualQuery to determine the bound of the stack. This change fixes a bug where the guard page of the stack was never restored after an overflow. It also eliminates a nasty piece of - assembly code for structured exception handling on mingw. It - introduces an assumption that the stack is a single memory arena - returned from VirtualAlloc, but the code in MSVCRT makes the same - assumption, so it should be fairly safe. + assembly code for structured exception handling on mingw. It introduces + an assumption that the stack is a single memory arena returned from + VirtualAlloc, but the code in MSVCRT makes the same assumption, so it + should be fairly safe. 2007-11-10 Miguel Sofer <msofer@users.sf.net> @@ -227,9 +276,9 @@ * unix/tclUnixPort.h: * win/tclWin32Dll.c: Modify the stack checking algorithm to recheck in case of failure. The working assumptions are now that (a) a thread's - stack is never moved, and (b) a thread's stack can grow but not - shrink. Port to windows - could be more efficient, but is already - cheaper than it was. + stack is never moved, and (b) a thread's stack can grow but not shrink. + Port to windows - could be more efficient, but is already cheaper than + it was. 2007-11-09 Miguel Sofer <msofer@users.sf.net> @@ -242,8 +291,8 @@ * generic/tclUnixInit.c: * generic/tclUnixPort.h: New fields in interp (ekeko!) to cache TSD data that is accessed at each command invocation, access macros to - replace Tcl_AsyncReady and TclpCheckStackSpace by much faster - variants. [Patch 1829248] + replace Tcl_AsyncReady and TclpCheckStackSpace by much faster variants. + [Patch 1829248] 2007-11-09 Jeff Hobbs <jeffh@ActiveState.com> @@ -257,12 +306,12 @@ 2007-11-07 Jeff Hobbs <jeffh@ActiveState.com> - * generic/tclStubInit.c: Added TclByteArrayMatch - * generic/tclInt.decls: for efficient glob - * generic/tclIntDecls.h: matching of ByteArray - * generic/tclUtil.c (TclByteArrayMatch): Tcl_Objs, used in - * generic/tclExecute.c (TclExecuteByteCode): INST_STR_MATCH. [Bug - 1827996] + * generic/tclStubInit.c: Added TclByteArrayMatch + * generic/tclInt.decls: for efficient glob + * generic/tclIntDecls.h: matching of ByteArray + * generic/tclUtil.c (TclByteArrayMatch): Tcl_Objs, used in + * generic/tclExecute.c (TclExecuteByteCode): INST_STR_MATCH. [Bug + 1827996] * generic/tclIO.c (TclGetsObjBinary): Add an efficient binary path for [gets]. @@ -286,9 +335,8 @@ * unix/tclUnixChan.c (TtyGetOptionProc): Accepted [Patch 1823576] provided by Stuart Cassof <stwo@users.sourceforge.net>. The patch adds - the necessary utf/external conversions to the handling of the - arguments of option -xchar which will allow the use of \0 and similar - characters. + the necessary utf/external conversions to the handling of the arguments + of option -xchar which will allow the use of \0 and similar characters. 2007-11-03 Miguel Sofer <msofer@users.sf.net> @@ -5,7 +5,7 @@ README: Tcl You can get any source release of Tcl from the file distributions link at the above URL. -RCS: @(#) $Id: README,v 1.59.2.4 2007/10/27 04:11:46 dgp Exp $ +RCS: @(#) $Id: README,v 1.59.2.5 2007/11/21 06:30:43 dgp Exp $ Contents -------- @@ -1,6 +1,6 @@ Recent user-visible changes to Tcl: -RCS: @(#) $Id: changes,v 1.116.2.3 2007/10/27 04:11:46 dgp Exp $ +RCS: @(#) $Id: changes,v 1.116.2.4 2007/11/21 06:30:44 dgp Exp $ 1. No more [command1] [command2] construct for grouping multiple commands on a single command line. @@ -6842,83 +6842,84 @@ URL validity checking against RFC 2986 (hobbs) --- Released 8.5a5, October 20, 2006 --- See ChangeLog for details --- 2006-10-20 (configure change) Added autodetection for OS-supplied timezone -files. +files (max) 2006-10-23 (enhancement)[1577278] Ensure the Tcl call stack always has a -CallFrame, even at level 0. +CallFrame, even at level 0 (sofer) *** POTENTIAL INCOMPATIBILITY for users of tclInt.h *** 2006-10-23 (enhancement)[1577492] Tcl_PushCallFrame and [info level] -enhanced for ensemble rewrites. +enhanced for ensemble rewrites (sofer) *** POTENTIAL INCOMPATIBILITY for [info level 0] on interp alias *** -2006-11-02 (feature change)[TIP 293] Replace {expand} with {*} +2006-11-02 (feature change)[TIP 293] Replace {expand} with {*} (hobbs) *** POTENTIAL INCOMPATIBILITY with previous 8.5 alphas only *** -2006-11-04 (new feature)[TIP 274] Expression operator is right associative. +2006-11-04 (new feature)[TIP 274] Exponentiation operator is right +associative (porter) 2006-11-09 (new feature)[TIP 272] Added [lreverse] and [string reverse] -commands. +commands (fellows) 2006-11-14 (new feature)[TIP 261] [namespace import] returns list of -imported commands. +imported commands (porter) 2006-11-15 (new feature)[TIP 270] New C routines Tcl_ObjPrintf, Tcl_AppendObjToErrorInfo, Tcl_Format, Tcl_AppendLimitedToObj, -Tcl_AppendFormatToObj, Tcl_AppendPrintfToObj. +Tcl_AppendFormatToObj, Tcl_AppendPrintfToObj (porter) -2006-11-22 (feature change) Moved TCL_REG_BOSONLY from tcl.h to tclInt.h +2006-11-22 (feature change) Moved TCL_REG_BOSONLY from tcl.h to tclInt (porter) 2006-11-22 (new feature)[TIP 269] Added [string is list] classification -command. +command (mistackin, fellows) 2006-11-25 (new feature)[TIP 174] Added commands corresponding to most -expr operators in ::tcl::mathop. +expr operators in ::tcl::mathop (fellows) -2006-11-26 (platform support)[1230558] --enable-64bit on more systems. +2006-11-26 (platform support)[1230558] --enable-64bit on more systems (steffen) 2006-11-27 (bug fix)[1602208] Fix 64-bit handling of select() on unix where -fd was greater than 32. +fd was greater than 32 (fontaine, kenny) 2006-11-28 (new feature)[TIP 280] Added [info frame] command for more -Tcl-level debugging information. +Tcl-level debugging information (kupries) 2006-12-01 (feature change)[TIP 298] Change Tcl_GetBignumAndClearObj to -Tcl_TakeBignumFromObj. +Tcl_TakeBignumFromObj (porter) -2006-12-01 (new feature)[TIP 287] Added [chan pending] subcommand. +2006-12-01 (new feature)[TIP 287] Added [chan pending] subcommand (cleverly) -2006-12-01 (new feature)[TIP 299] Added isqrt() expr operator. +2006-12-01 (new feature)[TIP 299] Added isqrt() expr operator (kenny) -2006-12-04 (new feature)[TIP 267] Added -ignorestderr option to exec. +2006-12-04 (new feature)[TIP 267] Added -ignorestderr option to exec (fellows) -2006-12-05 (new feature)[TIP 291] Added ::tcl_platform(pointerSize) key. +2006-12-05 (new feature)[TIP 291] ::tcl_platform(pointerSize) key (kupries) -2007-01-11 (configure change) Remove "-Wconversion" from default CFLAGS. +2007-01-11 (configure change) Remove "-Wconversion" from deflt CFLAGS (english) -2007-01-25 (configure change) Ensure CPPFLAGS env var is used when set. +2007-01-25 (configure change) Ensure CPPFLAGS env var is used when set (steffen) 2007-02-19 (configure change) Use SHLIB_SUFFIX=".so" on HP-UX IA64 (was -".sl"). +".sl") (hobbs) -2007-02-20 (bug fix)[1479814] Handle Windows NT \\?\... extended paths. +2007-02-20 (bug fix)[1479814] Handle Windows NT \\?\... extended paths (thoyts) 2007-03-01 (bug fix)[1671138] Fix infinite loop in compiled foreach with an -empty list. +empty list (fellows) 2007-03-07 (enhancement) Improved Windows time zone tables to handle new US -DST rules. +DST rules (kenny) -2007-03-09 (enhancement) Improved Y2038 compliance of zoneinfo files. +2007-03-09 (enhancement) Improved Y2038 compliance of zoneinfo files (kenny) 2007-04-02 (enhancement) Added bytecode compilation for global, variable, -upvar and namespace upvar. +upvar and namespace upvar (sofer) -2007-04-20 (bug fix) Improve clock localization for Japanese locale. +2007-04-20 (bug fix) Improve clock localization for Japanese locale (kenny) -2007-04-20 (enhancement) Documented Tcl_SetNotifier and Tcl_ServiceModeHook. +2007-04-20 (enhancement) Document Tcl_SetNotifier & Tcl_ServiceModeHook (kenny) -2007-04-23 (bug fix) Workaround crashing bug in fts_open() on 64bit Darwin. +2007-04-23 (bug fix) fts_open() crash on 64bit Darwin 8 or earlier (steffen) --- Released 8.5a6, April 25, 2007 --- See ChangeLog for details --- @@ -7021,7 +7022,7 @@ project for Xcode 3.0 (steffen) 2007-09-17 (platform support)[1748251] Fix NetBSD link failures (english) (bug fix)[1066755] Several stack efficiency efforts increases recursion limit -on Windows to be larger than the default [interp recursionlimit] value. +on Windows to be larger than the default [interp recursionlimit] value --- Released 8.5b1, September 26, 2007 --- See ChangeLog for details --- @@ -7036,3 +7037,39 @@ on Windows to be larger than the default [interp recursionlimit] value. 2007-10-25 (bug fix)[1726873] intermittent crash in threads (vasiljevic) --- Released 8.5b2, October 26, 2007 --- See ChangeLog for details --- + +2007-10-27 (bug fix)[1821159] fixed broken compile on x86_64 (sofer) + +2007-10-27 (bug fix)[1810264] stop panic in RE lexer (fellows) + +2007-10-28 (enhancement)[1826906] Embed iso8859-1 encoding in libtcl (fellows) + +2007-11-01 (bug fix)[1808258] [string is ascii \000] (fellows) + +2007-11-05 (bug fix)[1823576] [fconfigure $serial -xchar \000] (cassof) + +2007-11-07 (performance)[1827996] binary glob matching (hobbs) + +2007-11-07 (performance) binary [gets] (hobbs) + +2007-11-09 (performance)[1829248] interp state reset (sofer) + +2007-11-10 (performance) stack checking (sofer) + +2007-11-10 (performance) list indexing bytecode (sofer) + +2007-11-11 (performance)[1830038] macros to fetch Tcl_Obj intreps (sofer) + +2007-11-11 (performance)[1830166] RE bytecode for simple cases (hobbs) + +2007-11-13 (performance) [switch] & [regexp] use RE bytecode (hobbs, fellows) + +2007-11-14 (performance) bytecode for [info exists] (fellows) + +2007-11-15 (new feature)[1231022] configure option: --disable-rpath (fellows) + +2007-11-15 (bug fix)[1810038] infinite loop in RE compiler (lane,porter) + +Many significant documentation improvements (fellows, sofer) + +--- Released 8.5b3, November 19, 2007 --- See ChangeLog for details --- diff --git a/doc/binary.n b/doc/binary.n index 46dc26a..652cabb 100644 --- a/doc/binary.n +++ b/doc/binary.n @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: binary.n,v 1.29.6.1 2007/11/01 16:25:48 dgp Exp $ +'\" RCS: @(#) $Id: binary.n,v 1.29.6.2 2007/11/21 06:30:44 dgp Exp $ '\" .so man.macros .TH binary n 8.0 Tcl "Tcl Built-In Commands" @@ -69,9 +69,10 @@ Stores a byte string of length \fIcount\fR in the output string. Every character is taken as modulo 256 (i.e. the low byte of every character is used, and the high byte discarded) so when storing character strings not wholly expressible using the characters \eu0000-\eu00ff, -the \fBencoding convertto\fR command should be used -first if this truncation is not desired (i.e. if the characters are -not part of the ISO 8859-1 character set.) +the \fBencoding convertto\fR command should be used first to change +the string into an external representation +if this truncation is not desired (i.e. if the characters are +not part of the ISO 8859\-1 character set.) If \fIarg\fR has fewer than \fIcount\fR bytes, then additional zero bytes are used to pad out the field. If \fIarg\fR is longer than the specified length, the extra characters will be ignored. If @@ -82,12 +83,24 @@ formatted. For example, .CS \fBbinary format\fR a7a*a alpha bravo charlie .CE -will return a string equivalent to \fBalpha\e000\e000bravoc\fR and +will return a string equivalent to \fBalpha\e000\e000bravoc\fR, .CS \fBbinary format\fR a* [encoding convertto utf-8 \eu20ac] .CE will return a string equivalent to \fB\e342\e202\e254\fR (which is the -UTF-8 byte sequence for a Euro-currency character). +UTF-8 byte sequence for a Euro-currency character) and +.CS +\fBbinary format\fR a* [encoding convertto iso8859-15 \eu20ac] +.CE +will return a string equivalent to \fB\e244\fR (which is the ISO +8859\-15 byte sequence for a Euro-currency character). Contrast these +last two with: +.CS +\fBbinary format\fR a* \eu20ac +.CE +which returns a string equivalent to \fB\e254\fR (i.e. \fB\exac\fR) by +truncating the high-bits of the character, and which is probably not +what is desired. .RE .IP \fBA\fR 5 This form is the same as \fBa\fR except that spaces are used for @@ -158,12 +171,11 @@ will return a string equivalent to \fB\exab\ex00\exde\exf0\fR. .IP \fBc\fR 5 Stores one or more 8-bit integer values in the output string. If no \fIcount\fR is specified, then \fIarg\fR must consist of an integer -value; otherwise \fIarg\fR must consist of a list containing at least -\fIcount\fR integer elements. The low-order 8 bits of each integer +value. If \fIcount\fR is specified, \fIarg\fR must consist of a list +containing at least that many integers. The low-order 8 bits of each integer are stored as a one-byte value at the cursor position. If \fIcount\fR -is \fB*\fR, then all of the integers in the list are formatted. If -the number of elements in the list is fewer than \fIcount\fR, then an -error is generated. If the number of elements in the list is greater +is \fB*\fR, then all of the integers in the list are formatted. If the +number of elements in the list is greater than \fIcount\fR, then the extra elements are ignored. For example, .RS .CS @@ -455,15 +467,21 @@ is \fB*\fR, then all of the remaining bytes in \fIstring\fR will be scanned into the variable. If \fIcount\fR is omitted, then one byte will be scanned. All bytes scanned will be interpreted as being characters in the -range \eu0000-\eu00ff so the \fBencoding convertfrom\fR command might be -needed if the string is not an ISO 8859\-1 string. +range \eu0000-\eu00ff so the \fBencoding convertfrom\fR command will be +needed if the string is not a binary string or a string encoded in ISO +8859\-1. For example, .RS .CS \fBbinary scan\fR abcde\e000fghi a6a10 var1 var2 .CE will return \fB1\fR with the string equivalent to \fBabcde\e000\fR -stored in \fIvar1\fR and \fIvar2\fR left unmodified. +stored in \fIvar1\fR and \fIvar2\fR left unmodified, and +.CS +\fBbinary scan\fR \e342\e202\e254 a* var1 +set var2 [encoding convertfrom utf-8 $var1] +.CE +will store a Euro-currency character in \fIvar2\fR. .RE .IP \fBA\fR 5 This form is the same as \fBa\fR, except trailing blanks and nulls are stripped from @@ -514,10 +532,10 @@ scanned. If \fIcount\fR is omitted, then one hex digit will be scanned. For example, .RS .CS -\fBbinary scan\fR \ex07\ex86\ex05\ex12\ex34 H3H* var1 var2 +\fBbinary scan\fR \ex07\exC6\ex05\ex1f\ex34 H3H* var1 var2 .CE -will return \fB2\fR with \fB078\fR stored in \fIvar1\fR and -\fB051234\fR stored in \fIvar2\fR. +will return \fB2\fR with \fB0c8\fR stored in \fIvar1\fR and +\fB051f34\fR stored in \fIvar2\fR. .RE .IP \fBh\fR 5 This form is the same as \fBH\fR, except the digits are taken in @@ -686,15 +704,15 @@ will return \fB1\fR with \fB1.6000000238418579\fR stored in .VS 8.5 This form is the same as \fBf\fR except that the data is interpreted as \fIcount\fR single-precision floating point number in little-endian -order. This conversion is not portable to systems not using IEEE -floating point representations. +order. This conversion is not portable to the minority of systems not +using IEEE floating point representations. .VE 8.5 .IP \fBR\fR 5 .VS 8.5 This form is the same as \fBf\fR except that the data is interpreted as \fIcount\fR single-precision floating point number in big-endian -order. This conversion is not portable to systems not using IEEE -floating point representations. +order. This conversion is not portable to the minority of systems not +using IEEE floating point representations. .VE 8.5 .IP \fBd\fR 5 This form is the same as \fBf\fR except that the data is interpreted @@ -712,15 +730,15 @@ stored in \fIvar1\fR. .VS 8.5 This form is the same as \fBd\fR except that the data is interpreted as \fIcount\fR double-precision floating point number in little-endian -order. This conversion is not portable to systems not using IEEE -floating point representations. +order. This conversion is not portable to the minority of systems not +using IEEE floating point representations. .VE 8.5 .IP \fBQ\fR 5 .VS 8.5 This form is the same as \fBd\fR except that the data is interpreted as \fIcount\fR double-precision floating point number in big-endian -order. This conversion is not portable to systems not using IEEE -floating point representations. +order. This conversion is not portable to the minority of systems not +using IEEE floating point representations. .VE 8.5 .IP \fBx\fR 5 Moves the cursor forward \fIcount\fR bytes in \fIstring\fR. If diff --git a/doc/tclvars.n b/doc/tclvars.n index a06bc46..6096f8a 100644 --- a/doc/tclvars.n +++ b/doc/tclvars.n @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: tclvars.n,v 1.27.2.1 2007/11/01 16:25:55 dgp Exp $ +'\" RCS: @(#) $Id: tclvars.n,v 1.27.2.2 2007/11/21 06:30:44 dgp Exp $ '\" .so man.macros .TH tclvars n 8.0 Tcl "Tcl Built-In Commands" @@ -64,8 +64,9 @@ additional formats. .RS .TP \fBARITH\fI code msg\fR +. This format is used when an arithmetic error occurs (e.g. an attempt -to divide by zero in the \fBexpr\fR command). +to divide zero by zero in the \fBexpr\fR command). \fICode\fR identifies the precise error and \fImsg\fR provides a human-readable description of the error. \fICode\fR will be either DIVZERO (for an attempt to divide by zero), @@ -73,6 +74,11 @@ DOMAIN (if an argument is outside the domain of a function, such as acos(\-3)), IOVERFLOW (for integer overflow), OVERFLOW (for a floating-point overflow), or UNKNOWN (if the cause of the error cannot be determined). +.RS +.PP +Detection of these errors depends in part on the underlying hardware +and system libraries. +.RE .TP \fBCHILDKILLED\fI pid sigName msg\fR This format is used when a child process has been killed because of @@ -125,10 +131,15 @@ To set the \fB\-errorcode\fR return option, applications should use library procedures such as \fBTcl_SetObjErrorCode\fR, \fBTcl_SetReturnOptions\fR, and \fBTcl_PosixError\fR, or they may invoke the \fB\-errorcode\fR option of the \fBreturn\fR command. -If one of these methods has not been used, then the Tcl -interpreter will reset the variable to \fBNONE\fR after +If none of these methods for setting the error code has been used, +the Tcl interpreter will reset the variable to \fBNONE\fR after the next error. .RE +.\" .TP +.\" \fBTCL\fR ... +.\" . +.\" Indicates some sort of problem generated in relation to Tcl itself, +.\" e.g. a failure to look up a channel or variable. .TP \fBerrorInfo\fR This variable holds the value of the \fB\-errorinfo\fR return option @@ -161,10 +172,11 @@ compiled-in default location, the location of the binary containing the application, and the current working directory. .TP \fBtcl_patchLevel\fR +. When an interpreter is created Tcl initializes this variable to hold a string giving the current patch level for Tcl, such as -\fB7.3p2\fR for Tcl 7.3 with the first two official patches, or -\fB7.4b4\fR for the fourth beta release of Tcl 7.4. +\fB8.4.16\fR for Tcl 8.4 with the first sixteen official patches, or +\fB8.5b3\fR for the third beta release of Tcl 8.5. The value of this variable is returned by the \fBinfo patchlevel\fR command. .TP @@ -305,8 +317,6 @@ Setting it to 2 generates a detailed listing in stdout of the bytecode instructions emitted during every compilation. This variable is useful in tracking down suspected problems with the Tcl compiler. -It is also occasionally useful when converting -existing code to use Tcl8.0. .PP .RS This variable and functionality only exist if @@ -332,8 +342,6 @@ of bytecode instructions are not shown. Setting this variable is useful in tracking down suspected problems with the bytecode compiler and interpreter. -It is also occasionally useful when converting -code to use Tcl8.0. .PP .RS This variable and functionality only exist if diff --git a/generic/tcl.h b/generic/tcl.h index 284621b..91d4a9f 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tcl.h,v 1.231.2.10 2007/10/27 04:11:47 dgp Exp $ + * RCS: @(#) $Id: tcl.h,v 1.231.2.11 2007/11/21 06:30:45 dgp Exp $ */ #ifndef _TCL diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index a7c53f4..7d8a33b 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdIL.c,v 1.115.2.9 2007/11/16 07:20:53 dgp Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.115.2.10 2007/11/21 06:30:48 dgp Exp $ */ #include "tclInt.h" @@ -152,30 +152,31 @@ static Tcl_Obj * SelectObjFromSublist(Tcl_Obj *firstPtr, static const struct { const char *name; /* The name of the subcommand. */ Tcl_ObjCmdProc *proc; /* The implementation of the subcommand. */ + CompileProc *compileProc; /* The compiler for the subcommand. */ } defaultInfoMap[] = { - {"args", InfoArgsCmd}, - {"body", InfoBodyCmd}, - {"cmdcount", InfoCmdCountCmd}, - {"commands", InfoCommandsCmd}, - {"complete", InfoCompleteCmd}, - {"default", InfoDefaultCmd}, - {"exists", TclInfoExistsCmd}, - {"frame", InfoFrameCmd}, - {"functions", InfoFunctionsCmd}, - {"globals", TclInfoGlobalsCmd}, - {"hostname", InfoHostnameCmd}, - {"level", InfoLevelCmd}, - {"library", InfoLibraryCmd}, - {"loaded", InfoLoadedCmd}, - {"locals", TclInfoLocalsCmd}, - {"nameofexecutable",InfoNameOfExecutableCmd}, - {"patchlevel", InfoPatchLevelCmd}, - {"procs", InfoProcsCmd}, - {"script", InfoScriptCmd}, - {"sharedlibextension", InfoSharedlibCmd}, - {"tclversion", InfoTclVersionCmd}, - {"vars", TclInfoVarsCmd}, - {NULL, NULL} + {"args", InfoArgsCmd, NULL}, + {"body", InfoBodyCmd, NULL}, + {"cmdcount", InfoCmdCountCmd, NULL}, + {"commands", InfoCommandsCmd, NULL}, + {"complete", InfoCompleteCmd, NULL}, + {"default", InfoDefaultCmd, NULL}, + {"exists", TclInfoExistsCmd, TclCompileInfoExistsCmd}, + {"frame", InfoFrameCmd, NULL}, + {"functions", InfoFunctionsCmd, NULL}, + {"globals", TclInfoGlobalsCmd, NULL}, + {"hostname", InfoHostnameCmd, NULL}, + {"level", InfoLevelCmd, NULL}, + {"library", InfoLibraryCmd, NULL}, + {"loaded", InfoLoadedCmd, NULL}, + {"locals", TclInfoLocalsCmd, NULL}, + {"nameofexecutable", InfoNameOfExecutableCmd, NULL}, + {"patchlevel", InfoPatchLevelCmd, NULL}, + {"procs", InfoProcsCmd, NULL}, + {"script", InfoScriptCmd, NULL}, + {"sharedlibextension", InfoSharedlibCmd, NULL}, + {"tclversion", InfoTclVersionCmd, NULL}, + {"vars", TclInfoVarsCmd, NULL}, + {NULL, NULL, NULL} }; /* @@ -395,8 +396,13 @@ TclInitInfoCmd( if (tclNsPtr == NULL) { Tcl_Panic("unable to find or create ::tcl namespace!"); } + tclNsPtr = Tcl_FindNamespace(interp, "::tcl::info", NULL, + TCL_CREATE_NS_IF_UNKNOWN); + if (tclNsPtr == NULL) { + Tcl_Panic("unable to find or create ::tcl::info namespace!"); + } ensemble = Tcl_CreateEnsemble(interp, "::info", tclNsPtr, - TCL_ENSEMBLE_PREFIX); + TCL_ENSEMBLE_PREFIX | ENSEMBLE_COMPILE); if (ensemble != NULL) { Tcl_Obj *mapDict; int i; @@ -404,23 +410,19 @@ TclInitInfoCmd( TclNewObj(mapDict); for (i=0 ; defaultInfoMap[i].name != NULL ; i++) { Tcl_Obj *fromObj, *toObj; + Command *cmdPtr; fromObj = Tcl_NewStringObj(defaultInfoMap[i].name, -1); - TclNewLiteralStringObj(toObj, "::tcl::Info_"); + TclNewLiteralStringObj(toObj, "::tcl::info::"); Tcl_AppendToObj(toObj, defaultInfoMap[i].name, -1); Tcl_DictObjPut(NULL, mapDict, fromObj, toObj); - Tcl_CreateObjCommand(interp, TclGetString(toObj), - defaultInfoMap[i].proc, NULL, NULL); + cmdPtr = (Command *) Tcl_CreateObjCommand(interp, + TclGetString(toObj), defaultInfoMap[i].proc, NULL, NULL); + cmdPtr->compileProc = defaultInfoMap[i].compileProc; } Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict); } - /* - * Enable compilation of the [info exists] subcommand. - */ - - ((Command *)ensemble)->compileProc = &TclCompileInfoCmd; - return ensemble; } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index d2bc8e0..cce50ff 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdMZ.c,v 1.150.2.7 2007/11/12 19:18:15 dgp Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.150.2.8 2007/11/21 06:30:48 dgp Exp $ */ #include "tclInt.h" @@ -2957,7 +2957,7 @@ Tcl_SwitchObjCmd( } /* - * TIP #280. Make invoking context available to switch branch. + * TIP #280: Make invoking context available to switch branch. */ result = TclEvalObjEx(interp, objv[j], 0, ctxPtr, j); @@ -3145,6 +3145,22 @@ Tcl_WhileObjCmd( return result; } +/* + *---------------------------------------------------------------------- + * + * TclListLines -- + * + * ??? + * + * Results: + * Filled in array of line numbers? + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + void TclListLines( CONST char *listStr, /* Pointer to string with list structure. diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 9bc0f30..d9314f8 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompCmds.c,v 1.109.2.11 2007/11/16 07:20:53 dgp Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.109.2.12 2007/11/21 06:30:49 dgp Exp $ */ #include "tclInt.h" @@ -224,6 +224,8 @@ TclCompileAppendCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr, *valueTokenPtr; @@ -238,7 +240,7 @@ TclCompileAppendCmd( * append varName == set varName */ - return TclCompileSetCmd(interp, parsePtr, envPtr); + return TclCompileSetCmd(interp, parsePtr, cmdPtr, envPtr); } else if (numWords > 3) { /* * APPEND instructions currently only handle one value. @@ -324,6 +326,8 @@ TclCompileBreakCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { if (parsePtr->numWords != 1) { @@ -361,6 +365,8 @@ TclCompileCatchCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { JumpFixup jumpFixup; @@ -559,6 +565,8 @@ TclCompileContinueCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { /* @@ -600,6 +608,8 @@ TclCompileDictCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr; @@ -1178,6 +1188,8 @@ TclCompileExprCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *firstWordPtr; @@ -1221,6 +1233,8 @@ TclCompileForCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr; @@ -1385,6 +1399,8 @@ TclCompileForeachCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Proc *procPtr = envPtr->procPtr; @@ -1847,6 +1863,8 @@ TclCompileIfCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { JumpFixupArray jumpFalseFixupArray; @@ -2162,6 +2180,8 @@ TclCompileIncrCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr, *incrTokenPtr; @@ -2279,6 +2299,8 @@ TclCompileLappendCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr; @@ -2386,6 +2408,8 @@ TclCompileLassignCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr; @@ -2499,6 +2523,8 @@ TclCompileLindexCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *idxTokenPtr, *valTokenPtr; @@ -2594,6 +2620,8 @@ TclCompileListCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ @@ -2656,6 +2684,8 @@ TclCompileLlengthCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr; @@ -2716,6 +2746,8 @@ TclCompileLsetCmd( Tcl_Interp *interp, /* Tcl interpreter for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the * command. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds the resulting instructions. */ { int tempDepth; /* Depth used for emitting one part of the @@ -2872,6 +2904,8 @@ TclCompileRegexpCmd( Tcl_Interp *interp, /* Tcl interpreter for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the * command. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds the resulting instructions. */ { Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the @@ -3025,6 +3059,8 @@ TclCompileReturnCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { /* @@ -3216,6 +3252,8 @@ TclCompileSetCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr, *valueTokenPtr; @@ -3315,6 +3353,8 @@ TclCompileStringCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ @@ -3534,6 +3574,8 @@ TclCompileSwitchCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr; /* Pointer to tokens in command. */ @@ -4367,6 +4409,8 @@ TclCompileWhileCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *testTokenPtr, *bodyTokenPtr; @@ -5001,6 +5045,8 @@ int TclCompileInvertOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) { return CompileUnaryOpCmd(interp, parsePtr, INST_BITNOT, envPtr); @@ -5010,6 +5056,8 @@ int TclCompileNotOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) { return CompileUnaryOpCmd(interp, parsePtr, INST_LNOT, envPtr); @@ -5019,6 +5067,8 @@ int TclCompileAddOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) { return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_ADD, @@ -5029,6 +5079,8 @@ int TclCompileMulOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) { return CompileAssociativeBinaryOpCmd(interp, parsePtr, "1", INST_MULT, @@ -5039,6 +5091,8 @@ int TclCompileAndOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) { return CompileAssociativeBinaryOpCmd(interp, parsePtr, "-1", INST_BITAND, @@ -5049,6 +5103,8 @@ int TclCompileOrOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) { return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_BITOR, @@ -5059,6 +5115,8 @@ int TclCompileXorOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) { return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_BITXOR, @@ -5069,6 +5127,8 @@ int TclCompilePowOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) { /* @@ -5097,6 +5157,8 @@ int TclCompileLshiftOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) { return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LSHIFT, envPtr); @@ -5106,6 +5168,8 @@ int TclCompileRshiftOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) { return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_RSHIFT, envPtr); @@ -5115,6 +5179,8 @@ int TclCompileModOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) { return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_MOD, envPtr); @@ -5124,6 +5190,8 @@ int TclCompileNeqOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) { return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_NEQ, envPtr); @@ -5133,6 +5201,8 @@ int TclCompileStrneqOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) { return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_STR_NEQ, envPtr); @@ -5142,6 +5212,8 @@ int TclCompileInOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) { return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LIST_IN, envPtr); @@ -5151,6 +5223,8 @@ int TclCompileNiOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) { return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LIST_NOT_IN, @@ -5161,6 +5235,8 @@ int TclCompileLessOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) { return CompileComparisonOpCmd(interp, parsePtr, INST_LT, envPtr); @@ -5170,6 +5246,8 @@ int TclCompileLeqOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) { return CompileComparisonOpCmd(interp, parsePtr, INST_LE, envPtr); @@ -5179,6 +5257,8 @@ int TclCompileGreaterOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) { return CompileComparisonOpCmd(interp, parsePtr, INST_GT, envPtr); @@ -5188,6 +5268,8 @@ int TclCompileGeqOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) { return CompileComparisonOpCmd(interp, parsePtr, INST_GE, envPtr); @@ -5197,6 +5279,8 @@ int TclCompileEqOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) { return CompileComparisonOpCmd(interp, parsePtr, INST_EQ, envPtr); @@ -5206,6 +5290,8 @@ int TclCompileStreqOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) { return CompileComparisonOpCmd(interp, parsePtr, INST_STR_EQ, envPtr); @@ -5215,6 +5301,8 @@ int TclCompileMinusOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) { Tcl_Token *tokenPtr = parsePtr->tokenPtr; @@ -5253,6 +5341,8 @@ int TclCompileDivOpCmd( Tcl_Interp *interp, Tcl_Parse *parsePtr, + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) { Tcl_Token *tokenPtr = parsePtr->tokenPtr; @@ -5308,7 +5398,7 @@ TclCompileDivOpCmd( static int IndexTailVarIfKnown( Tcl_Interp *interp, - Tcl_Token *varTokenPtr, /* Token representing the variable name */ + Tcl_Token *varTokenPtr, /* Token representing the variable name */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Obj *tailPtr; @@ -5406,6 +5496,8 @@ TclCompileUpvarCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr; @@ -5515,6 +5607,8 @@ TclCompileNamespaceCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr; @@ -5605,6 +5699,8 @@ TclCompileGlobalCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr; @@ -5678,6 +5774,8 @@ TclCompileVariableCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr, *valueTokenPtr; @@ -5737,109 +5835,230 @@ TclCompileVariableCmd( /* *---------------------------------------------------------------------- * - * TclCompileInfoCmd -- + * TclCompileEnsemble -- * - * Procedure called to compile the "info" command. Only handles the - * "exists" subcommand. + * Procedure called to compile an ensemble command. * * Results: * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer * evaluation to runtime. * * Side effects: - * Instructions are added to envPtr to execute the "info exists" - * subcommand at runtime. + * Instructions are added to envPtr to execute the subcommands of the + * ensemble at runtime if a compile-time mapping is possible. * *---------------------------------------------------------------------- */ int -TclCompileInfoCmd( +TclCompileEnsemble( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - Tcl_Token *tokenPtr; - int isScalar, simpleVarName, localIndex, numWords; - DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr, *argTokensPtr; + Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems; + Tcl_Command ensemble = (Tcl_Command) cmdPtr; + Tcl_Parse synthetic; + int len, numBytes, result; + const char *word; + + if (parsePtr->numWords < 2) { + return TCL_ERROR; + } + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + /* + * Too hard. + */ - numWords = parsePtr->numWords; - if (numWords != 3) { return TCL_ERROR; } + word = tokenPtr[1].start; + numBytes = tokenPtr[1].size; + /* - * Ensure that the next word is "exists"; that's the only case we will - * deal with. + * There's a sporting chance we'll be able to compile this. But now we + * must check properly. To do that, check that we're compiling an + * ensemble that has [info exists] as its appropriate subcommand. */ - tokenPtr = TokenAfter(parsePtr->tokenPtr); - if (parsePtr->tokenPtr->type == TCL_TOKEN_SIMPLE_WORD && - tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - const char *word = tokenPtr[1].start; - int numBytes = tokenPtr[1].size; - Command *cmdPtr; - Tcl_Obj *mapObj, *existsObj, *targetCmdObj; - Tcl_DString ds; - + if (Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj) != TCL_OK + || mapObj == NULL) { /* - * There's a sporting chance we'll be able to compile this. But now we - * must check properly. To do that, look up what we expect to be - * called (inefficient, should be in context?) and check that that's - * an ensemble that has [info exists] as its appropriate subcommand. + * Either not an ensemble or a mapping isn't installed. Crud. Too hard + * to proceed. */ - Tcl_DStringInit(&ds); - Tcl_DStringAppend(&ds, parsePtr->tokenPtr[1].start, - parsePtr->tokenPtr[1].size); - cmdPtr = (Command *) Tcl_FindCommand(interp, Tcl_DStringValue(&ds), - (Tcl_Namespace *) envPtr->iPtr->globalNsPtr, 0); - Tcl_DStringFree(&ds); - if (cmdPtr == NULL || cmdPtr->compileProc != &TclCompileInfoCmd) { - /* - * Not [info], and can't be bothered to follow rabbit hole of - * renaming. This is an optimization, darnit! - */ + return TCL_ERROR; + } - return TCL_ERROR; - } + TclNewStringObj(subcmdObj, word, numBytes); + if (Tcl_DictObjGet(NULL, mapObj, subcmdObj, &targetCmdObj) != TCL_OK + || targetCmdObj == NULL) { + /* + * We've not got a valid subcommand. + */ - if (Tcl_GetEnsembleMappingDict(interp, (Tcl_Command) cmdPtr, - &mapObj) != TCL_OK || mapObj == NULL) { - /* - * Either not an ensemble or a mapping isn't installed. Crud. Too - * hard to proceed. - */ + TclDecrRefCount(subcmdObj); + return TCL_ERROR; + } + TclDecrRefCount(subcmdObj); - return TCL_ERROR; - } + /* + * The command we map to is the first word out of the map element. Note + * that we reject dealing with lists that are multiple elements long here; + * our rewriting-fu is not yet strong enough. + */ - TclNewStringObj(existsObj, word, numBytes); - if (Tcl_DictObjGet(NULL, mapObj, existsObj, &targetCmdObj) != TCL_OK - || targetCmdObj == NULL) { - /* - * We've not got a valid subcommand. - */ + if (Tcl_ListObjGetElements(NULL, targetCmdObj, &len, &elems) != TCL_OK + || len != 1) { + return TCL_ERROR; + } + targetCmdObj = elems[0]; + Tcl_IncrRefCount(targetCmdObj); - TclDecrRefCount(existsObj); - return TCL_ERROR; - } - TclDecrRefCount(existsObj); + /* + * Check to see if there's also a subcommand list; must check to see if + * the subcommand we are calling is in that list if it exists, since that + * list filters the entries in the map. + */ - cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, targetCmdObj); - if (cmdPtr == NULL || cmdPtr->objProc != &TclInfoExistsCmd) { - /* - * Maps to something unexpected. Help! - */ + (void) Tcl_GetEnsembleSubcommandList(NULL, ensemble, &listObj); + if (listObj != NULL) { + int i, sclen; + char *str; + if (Tcl_ListObjGetElements(NULL, listObj, &len,&elems) != TCL_OK){ + TclDecrRefCount(targetCmdObj); return TCL_ERROR; } + for (i=0 ; i<len ; i++) { + str = Tcl_GetStringFromObj(elems[i], &sclen); + if (sclen == numBytes && + memcmp(word, str, (unsigned) numBytes) == 0) { + goto doneSubcmdListSearch; + } + } + TclDecrRefCount(targetCmdObj); + return TCL_ERROR; + } + + /* + * OK, we definitely map to something. But what? + */ + doneSubcmdListSearch: + cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, targetCmdObj); + TclDecrRefCount(targetCmdObj); + if (cmdPtr == NULL || cmdPtr->compileProc == NULL) { /* - * OK, it really is [info exists]! + * Maps to an undefined command or a command without a compiler. + * Cannot compile. */ + + return TCL_ERROR; + } + + /* + * Should check if we mapped to another ensemble here, and go round the + * peek-inside scheme above if so. [TO-DO] + */ + + /* + * Now we've done the mapping process, can now actually try to compile. + * We do this by handing off to the subcommand's actual compiler. But to + * do that, we have to perform some trickery to rewrite the arguments. + */ + + argTokensPtr = TokenAfter(tokenPtr); + memcpy(&synthetic, parsePtr, sizeof(Tcl_Parse)); + synthetic.numWords--; + synthetic.numTokens -= (argTokensPtr - parsePtr->tokenPtr) - 2; + if (synthetic.numTokens <= NUM_STATIC_TOKENS) { + synthetic.tokenPtr = synthetic.staticTokens; + synthetic.tokensAvailable = NUM_STATIC_TOKENS; } else { + synthetic.tokenPtr = (Tcl_Token *) + ckalloc(sizeof(Tcl_Token) * synthetic.numTokens); + synthetic.tokensAvailable = synthetic.numTokens; + } + + /* + * Now we have the space to work in, install something rewritten. + */ + + synthetic.tokenPtr[0].type = TCL_TOKEN_SIMPLE_WORD; + synthetic.tokenPtr[0].start = parsePtr->tokenPtr[0].start; + synthetic.tokenPtr[0].size = (tokenPtr->start + tokenPtr->size) + - parsePtr->tokenPtr[0].start; + synthetic.tokenPtr[0].numComponents = 1; + + synthetic.tokenPtr[1].type = TCL_TOKEN_TEXT; + synthetic.tokenPtr[1].start = synthetic.tokenPtr[0].start; + synthetic.tokenPtr[1].size = synthetic.tokenPtr[0].size; + synthetic.tokenPtr[1].numComponents = 0; + + /* + * Copy over the real argument tokens. + */ + + memcpy(synthetic.tokenPtr + 2, argTokensPtr, + sizeof(Tcl_Token) * (synthetic.numTokens - 2)); + + /* + * Hand off compilation to the subcommand compiler. At last! + */ + + result = cmdPtr->compileProc(interp, &synthetic, cmdPtr, envPtr); + + /* + * Clean up if necessary. + */ + + if (synthetic.tokenPtr != synthetic.staticTokens) { + ckfree((char *) synthetic.tokenPtr); + } + return result; +} + +/* + *---------------------------------------------------------------------- + * + * TclCompileInfoExistsCmd -- + * + * Procedure called to compile the "info exists" subcommand. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "info exists" + * subcommand at runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileInfoExistsCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + Tcl_Token *tokenPtr; + int isScalar, simpleVarName, localIndex; + DefineLineInformation; /* TIP #280 */ + + if (parsePtr->numWords != 2) { return TCL_ERROR; } @@ -5851,9 +6070,9 @@ TclCompileInfoCmd( * qualifiers. */ - tokenPtr = TokenAfter(tokenPtr); + tokenPtr = TokenAfter(parsePtr->tokenPtr); PushVarName(interp, tokenPtr, envPtr, TCL_CREATE_VAR, &localIndex, - &simpleVarName, &isScalar, mapPtr->loc[eclIndex].line[2]); + &simpleVarName, &isScalar, mapPtr->loc[eclIndex].line[1]); /* * Emit instruction to check the variable for existence. diff --git a/generic/tclCompile.c b/generic/tclCompile.c index cffb8a4..77623c2 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.c,v 1.117.2.14 2007/11/16 07:20:53 dgp Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.117.2.15 2007/11/21 06:30:49 dgp Exp $ */ #include "tclInt.h" @@ -1333,7 +1333,7 @@ TclCompileScript( && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES) && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) { int savedNumCmds = envPtr->numCommands; - unsigned int savedCodeNext = + unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart; int update = 0, code; @@ -1375,7 +1375,8 @@ TclCompileScript( update = 1; } - code = (cmdPtr->compileProc)(interp, parsePtr, envPtr); + code = (cmdPtr->compileProc)(interp, parsePtr, + cmdPtr, envPtr); if (code == TCL_OK) { if (update) { @@ -1385,7 +1386,7 @@ TclCompileScript( unsigned char *fixPtr = envPtr->codeStart + savedCodeNext + 1; - unsigned int fixLen = envPtr->codeNext + unsigned fixLen = envPtr->codeNext - envPtr->codeStart - savedCodeNext; TclStoreInt4AtPtr(fixLen, fixPtr); @@ -1873,6 +1874,8 @@ TclCompileNoOp( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr; @@ -2753,7 +2756,7 @@ TclFixupForwardJump( { unsigned char *jumpPc, *p; int firstCmd, lastCmd, firstRange, lastRange, k; - unsigned int numBytes; + unsigned numBytes; if (jumpDist <= distThreshold) { jumpPc = (envPtr->codeStart + jumpFixupPtr->codeOffset); @@ -3405,10 +3408,10 @@ TclDisassembleByteCodeObj( Tcl_AppendPrintfToObj(bufferObj, " Code %lu = header %lu+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n", (unsigned long) codePtr->structureSize, - (unsigned long) (sizeof(ByteCode) - (sizeof(size_t) + sizeof(Tcl_Time))), + (unsigned long) (sizeof(ByteCode) - sizeof(size_t) - sizeof(Tcl_Time)), codePtr->numCodeBytes, (unsigned long) (codePtr->numLitObjects * sizeof(Tcl_Obj *)), - (unsigned long) (codePtr->numExceptRanges * sizeof(ExceptionRange)), + (unsigned long) (codePtr->numExceptRanges*sizeof(ExceptionRange)), (unsigned long) (codePtr->numAuxDataItems * sizeof(AuxData)), codePtr->numCmdLocBytes); #endif /* TCL_COMPILE_STATS */ @@ -3509,7 +3512,7 @@ TclDisassembleByteCodeObj( srcLengthNext = codePtr->srcLengthStart; codeOffset = srcOffset = 0; for (i = 0; i < numCmds; i++) { - if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) { + if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) { codeDeltaNext++; delta = TclGetInt4AtPtr(codeDeltaNext); codeDeltaNext += 4; @@ -3519,7 +3522,7 @@ TclDisassembleByteCodeObj( } codeOffset += delta; - if ((unsigned int) (*codeLengthNext) == (unsigned int) 0xFF) { + if ((unsigned) *codeLengthNext == (unsigned) 0xFF) { codeLengthNext++; codeLen = TclGetInt4AtPtr(codeLengthNext); codeLengthNext += 4; @@ -3528,7 +3531,7 @@ TclDisassembleByteCodeObj( codeLengthNext++; } - if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) { + if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) { srcDeltaNext++; delta = TclGetInt4AtPtr(srcDeltaNext); srcDeltaNext += 4; @@ -3538,7 +3541,7 @@ TclDisassembleByteCodeObj( } srcOffset += delta; - if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) { + if ((unsigned) *srcLengthNext == (unsigned) 0xFF) { srcLengthNext++; srcLen = TclGetInt4AtPtr(srcLengthNext); srcLengthNext += 4; @@ -3568,7 +3571,7 @@ TclDisassembleByteCodeObj( codeOffset = srcOffset = 0; pc = codeStart; for (i = 0; i < numCmds; i++) { - if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) { + if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) { codeDeltaNext++; delta = TclGetInt4AtPtr(codeDeltaNext); codeDeltaNext += 4; @@ -3578,7 +3581,7 @@ TclDisassembleByteCodeObj( } codeOffset += delta; - if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) { + if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) { srcDeltaNext++; delta = TclGetInt4AtPtr(srcDeltaNext); srcDeltaNext += 4; @@ -3588,7 +3591,7 @@ TclDisassembleByteCodeObj( } srcOffset += delta; - if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) { + if ((unsigned) *srcLengthNext == (unsigned) 0xFF) { srcLengthNext++; srcLen = TclGetInt4AtPtr(srcLengthNext); srcLengthNext += 4; @@ -3644,7 +3647,7 @@ FormatInstruction( unsigned char opCode = *pc; register InstructionDesc *instDesc = &tclInstructionTable[opCode]; unsigned char *codeStart = codePtr->codeStart; - unsigned int pcOffset = (pc - codeStart); + unsigned pcOffset = pc - codeStart; int opnd = 0, i, j, numBytes = 1; int localCt = procPtr ? procPtr->numCompiledLocals : 0; CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL; @@ -3681,7 +3684,7 @@ FormatInstruction( if (opCode == INST_PUSH1) { suffixObj = codePtr->objArrayPtr[opnd]; } - Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned int) opnd); + Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); break; case OPERAND_AUX4: case OPERAND_UINT4: @@ -3692,7 +3695,7 @@ FormatInstruction( sprintf(suffixBuffer+strlen(suffixBuffer), ", %u cmds start here", opnd); } - Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned int) opnd); + Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); if (instDesc->opTypes[i] == OPERAND_AUX4) { auxPtr = &codePtr->auxDataArrayPtr[opnd]; } @@ -3718,7 +3721,7 @@ FormatInstruction( if (localPtr != NULL) { if (opnd >= localCt) { Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)", - (unsigned int) opnd, localCt); + (unsigned) opnd, localCt); } for (j = 0; j < opnd; j++) { localPtr = localPtr->nextPtr; diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index cf37b21..f5deb82 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDictObj.c,v 1.49.2.2 2007/11/12 19:18:16 dgp Exp $ + * RCS: @(#) $Id: tclDictObj.c,v 1.49.2.3 2007/11/21 06:30:50 dgp Exp $ */ #include "tclInt.h" @@ -624,6 +624,8 @@ TclTraceDictPath( Tcl_ResetResult(interp); Tcl_AppendResult(interp, "key \"", TclGetString(keyv[i]), "\" not known in dictionary", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT", + TclGetString(keyv[i]), NULL); } return NULL; } @@ -2239,7 +2241,10 @@ DictForCmd( break; } - /* TIP #280. Make invoking context available to loop body */ + /* + * TIP #280. Make invoking context available to loop body. + */ + result = TclEvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 4); if (result == TCL_CONTINUE) { result = TCL_OK; @@ -2570,7 +2575,10 @@ DictFilterCmd( goto abnormalResult; } - /* TIP #280. Make invoking context available to loop body */ + /* + * TIP #280. Make invoking context available to loop body. + */ + result = TclEvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 5); switch (result) { case TCL_OK: @@ -2848,10 +2856,10 @@ DictWithCmd( } /* - * Execute the body. + * Execute the body, while making the invoking context available to the + * loop body (TIP#280). */ - /* TIP #280. Make invoking context available to loop body */ result = TclEvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1); if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (body of \"dict with\")"); diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 5884abd..717e718 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -12,41 +12,41 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclEnv.c,v 1.33.2.1 2007/09/04 17:43:50 dgp Exp $ + * RCS: @(#) $Id: tclEnv.c,v 1.33.2.2 2007/11/21 06:30:50 dgp Exp $ */ #include "tclInt.h" -TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ */ +TCL_DECLARE_MUTEX(envMutex); /* To serialize access to environ. */ -static int cacheSize = 0; /* Number of env strings in environCache. */ -static char **environCache = NULL; - /* Array containing all of the environment +static struct { + int cacheSize; /* Number of env strings in cache. */ + char **cache; /* Array containing all of the environment * strings that Tcl has allocated. */ - #ifndef USE_PUTENV -static char **ourEnviron = NULL;/* Cache of the array that we allocate. We + char **ourEnviron; /* Cache of the array that we allocate. We * need to track this in case another * subsystem swaps around the environ array * like we do. */ -static int environSize = 0; /* Non-zero means that the environ array was + int ourEnvironSize; /* Non-zero means that the environ array was * malloced and has this many total entries * allocated to it (not all may be in use at * once). Zero means that the environment * array is in its original static state. */ #endif +} env; /* * Declarations for local functions defined in this file: */ static char * EnvTraceProc(ClientData clientData, Tcl_Interp *interp, - CONST char *name1, CONST char *name2, int flags); -static void ReplaceString(CONST char *oldStr, char *newStr); -MODULE_SCOPE void TclSetEnv(CONST char *name, CONST char *value); -MODULE_SCOPE void TclUnsetEnv(CONST char *name); + const char *name1, const char *name2, int flags); +static void ReplaceString(const char *oldStr, char *newStr); +MODULE_SCOPE void TclSetEnv(const char *name, const char *value); +MODULE_SCOPE void TclUnsetEnv(const char *name); #if defined(__CYGWIN__) && defined(__WIN32__) -static void TclCygwinPutenv(CONST char *string); +static void TclCygwinPutenv(const char *string); #endif /* @@ -92,8 +92,7 @@ TclSetupEnv( Tcl_UntraceVar2(interp, "env", NULL, TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | - TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, - (ClientData) NULL); + TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL); Tcl_UnsetVar2(interp, "env", NULL, TCL_GLOBAL_ONLY); @@ -127,8 +126,7 @@ TclSetupEnv( Tcl_TraceVar2(interp, "env", NULL, TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | - TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, - (ClientData) NULL); + TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL); } /* @@ -154,14 +152,14 @@ TclSetupEnv( void TclSetEnv( - CONST char *name, /* Name of variable whose value is to be set + const char *name, /* Name of variable whose value is to be set * (UTF-8). */ - CONST char *value) /* New value for variable (UTF-8). */ + const char *value) /* New value for variable (UTF-8). */ { Tcl_DString envString; int index, length, nameLength; char *p, *oldValue; - CONST char *p2; + const char *p2; /* * Figure out where the entry is going to go. If the name doesn't already @@ -176,22 +174,20 @@ TclSetEnv( #ifndef USE_PUTENV /* * We need to handle the case where the environment may be changed - * outside our control. environSize is only valid if the current + * outside our control. ourEnvironSize is only valid if the current * environment is the one we allocated. [Bug 979640] */ - if ((ourEnviron != environ) || ((length + 2) > environSize)) { - char **newEnviron; + if ((env.ourEnviron != environ) || (length+2 > env.ourEnvironSize)) { + char **newEnviron = (char **) + ckalloc(((unsigned) length + 5) * sizeof(char *)); - newEnviron = (char **) - ckalloc((unsigned) ((length + 5) * sizeof(char *))); - memcpy((void *) newEnviron, (void *) environ, - length * sizeof(char *)); - if ((environSize != 0) && (ourEnviron != NULL)) { - ckfree((char *) ourEnviron); + memcpy(newEnviron, environ, length * sizeof(char *)); + if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) { + ckfree((char *) env.ourEnviron); } - environ = ourEnviron = newEnviron; - environSize = length + 5; + environ = env.ourEnviron = newEnviron; + env.ourEnvironSize = length + 5; } index = length; environ[index + 1] = NULL; @@ -199,7 +195,7 @@ TclSetEnv( oldValue = NULL; nameLength = strlen(name); } else { - CONST char *env; + const char *env; /* * Compare the new value to the existing value. If they're the same @@ -210,7 +206,7 @@ TclSetEnv( */ env = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envString); - if (strcmp(value, (env + length + 1)) == 0) { + if (strcmp(value, env + (length + 1)) == 0) { Tcl_DStringFree(&envString); Tcl_MutexUnlock(&envMutex); return; @@ -227,7 +223,7 @@ TclSetEnv( * and set the environ array value. */ - p = (char *) ckalloc((unsigned) (nameLength + strlen(value) + 2)); + p = ckalloc((unsigned) nameLength + strlen(value) + 2); strcpy(p, name); p[nameLength] = '='; strcpy(p+nameLength+1, value); @@ -237,7 +233,7 @@ TclSetEnv( * Copy the native string to heap memory. */ - p = (char *) ckrealloc(p, (unsigned) (strlen(p2) + 1)); + p = ckrealloc(p, strlen(p2) + 1); strcpy(p, p2); Tcl_DStringFree(&envString); @@ -250,7 +246,7 @@ TclSetEnv( index = TclpFindVariable(name, &length); #else environ[index] = p; -#endif +#endif /* USE_PUTENV */ /* * Watch out for versions of putenv that copy the string (e.g. VC++). In @@ -267,7 +263,7 @@ TclSetEnv( */ ckfree(p); -#endif +#endif /* HAVE_PUTENV_THAT_COPIES */ } Tcl_MutexUnlock(&envMutex); @@ -306,11 +302,11 @@ TclSetEnv( int Tcl_PutEnv( - CONST char *assignment) /* Info about environment variable in the form + const char *assignment) /* Info about environment variable in the form * NAME=value. (native) */ { Tcl_DString nameString; - CONST char *name; + const char *name; char *value; if (assignment == NULL) { @@ -355,7 +351,7 @@ Tcl_PutEnv( void TclUnsetEnv( - CONST char *name) /* Name of variable to remove (UTF-8). */ + const char *name) /* Name of variable to remove (UTF-8). */ { char *oldValue; int length; @@ -365,7 +361,7 @@ TclUnsetEnv( char *string; #else char **envPtr; -#endif +#endif /* USE_PUTENV_FOR_UNSET */ Tcl_MutexLock(&envMutex); index = TclpFindVariable(name, &length); @@ -398,18 +394,18 @@ TclUnsetEnv( */ #ifdef WIN32 - string = ckalloc((unsigned int) length+2); - memcpy((void *) string, (void *) name, (size_t) length); + string = ckalloc((unsigned) length+2); + memcpy(string, name, (size_t) length); string[length] = '='; string[length+1] = '\0'; #else - string = ckalloc((unsigned int) length+1); - memcpy((void *) string, (void *) name, (size_t) length); + string = ckalloc((unsigned) length+1); + memcpy(string, name, (size_t) length); string[length] = '\0'; #endif /* WIN32 */ Tcl_UtfToExternalDString(NULL, string, -1, &envString); - string = ckrealloc(string, (unsigned) (Tcl_DStringLength(&envString)+1)); + string = ckrealloc(string, (unsigned) Tcl_DStringLength(&envString)+1); strcpy(string, Tcl_DStringValue(&envString)); Tcl_DStringFree(&envString); @@ -465,16 +461,16 @@ TclUnsetEnv( *---------------------------------------------------------------------- */ -CONST char * +const char * TclGetEnv( - CONST char *name, /* Name of environment variable to find + const char *name, /* Name of environment variable to find * (UTF-8). */ Tcl_DString *valuePtr) /* Uninitialized or free DString in which the * value of the environment variable is * stored. */ { int length, index; - CONST char *result; + const char *result; Tcl_MutexLock(&envMutex); index = TclpFindVariable(name, &length); @@ -524,8 +520,8 @@ EnvTraceProc( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Interpreter whose "env" variable is being * modified. */ - CONST char *name1, /* Better be "env". */ - CONST char *name2, /* Name of variable being modified, or NULL if + const char *name1, /* Better be "env". */ + const char *name2, /* Name of variable being modified, or NULL if * whole array is being deleted (UTF-8). */ int flags) /* Indicates what's happening. */ { @@ -551,7 +547,7 @@ EnvTraceProc( */ if (flags & TCL_TRACE_WRITES) { - CONST char *value; + const char *value; value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY); TclSetEnv(name2, value); @@ -563,9 +559,8 @@ EnvTraceProc( if (flags & TCL_TRACE_READS) { Tcl_DString valueString; - CONST char *value; + const char *value = TclGetEnv(name2, &valueString); - value = TclGetEnv(name2, &valueString); if (value == NULL) { return "no such variable"; } @@ -603,7 +598,7 @@ EnvTraceProc( static void ReplaceString( - CONST char *oldStr, /* Old environment string. */ + const char *oldStr, /* Old environment string. */ char *newStr) /* New environment string. */ { int i; @@ -615,27 +610,27 @@ ReplaceString( * changes are being made. */ - for (i = 0; i < cacheSize; i++) { - if ((environCache[i] == oldStr) || (environCache[i] == NULL)) { + for (i = 0; i < env.cacheSize; i++) { + if (env.cache[i]==oldStr || env.cache[i]==NULL) { break; } } - if (i < cacheSize) { + if (i < env.cacheSize) { /* * Replace or delete the old value. */ - if (environCache[i]) { - ckfree(environCache[i]); + if (env.cache[i]) { + ckfree(env.cache[i]); } if (newStr) { - environCache[i] = newStr; + env.cache[i] = newStr; } else { - for (; i < cacheSize-1; i++) { - environCache[i] = environCache[i+1]; + for (; i < env.cacheSize-1; i++) { + env.cache[i] = env.cache[i+1]; } - environCache[cacheSize-1] = NULL; + env.cache[env.cacheSize-1] = NULL; } } else { /* @@ -644,12 +639,12 @@ ReplaceString( const int growth = 5; - environCache = (char **) ckrealloc ((char *) environCache, - (cacheSize + growth) * sizeof(char *)); - environCache[cacheSize] = newStr; - (void) memset(environCache+cacheSize+1, (int) 0, - (size_t) ((growth-1) * sizeof(char*))); - cacheSize += growth; + env.cache = (char **) ckrealloc((char *) env.cache, + (env.cacheSize + growth) * sizeof(char *)); + env.cache[env.cacheSize] = newStr; + (void) memset(env.cache+env.cacheSize+1, (int) 0, + (size_t) (growth-1) * sizeof(char*)); + env.cacheSize += growth; } } @@ -682,12 +677,12 @@ TclFinalizeEnvironment(void) * unlikely, so we don't bother. */ - if (environCache) { - ckfree((char *) environCache); - environCache = NULL; - cacheSize = 0; + if (env.cache) { + ckfree((char *) env.cache); + env.cache = NULL; + env.cacheSize = 0; #ifndef USE_PUTENV - environSize = 0; + env.ourEnvironSize = 0; #endif } } @@ -714,7 +709,7 @@ TclCygwinPutenv( * for Windows. */ - name = (char *) alloca(strlen(str) + 1); + name = alloca(strlen(str) + 1); strcpy(name, str); for (value=name ; *value!='=' && *value!='\0' ; ++value) { /* Empty body */ @@ -777,7 +772,7 @@ TclCygwinPutenv( int size; size = cygwin_posix_to_win32_path_list_buf_size(value); - buf = (char *) alloca(size + 1); + buf = alloca(size + 1); cygwin_posix_to_win32_path_list(value, buf); } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 35d2f41..8142ba9 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.285.2.24 2007/11/16 07:20:54 dgp Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.285.2.25 2007/11/21 06:30:50 dgp Exp $ */ #include "tclInt.h" @@ -295,7 +295,7 @@ VarHashCreateVar( if (traceInstructions) { \ fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \ (int) CURR_DEPTH, \ - (unsigned int)(pc - codePtr->codeStart), \ + (unsigned)(pc - codePtr->codeStart), \ GetOpcodeName(pc)); \ printf a; \ } @@ -307,7 +307,7 @@ VarHashCreateVar( if (traceInstructions) { \ fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \ (int) CURR_DEPTH, \ - (unsigned int)(pc - codePtr->codeStart), \ + (unsigned)(pc - codePtr->codeStart), \ GetOpcodeName(pc)); \ printf a; \ TclPrintObject(stdout, objPtr, 30); \ @@ -461,18 +461,17 @@ static Tcl_ObjType dictIteratorType = { #if (LONG_MAX == 0x7fffffff) -/* +/* * Maximum base that, when raised to powers 2, 3, ... 8, fits in a 32-bit * signed integer */ static const long MaxBase32[7] = {46340, 1290, 215, 73, 35, 21, 14}; -/* - * Table giving 3, 4, ..., 11, raised to the powers 9, 10, ..., - * as far as they fit in a 32-bit signed integer. Exp32Index[i] gives - * the starting index of powers of i+3; Exp32Value[i] gives the corresponding - * powers. +/* + * Table giving 3, 4, ..., 11, raised to the powers 9, 10, ..., as far as they + * fit in a 32-bit signed integer. Exp32Index[i] gives the starting index of + * powers of i+3; Exp32Value[i] gives the corresponding powers. */ static const unsigned short Exp32Index[] = { @@ -492,13 +491,13 @@ static const long Exp32Value[] = { #if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG) /* - * Maximum base that, when raised to powers 2, 3, ..., 16, fits in a + * Maximum base that, when raised to powers 2, 3, ..., 16, fits in a * Tcl_WideInt. */ static Tcl_WideInt MaxBaseWide[15]; -/* +/* *Table giving 3, 4, ..., 13 raised to powers greater than 16 when the * results fit in a 64-bit signed integer. */ @@ -658,29 +657,34 @@ InitByteCodeExecution( } #endif #ifdef TCL_COMPILE_STATS - Tcl_CreateObjCommand(interp, "evalstats", EvalStatsCmd, - (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "evalstats", EvalStatsCmd, NULL, NULL); #endif /* TCL_COMPILE_STATS */ #if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG) - /* + /* * Fill in a table of what base can be raised to powers 2, 3, ... 16 * without overflowing a Tcl_WideInt */ - for (i = 2; i <= 16; ++i) { - /* Compute an initial guess in floating point */ + for (i = 2; i <= 16; ++i) { + /* + * Compute an initial guess in floating point. + */ w = (Tcl_WideInt) pow((double) LLONG_MAX, 1.0 / i) + 1; - /* Correct the guess if it's too high */ + /* + * Correct the guess if it's too high. + */ for (;;) { x = LLONG_MAX; for (j = 0; j < i; ++j) { x /= w; } - if (x == 1) break; + if (x == 1) { + break; + } --w; } @@ -719,9 +723,8 @@ TclCreateExecEnv( * environment is being created. */ { ExecEnv *eePtr = (ExecEnv *) ckalloc(sizeof(ExecEnv)); - ExecStack *esPtr = (ExecStack *) - ckalloc((size_t) (sizeof(ExecStack) - + (TCL_STACK_INITIAL_SIZE -1) * sizeof(Tcl_Obj *))); + ExecStack *esPtr = (ExecStack *) ckalloc(sizeof(ExecStack) + + (size_t) (TCL_STACK_INITIAL_SIZE-1) * sizeof(Tcl_Obj *)); eePtr->execStackPtr = esPtr; TclNewBooleanObj(eePtr->constants[0], 0); @@ -891,7 +894,7 @@ GrowEvaluationStack( if (move) { move = esPtr->tosPtr - markerPtr; } - needed = growth + move + 1; /* add the marker */ + needed = growth + move + 1; /* Add the marker. */ /* * Check if there is enough room in the next stack (if there is one, it @@ -1177,10 +1180,13 @@ Tcl_ExprObj( } } if (objPtr->typePtr != &tclByteCodeType) { + /* + * TIP #280: No invoker (yet) - Expression compilation. + */ - /* TIP #280: No invoker (yet) - Expression compilation. */ int length; const char *string = TclGetStringFromObj(objPtr, &length); + TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0); TclCompileExpr(interp, string, length, &compEnv); @@ -1415,19 +1421,25 @@ TclIncrObj( } if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) { - /* Produce error message (reparse?!) */ + /* + * Produce error message (reparse?!) + */ + return TclGetIntFromObj(interp, valuePtr, &type1); } if (GetNumberFromObj(NULL, incrPtr, &ptr2, &type2) != TCL_OK) { - /* Produce error message (reparse?!) */ + /* + * Produce error message (reparse?!) + */ + TclGetIntFromObj(interp, incrPtr, &type1); Tcl_AddErrorInfo(interp, "\n (reading increment)"); return TCL_ERROR; } if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) { - long augend = *((const long *)ptr1); - long addend = *((const long *)ptr2); + long augend = *((const long *) ptr1); + long addend = *((const long *) ptr2); long sum = augend + addend; /* @@ -1442,8 +1454,8 @@ TclIncrObj( } #ifndef NO_WIDE_TYPE { - Tcl_WideInt w1 = (Tcl_WideInt)augend; - Tcl_WideInt w2 = (Tcl_WideInt)addend; + Tcl_WideInt w1 = (Tcl_WideInt) augend; + Tcl_WideInt w2 = (Tcl_WideInt) addend; /* * We know the sum value is outside the long range, so we use the @@ -1476,6 +1488,7 @@ TclIncrObj( #ifndef NO_WIDE_TYPE if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) { Tcl_WideInt w1, w2, sum; + TclGetWideIntFromObj(NULL, valuePtr, &w1); TclGetWideIntFromObj(NULL, incrPtr, &w2); sum = w1 + w2; @@ -1530,6 +1543,13 @@ TclExecuteByteCode( #define iPtr ((Interp *) interp) /* + * Check just the read-traced/write-traced bit of a variable. + */ + +#define ReadTraced(varPtr) ((varPtr)->flags & VAR_TRACED_READ) +#define WriteTraced(varPtr) ((varPtr)->flags & VAR_TRACED_WRITE) + + /* * Constants: variables that do not change during the execution, used * sporadically. */ @@ -1772,7 +1792,7 @@ TclExecuteByteCode( } else if (*pc == INST_PUSH1) { goto instPush1Peephole; } - + switch (*pc) { case INST_SYNTAX: case INST_RETURN_IMM: { @@ -2159,7 +2179,7 @@ TclExecuteByteCode( TRACE(("%u => call ", objc)); } else { fprintf(stdout, "%d: (%u) invoking ", iPtr->numLevels, - (unsigned int)(pc - codePtr->codeStart)); + (unsigned)(pc - codePtr->codeStart)); } for (i = 0; i < objc; i++) { TclPrintObject(stdout, objv[i], 15); @@ -2387,7 +2407,7 @@ TclExecuteByteCode( if (result == TCL_OK) { objResultPtr = valuePtr; TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr); - NEXT_INST_F(1, 1, -1); /* already has right refct */ + NEXT_INST_F(1, 1, -1); /* Already has right refct. */ } else { TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(objPtr)), Tcl_GetObjResult(interp)); @@ -2410,7 +2430,7 @@ TclExecuteByteCode( Tcl_Obj *objPtr; case INST_LOAD_SCALAR1: - instLoadScalar1: + instLoadScalar1: opnd = TclGetUInt1AtPtr(pc+1); varPtr = &(compiledLocals[opnd]); while (TclIsVarLink(varPtr)) { @@ -2471,7 +2491,7 @@ TclExecuteByteCode( arrayPtr = arrayPtr->value.linkPtr; } TRACE(("%u \"%.30s\" => ", opnd, O2S(part2Ptr))); - if (TclIsVarArray(arrayPtr) && !(arrayPtr->flags & VAR_TRACED_READ)) { + if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)) { varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr); if (varPtr && TclIsVarDirectReadable(varPtr)) { /* @@ -2539,8 +2559,8 @@ TclExecuteByteCode( */ DECACHE_STACK_INFO(); - objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, - TCL_LEAVE_ERR_MSG, opnd); + objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr, + part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd); CACHE_STACK_INFO(); if (objResultPtr) { TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); @@ -2590,7 +2610,7 @@ TclExecuteByteCode( while (TclIsVarLink(arrayPtr)) { arrayPtr = arrayPtr->value.linkPtr; } - if (TclIsVarArray(arrayPtr) && !(arrayPtr->flags & VAR_TRACED_WRITE)) { + if (TclIsVarArray(arrayPtr) && !WriteTraced(arrayPtr)) { varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr); if (varPtr && TclIsVarDirectWritable(varPtr)) { tosPtr--; @@ -2692,13 +2712,13 @@ TclExecuteByteCode( part1Ptr = objPtr; #ifdef TCL_COMPILE_DEBUG if (part2Ptr == NULL) { - TRACE(("\"%.30s\" <- \"%.30s\" =>", O2S(part1Ptr), O2S(valuePtr))); + TRACE(("\"%.30s\" <- \"%.30s\" =>", O2S(part1Ptr),O2S(valuePtr))); } else { TRACE(("\"%.30s(%.30s)\" <- \"%.30s\" => ", O2S(part1Ptr), O2S(part2Ptr), O2S(valuePtr))); } #endif - varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr, TCL_LEAVE_ERR_MSG, + varPtr = TclObjLookupVarEx(interp, objPtr,part2Ptr, TCL_LEAVE_ERR_MSG, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (varPtr) { cleanup = ((part2Ptr == NULL)? 2 : 3); @@ -2884,8 +2904,8 @@ TclExecuteByteCode( } part1Ptr = objPtr; opnd = -1; - varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr, TCL_LEAVE_ERR_MSG, - "read", 1, 1, &arrayPtr); + varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr, + TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr); if (varPtr) { cleanup = ((part2Ptr == NULL)? 1 : 2); goto doIncrVar; @@ -3112,14 +3132,12 @@ TclExecuteByteCode( * Start of INST_EXIST instructions. */ { - int opnd, pcAdjustment; Tcl_Obj *part1Ptr, *part2Ptr; Var *varPtr, *arrayPtr; -#define ReadTraced(varPtr) ((varPtr)->flags & VAR_TRACED_READ) + case INST_EXIST_SCALAR: { + int opnd = TclGetUInt4AtPtr(pc+1); - case INST_EXIST_SCALAR: - opnd = TclGetUInt4AtPtr(pc+1); varPtr = &(compiledLocals[opnd]); while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; @@ -3127,25 +3145,27 @@ TclExecuteByteCode( TRACE(("%u => ", opnd)); if (ReadTraced(varPtr)) { DECACHE_STACK_INFO(); - if (TclObjCallVarTraces(iPtr, NULL, varPtr, NULL, NULL, - TCL_TRACE_READS, 0, opnd) != TCL_OK) { + TclObjCallVarTraces(iPtr, NULL, varPtr, NULL, NULL, + TCL_TRACE_READS, 0, opnd); + CACHE_STACK_INFO(); + if (TclIsVarUndefined(varPtr)) { + TclCleanupVar(varPtr, NULL); varPtr = NULL; } - CACHE_STACK_INFO(); } + /* * Tricky! Arrays always exist. */ - if (varPtr == NULL || varPtr->value.objPtr == NULL) { - objResultPtr = constants[0]; - } else { - objResultPtr = constants[1]; - } + + objResultPtr = constants[!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1]; TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_F(5, 0, 1); + } + + case INST_EXIST_ARRAY: { + int opnd = TclGetUInt4AtPtr(pc+1); - case INST_EXIST_ARRAY: - opnd = TclGetUInt4AtPtr(pc+1); part2Ptr = OBJ_AT_TOS; arrayPtr = &(compiledLocals[opnd]); while (TclIsVarLink(arrayPtr)) { @@ -3154,37 +3174,32 @@ TclExecuteByteCode( TRACE(("%u \"%.30s\" => ", opnd, O2S(part2Ptr))); if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)) { varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr); - if (!varPtr) { - objResultPtr = constants[0]; - TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); - NEXT_INST_F(5, 1, 1); - } else if (!ReadTraced(varPtr)) { - objResultPtr = constants[varPtr->value.objPtr != NULL ? 1:0]; - TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); - NEXT_INST_F(5, 1, 1); + if (!varPtr || !ReadTraced(varPtr)) { + goto doneExistArray; } } varPtr = TclLookupArrayElement(interp, NULL, part2Ptr, 0, "access", - 0, 0, arrayPtr, opnd); - if (varPtr&&(ReadTraced(varPtr)||(arrayPtr&&ReadTraced(arrayPtr)))) { - DECACHE_STACK_INFO(); - if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, NULL, - part2Ptr, TCL_TRACE_READS, 0, opnd) != TCL_OK) { + 0, 1, arrayPtr, opnd); + if (varPtr) { + if (ReadTraced(varPtr) || (arrayPtr && ReadTraced(arrayPtr))) { + DECACHE_STACK_INFO(); + TclObjCallVarTraces(iPtr, arrayPtr, varPtr, NULL, part2Ptr, + TCL_TRACE_READS, 0, opnd); + CACHE_STACK_INFO(); + } + if (TclIsVarUndefined(varPtr)) { + TclCleanupVar(varPtr, arrayPtr); varPtr = NULL; } - CACHE_STACK_INFO(); - } - if (varPtr == NULL) { - objResultPtr = constants[0]; - } else { - objResultPtr = constants[varPtr->value.objPtr != NULL ? 1 : 0]; } + doneExistArray: + objResultPtr = constants[!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1]; TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_F(5, 1, 1); + } case INST_EXIST_ARRAY_STK: cleanup = 2; - pcAdjustment = 1; part2Ptr = OBJ_AT_TOS; /* element name */ part1Ptr = OBJ_UNDER_TOS; /* array name */ TRACE(("\"%.30s(%.30s)\" => ", O2S(part1Ptr), O2S(part2Ptr))); @@ -3192,29 +3207,28 @@ TclExecuteByteCode( case INST_EXIST_STK: cleanup = 1; - pcAdjustment = 1; part2Ptr = NULL; part1Ptr = OBJ_AT_TOS; /* variable name */ TRACE(("\"%.30s\" => ", O2S(part1Ptr))); doExistStk: varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, 0, "access", - /*createPart1*/0, /*createPart2*/0, &arrayPtr); - if (varPtr&&(ReadTraced(varPtr)||(arrayPtr&&ReadTraced(arrayPtr)))) { - DECACHE_STACK_INFO(); - if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr, - part2Ptr, TCL_TRACE_READS, 0, -1) != TCL_OK) { + /*createPart1*/0, /*createPart2*/1, &arrayPtr); + if (varPtr) { + if (ReadTraced(varPtr) || (arrayPtr && ReadTraced(arrayPtr))) { + DECACHE_STACK_INFO(); + TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,part2Ptr, + TCL_TRACE_READS, 0, -1); + CACHE_STACK_INFO(); + } + if (TclIsVarUndefined(varPtr)) { + TclCleanupVar(varPtr, arrayPtr); varPtr = NULL; } - CACHE_STACK_INFO(); - } - if (!varPtr) { - objResultPtr = constants[0]; - } else { - objResultPtr = constants[varPtr->value.objPtr != NULL ? 1:0]; } + objResultPtr = constants[!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1]; TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); - NEXT_INST_V(pcAdjustment, cleanup, 1); + NEXT_INST_V(1, cleanup, 1); } /* @@ -3308,8 +3322,12 @@ TclExecuteByteCode( if ((varPtr != otherPtr) && !TclIsVarTraced(varPtr) && (TclIsVarUndefined(varPtr) || TclIsVarLink(varPtr))) { if (!TclIsVarUndefined(varPtr)) { - /* Then it is a defined link */ + /* + * Then it is a defined link. + */ + Var *linkPtr = varPtr->value.linkPtr; + if (linkPtr == otherPtr) { goto doLinkVarsDone; } @@ -3342,20 +3360,18 @@ TclExecuteByteCode( } case INST_JUMP1: { - int opnd; + int opnd = TclGetInt1AtPtr(pc+1); - opnd = TclGetInt1AtPtr(pc+1); TRACE(("%d => new pc %u\n", opnd, - (unsigned int)(pc + opnd - codePtr->codeStart))); + (unsigned)(pc + opnd - codePtr->codeStart))); NEXT_INST_F(opnd, 0, 0); } case INST_JUMP4: { - int opnd; + int opnd = TclGetInt4AtPtr(pc+1); - opnd = TclGetInt4AtPtr(pc+1); TRACE(("%d => new pc %u\n", opnd, - (unsigned int)(pc + opnd - codePtr->codeStart))); + (unsigned)(pc + opnd - codePtr->codeStart))); NEXT_INST_F(opnd, 0, 0); } @@ -3402,7 +3418,7 @@ TclExecuteByteCode( if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) { TRACE(("%d => %.20s true, new pc %u\n", jmpOffset[1], O2S(valuePtr), - (unsigned)(pc+jmpOffset[1] - codePtr->codeStart))); + (unsigned)(pc + jmpOffset[1] - codePtr->codeStart))); } else { TRACE(("%d => %.20s true\n", jmpOffset[0], O2S(valuePtr))); } @@ -3437,7 +3453,7 @@ TclExecuteByteCode( int jumpOffset = PTR2INT(Tcl_GetHashValue(hPtr)); TRACE_APPEND(("found in table, new pc %u\n", - (unsigned int)(pc - codePtr->codeStart + jumpOffset))); + (unsigned)(pc - codePtr->codeStart + jumpOffset))); NEXT_INST_F(jumpOffset, 1, 0); } else { TRACE_APPEND(("not found in table\n")); @@ -3528,7 +3544,7 @@ TclExecuteByteCode( /*** lindex with objc == 3 ***/ /* Variables also for INST_LIST_INDEX_IMM */ - + int listc, idx, opnd, pcAdjustment; Tcl_Obj **listv; Tcl_Obj *valuePtr, *value2Ptr; @@ -3546,8 +3562,9 @@ TclExecuteByteCode( result = TclListObjGetElements(interp, valuePtr, &listc, &listv); if ((result == TCL_OK) && (value2Ptr->typePtr != &tclListType) - && (TclGetIntForIndexM(NULL , value2Ptr, listc-1, &idx) == TCL_OK)) { - Tcl_DecrRefCount(value2Ptr); + && (TclGetIntForIndexM(NULL , value2Ptr, listc-1, + &idx) == TCL_OK)) { + TclDecrRefCount(value2Ptr); tosPtr--; pcAdjustment = 1; goto lindexFastPath; @@ -3569,7 +3586,7 @@ TclExecuteByteCode( goto checkForCatch; } - case INST_LIST_INDEX_IMM: + case INST_LIST_INDEX_IMM: /*** lindex with objc==3 and index in bytecode stream ***/ pcAdjustment = 5; @@ -3587,7 +3604,7 @@ TclExecuteByteCode( */ result = TclListObjGetElements(interp, valuePtr, &listc, &listv); - + if (result == TCL_OK) { /* * Select the list item based on the index. Negative operand means @@ -3600,7 +3617,7 @@ TclExecuteByteCode( idx = opnd; } - lindexFastPath: + lindexFastPath: if (idx >= 0 && idx < listc) { objResultPtr = listv[idx]; } else { @@ -3721,7 +3738,7 @@ TclExecuteByteCode( */ objPtr = POP_OBJECT(); - Tcl_DecrRefCount(objPtr); /* This one should be done here */ + Tcl_DecrRefCount(objPtr); /* This one should be done here. */ /* * Get the new element value, and the index list. @@ -4236,11 +4253,13 @@ TclExecuteByteCode( if (match < 0) { objResultPtr = Tcl_GetObjResult(interp); - TRACE_WITH_OBJ(("%.20s %.20s => ERROR: ", O2S(valuePtr), O2S(value2Ptr)), objResultPtr); + TRACE_WITH_OBJ(("%.20s %.20s => ERROR: ", + O2S(valuePtr), O2S(value2Ptr)), objResultPtr); result = TCL_ERROR; goto checkForCatch; } else { - TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match)); + TRACE(("%.20s %.20s => %d\n", + O2S(valuePtr), O2S(value2Ptr), match)); objResultPtr = constants[match]; NEXT_INST_F(2, 2, 1); } @@ -4846,7 +4865,7 @@ TclExecuteByteCode( * Large left shifts create integer overflow. * * BEWARE! Can't use Tcl_GetIntFromObj() here because that - * converts values in the (unsigned int) range to their signed int + * converts values in the (unsigned) range to their signed int * counterparts, leading to incorrect results. */ @@ -5032,7 +5051,8 @@ TclExecuteByteCode( result = GetNumberFromObj(NULL, valuePtr, &ptr1, &type1); if ((result != TCL_OK) - || (type1 == TCL_NUMBER_NAN) || (type1 == TCL_NUMBER_DOUBLE)) { + || (type1 == TCL_NUMBER_NAN) + || (type1 == TCL_NUMBER_DOUBLE)) { result = TCL_ERROR; TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", O2S(valuePtr), O2S(value2Ptr), (valuePtr->typePtr? @@ -5436,14 +5456,14 @@ TclExecuteByteCode( NEXT_INST_F(1, 1, 0); } - /* TODO: Attempts to re-use unshared operands on stack */ + /* TODO: Attempts to re-use unshared operands on stack. */ if (*pc == INST_EXPON) { long l1 = 0, l2 = 0; Tcl_WideInt w1; int oddExponent = 0, negativeExponent = 0; if (type2 == TCL_NUMBER_LONG) { - l2 = *((const long *)ptr2); + l2 = *((const long *) ptr2); if (l2 == 0) { /* * Anything to the zero power is 1. @@ -5562,17 +5582,18 @@ TclExecuteByteCode( /* * Reduce small powers of 2 to shifts. */ - if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) { + + if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) { TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); TclNewLongObj(objResultPtr, (1L << l2)); TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } #if !defined(TCL_WIDE_INT_IS_LONG) - if ((unsigned long) l2 < CHAR_BIT * sizeof(Tcl_WideInt) - 1) { + if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){ TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); - objResultPtr - = Tcl_NewWideIntObj(((Tcl_WideInt) 1) << l2); + objResultPtr = + Tcl_NewWideIntObj(((Tcl_WideInt) 1) << l2); TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } @@ -5580,21 +5601,22 @@ TclExecuteByteCode( } if (l1 == -2) { int signum = oddExponent ? -1 : 1; + /* * Reduce small powers of 2 to shifts. */ - if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) { + + if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) { TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); TclNewLongObj(objResultPtr, signum * (1L << l2)); TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } #if !defined(TCL_WIDE_INT_IS_LONG) - if ((unsigned long) l2 < CHAR_BIT * sizeof(Tcl_WideInt) - 1) { + if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){ TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); - objResultPtr - = Tcl_NewWideIntObj(signum * - (((Tcl_WideInt) 1) << l2)); + objResultPtr = Tcl_NewWideIntObj( + signum * (((Tcl_WideInt) 1) << l2)); TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } @@ -5602,36 +5624,37 @@ TclExecuteByteCode( } #if (LONG_MAX == 0x7fffffff) if (l2 <= 8 && - l1 <= MaxBase32[l2-2] && l1 >= -MaxBase32[l2-2]) { + l1 <= MaxBase32[l2-2] && l1 >= -MaxBase32[l2-2]) { /* - * Small powers of 32-bit integers + * Small powers of 32-bit integers. */ - long lResult = l1 * l1; /* b**2 */ + + long lResult = l1 * l1; /* b**2 */ switch (l2) { case 2: break; case 3: - lResult *= l1; /* b**3 */ + lResult *= l1; /* b**3 */ break; case 4: - lResult *= lResult; /* b**4 */ + lResult *= lResult; /* b**4 */ break; case 5: - lResult *= lResult; /* b**4 */ - lResult *= l1; /* b**5 */ + lResult *= lResult; /* b**4 */ + lResult *= l1; /* b**5 */ break; case 6: - lResult *= l1; /* b**3 */ - lResult *= lResult; /* b**6 */ + lResult *= l1; /* b**3 */ + lResult *= lResult; /* b**6 */ break; case 7: - lResult *= l1; /* b**3 */ - lResult *= lResult; /* b**6 */ - lResult *= l1; /* b**7 */ + lResult *= l1; /* b**3 */ + lResult *= lResult; /* b**6 */ + lResult *= l1; /* b**7 */ break; case 8: - lResult *= lResult; /* b**4 */ - lResult *= lResult; /* b**8 */ + lResult *= lResult; /* b**4 */ + lResult *= lResult; /* b**8 */ break; } TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); @@ -5644,16 +5667,17 @@ TclExecuteByteCode( TRACE(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 1, 0); } - if (l1 >= 3 - && (unsigned long) l1 < (sizeof(Exp32Index) - / sizeof(unsigned short)) - 1) { + if (l1 >= 3 && + ((unsigned long) l1 < (sizeof(Exp32Index) + / sizeof(unsigned short)) - 1)) { unsigned short base = Exp32Index[l1-3] - + (unsigned short) l2 - 9; + + (unsigned short) l2 - 9; if (base < Exp32Index[l1-2]) { /* - * 32-bit number raised to intermediate power, - * done by table lookup + * 32-bit number raised to intermediate power, done by + * table lookup. */ + TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); if (Tcl_IsShared(valuePtr)) { TclNewLongObj(objResultPtr, Exp32Value[base]); @@ -5671,12 +5695,14 @@ TclExecuteByteCode( unsigned short base = Exp32Index[-l1-3] + (unsigned short) l2 - 9; if (base < Exp32Index[-l1-2]) { - long lResult = (oddExponent) ? + long lResult = (oddExponent) ? -Exp32Value[base] : Exp32Value[base]; + /* - * 32-bit number raised to intermediate power, - * done by table lookup + * 32-bit number raised to intermediate power, done by + * table lookup. */ + TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); if (Tcl_IsShared(valuePtr)) { TclNewLongObj(objResultPtr, lResult); @@ -5700,83 +5726,84 @@ TclExecuteByteCode( w1 = 0; } #if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG) - if (w1 != 0 && type2 == TCL_NUMBER_LONG - && l2 <= 16 - && w1 <= MaxBaseWide[l2-2] && w1 >= -MaxBaseWide[l2-2]) { - /* - * Small powers of integers whose result is wide + if (w1 != 0 && type2 == TCL_NUMBER_LONG && l2 <= 16 + && w1 <= MaxBaseWide[l2-2] && w1 >= -MaxBaseWide[l2-2]) { + /* + * Small powers of integers whose result is wide. */ + Tcl_WideInt wResult = w1 * w1; /* b**2 */ + switch (l2) { case 2: break; case 3: - wResult *= l1; /* b**3 */ + wResult *= l1; /* b**3 */ break; case 4: - wResult *= wResult; /* b**4 */ + wResult *= wResult; /* b**4 */ break; case 5: - wResult *= wResult; /* b**4 */ - wResult *= w1; /* b**5 */ + wResult *= wResult; /* b**4 */ + wResult *= w1; /* b**5 */ break; case 6: - wResult *= w1; /* b**3 */ - wResult *= wResult; /* b**6 */ + wResult *= w1; /* b**3 */ + wResult *= wResult; /* b**6 */ break; case 7: - wResult *= w1; /* b**3 */ - wResult *= wResult; /* b**6 */ - wResult *= w1; /* b**7 */ + wResult *= w1; /* b**3 */ + wResult *= wResult; /* b**6 */ + wResult *= w1; /* b**7 */ break; case 8: - wResult *= wResult; /* b**4 */ - wResult *= wResult; /* b**8 */ + wResult *= wResult; /* b**4 */ + wResult *= wResult; /* b**8 */ break; case 9: - wResult *= wResult; /* b**4 */ - wResult *= wResult; /* b**8 */ - wResult *= w1; /* b**9 */ + wResult *= wResult; /* b**4 */ + wResult *= wResult; /* b**8 */ + wResult *= w1; /* b**9 */ break; case 10: - wResult *= wResult; /* b**4 */ - wResult *= w1; /* b**5 */ + wResult *= wResult; /* b**4 */ + wResult *= w1; /* b**5 */ wResult *= wResult; /* b**10 */ break; case 11: - wResult *= wResult; /* b**4 */ - wResult *= w1; /* b**5 */ + wResult *= wResult; /* b**4 */ + wResult *= w1; /* b**5 */ wResult *= wResult; /* b**10 */ - wResult *= w1; /* b**11 */ + wResult *= w1; /* b**11 */ break; case 12: - wResult *= w1; /* b**3 */ - wResult *= wResult; /* b**6 */ - wResult *= wResult; /* b**12 */ + wResult *= w1; /* b**3 */ + wResult *= wResult; /* b**6 */ + wResult *= wResult; /* b**12 */ break; case 13: - wResult *= w1; /* b**3 */ - wResult *= wResult; /* b**6 */ - wResult *= wResult; /* b**12 */ - wResult *= w1; /* b**13 */ + wResult *= w1; /* b**3 */ + wResult *= wResult; /* b**6 */ + wResult *= wResult; /* b**12 */ + wResult *= w1; /* b**13 */ break; case 14: - wResult *= w1; /* b**3 */ - wResult *= wResult; /* b**6 */ - wResult *= w1; /* b**7 */ + wResult *= w1; /* b**3 */ + wResult *= wResult; /* b**6 */ + wResult *= w1; /* b**7 */ wResult *= wResult; /* b**14 */ break; case 15: - wResult *= w1; /* b**3 */ - wResult *= wResult; /* b**6 */ - wResult *= w1; /* b**7 */ + wResult *= w1; /* b**3 */ + wResult *= wResult; /* b**6 */ + wResult *= w1; /* b**7 */ wResult *= wResult; /* b**14 */ - wResult *= w1; /* b**15 */ + wResult *= w1; /* b**15 */ break; case 16: - wResult *= wResult; /* b**4 */ - wResult *= wResult; /* b**8 */ - wResult *= wResult; /* b**16 */ + wResult *= wResult; /* b**4 */ + wResult *= wResult; /* b**8 */ + wResult *= wResult; /* b**16 */ break; } @@ -5787,19 +5814,22 @@ TclExecuteByteCode( } /* - * Handle cases of powers > 16 that still fit in a 64-bit - * word by doing table lookup + * Handle cases of powers > 16 that still fit in a 64-bit word by + * doing table lookup. */ - if (w1 >= 3 - && (Tcl_WideUInt) w1 < (sizeof(Exp64Index) - / sizeof(unsigned short)) - 1) { - unsigned short base - = Exp64Index[w1-3] + (unsigned short) l2 - 17; + + if (w1 >= 3 && + (Tcl_WideUInt) w1 < (sizeof(Exp64Index) + / sizeof(unsigned short)) - 1) { + unsigned short base = + Exp64Index[w1-3] + (unsigned short) l2 - 17; + if (base < Exp64Index[w1-2]) { /* - * 64-bit number raised to intermediate power, - * done by table lookup + * 64-bit number raised to intermediate power, done by + * table lookup. */ + TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); if (Tcl_IsShared(valuePtr)) { objResultPtr = Tcl_NewWideIntObj(Exp64Value[base]); @@ -5811,18 +5841,20 @@ TclExecuteByteCode( NEXT_INST_F(1, 1, 0); } } - if (-w1 >= 3 - && (Tcl_WideUInt) (-w1) < (sizeof(Exp64Index) - / sizeof(unsigned short)) - 1) { - unsigned short base - = Exp64Index[-w1-3] + (unsigned short) l2 - 17; + if (-w1 >= 3 && + (Tcl_WideUInt) (-w1) < (sizeof(Exp64Index) + / sizeof(unsigned short)) - 1) { + unsigned short base = + Exp64Index[-w1-3] + (unsigned short) l2 - 17; + if (base < Exp64Index[-w1-2]) { - Tcl_WideInt wResult = (oddExponent) ? - -Exp64Value[base] : Exp64Value[base]; + Tcl_WideInt wResult = (oddExponent) ? + -Exp64Value[base] : Exp64Value[base]; /* - * 64-bit number raised to intermediate power, - * done by table lookup + * 64-bit number raised to intermediate power, done by + * table lookup. */ + TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); if (Tcl_IsShared(valuePtr)) { objResultPtr = Tcl_NewWideIntObj(wResult); @@ -5835,13 +5867,14 @@ TclExecuteByteCode( } } #endif - + goto overflow; } if ((*pc != INST_MULT) && (type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) { Tcl_WideInt w1, w2, wResult; + TclGetWideIntFromObj(NULL, valuePtr, &w1); TclGetWideIntFromObj(NULL, value2Ptr, &w2); @@ -5871,12 +5904,12 @@ TclExecuteByteCode( /* * Must check for overflow. The macro tests for overflows * in sums by looking at the sign bits. As we have a - * subtraction here, we are adding -w2. As -w2 could in turn - * overflow, we test with ~w2 instead: it has the opposite - * sign bit to w2 so it does the job. Note that the only - * "bad" case (w2==0) is irrelevant for this macro, as in - * that case w1 and wResult have the same sign and there - * is no overflow anyway. + * subtraction here, we are adding -w2. As -w2 could in + * turn overflow, we test with ~w2 instead: it has the + * opposite sign bit to w2 so it does the job. Note that + * the only "bad" case (w2==0) is irrelevant for this + * macro, as in that case w1 and wResult have the same + * sign and there is no overflow anyway. */ if (Overflowing(w1, ~w2, wResult)) { @@ -6048,6 +6081,7 @@ TclExecuteByteCode( #ifndef NO_WIDE_TYPE if (type == TCL_NUMBER_WIDE) { Tcl_WideInt w = *((const Tcl_WideInt *)ptr); + if (Tcl_IsShared(valuePtr)) { objResultPtr = Tcl_NewWideIntObj(~w); NEXT_INST_F(1, 1, 1); @@ -6099,6 +6133,7 @@ TclExecuteByteCode( } case TCL_NUMBER_LONG: { long l = *((const long *)ptr); + if (l != LONG_MIN) { if (Tcl_IsShared(valuePtr)) { TclNewLongObj(objResultPtr, -l); @@ -6310,12 +6345,11 @@ TclExecuteByteCode( * the next value list element to each loop var. */ - int opnd, numLists; ForeachInfo *infoPtr; ForeachVarList *varListPtr; Tcl_Obj *listPtr,*valuePtr, *value2Ptr, **elements; Var *iterVarPtr, *listVarPtr, *varPtr; - int iterNum, listTmpIndex, listLen, numVars; + int opnd, numLists, iterNum, listTmpIndex, listLen, numVars; int varIndex, valIndex, continueLoop, j; long i; @@ -6409,13 +6443,13 @@ TclExecuteByteCode( "%u => ERROR init. index temp %d: ", opnd,varIndex), Tcl_GetObjResult(interp)); result = TCL_ERROR; - Tcl_DecrRefCount(listPtr); + TclDecrRefCount(listPtr); goto checkForCatch; } } valIndex++; } - Tcl_DecrRefCount(listPtr); + TclDecrRefCount(listPtr); listTmpIndex++; } } @@ -6538,7 +6572,7 @@ TclExecuteByteCode( dictPtr = varPtr->value.objPtr; } else { DECACHE_STACK_INFO(); - dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd2); + dictPtr = TclPtrGetVar(interp, varPtr, NULL,NULL,NULL, 0, opnd2); CACHE_STACK_INFO(); } if (dictPtr == NULL) { @@ -6578,7 +6612,7 @@ TclExecuteByteCode( if (result == TCL_OK) { Tcl_InvalidateStringRep(dictPtr); } - Tcl_DecrRefCount(incrPtr); + TclDecrRefCount(incrPtr); } break; case INST_DICT_UNSET: @@ -6593,7 +6627,7 @@ TclExecuteByteCode( if (result != TCL_OK) { if (allocateDict) { - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); } TRACE_WITH_OBJ(("%u %u => ERROR updating dictionary: ", opnd, opnd2), Tcl_GetObjResult(interp)); @@ -6606,7 +6640,7 @@ TclExecuteByteCode( Tcl_IncrRefCount(dictPtr); if (oldValuePtr != NULL) { - Tcl_DecrRefCount(oldValuePtr); + TclDecrRefCount(oldValuePtr); } varPtr->value.objPtr = dictPtr; } @@ -6617,7 +6651,7 @@ TclExecuteByteCode( objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL, dictPtr, TCL_LEAVE_ERR_MSG, opnd2); CACHE_STACK_INFO(); - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); if (objResultPtr == NULL) { TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); @@ -6662,7 +6696,7 @@ TclExecuteByteCode( result = Tcl_DictObjGet(interp, dictPtr, OBJ_UNDER_TOS, &valPtr); if (result != TCL_OK) { if (allocateDict) { - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); } goto checkForCatch; } @@ -6695,9 +6729,9 @@ TclExecuteByteCode( valPtr = Tcl_DuplicateObj(valPtr); result = Tcl_ListObjAppendElement(interp, valPtr, OBJ_AT_TOS); if (result != TCL_OK) { - Tcl_DecrRefCount(valPtr); + TclDecrRefCount(valPtr); if (allocateDict) { - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); } goto checkForCatch; } @@ -6705,7 +6739,7 @@ TclExecuteByteCode( result = Tcl_ListObjAppendElement(interp, valPtr, OBJ_AT_TOS); if (result != TCL_OK) { if (allocateDict) { - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); } goto checkForCatch; } @@ -6723,7 +6757,7 @@ TclExecuteByteCode( Tcl_IncrRefCount(dictPtr); if (oldValuePtr != NULL) { - Tcl_DecrRefCount(oldValuePtr); + TclDecrRefCount(oldValuePtr); } varPtr->value.objPtr = dictPtr; } @@ -6734,7 +6768,7 @@ TclExecuteByteCode( objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL, dictPtr, TCL_LEAVE_ERR_MSG, opnd); CACHE_STACK_INFO(); - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); if (objResultPtr == NULL) { TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); @@ -6775,7 +6809,7 @@ TclExecuteByteCode( varPtr = (compiledLocals + opnd); if (varPtr->value.objPtr) { if (varPtr->value.objPtr->typePtr != &dictIteratorType) { - Tcl_DecrRefCount(varPtr->value.objPtr); + TclDecrRefCount(varPtr->value.objPtr); } else { Tcl_Panic("mis-issued dictFirst!"); } @@ -6828,14 +6862,14 @@ TclExecuteByteCode( ckfree((char *) searchPtr); dictPtr = (Tcl_Obj *) statePtr->internalRep.twoPtrValue.ptr2; - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); /* * Set the internal variable to an empty object to signify that we * don't hold an iterator. */ - Tcl_DecrRefCount(statePtr); + TclDecrRefCount(statePtr); TclNewObj(emptyPtr); compiledLocals[opnd].value.objPtr = emptyPtr; Tcl_IncrRefCount(emptyPtr); @@ -6960,7 +6994,7 @@ TclExecuteByteCode( } if (TclIsVarDirectWritable(varPtr)) { Tcl_IncrRefCount(dictPtr); - Tcl_DecrRefCount(varPtr->value.objPtr); + TclDecrRefCount(varPtr->value.objPtr); varPtr->value.objPtr = dictPtr; } else { DECACHE_STACK_INFO(); @@ -6969,7 +7003,7 @@ TclExecuteByteCode( CACHE_STACK_INFO(); if (objResultPtr == NULL) { if (allocdict) { - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); } result = TCL_ERROR; goto checkForCatch; @@ -7077,7 +7111,8 @@ TclExecuteByteCode( NEXT_INST_F(0, 0, 0); } else { if (rangePtr->continueOffset == -1) { - TRACE_APPEND(("%s, loop w/o continue, checking for catch\n", + TRACE_APPEND(( + "%s, loop w/o continue, checking for catch\n", StringForResultCode(result))); goto checkForCatch; } @@ -7166,6 +7201,7 @@ TclExecuteByteCode( * script to INST_EVAL. Cannot correct the compiler without * breakingcompat with previous .tbc compiled scripts. */ + #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { fprintf(stdout, " ... no enclosing catch, returning %s\n", @@ -7183,21 +7219,21 @@ TclExecuteByteCode( * had when starting to execute the range's catch command. */ - processCatch: + processCatch: while (CURR_DEPTH > *catchTop) { valuePtr = POP_OBJECT(); TclDecrRefCount(valuePtr); } #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { - fprintf(stdout, " ... found catch at %d, catchTop=%d, unwound to %ld, new pc %u\n", - rangePtr->codeOffset, (catchTop - initCatchTop - 1), - (long) *catchTop, - (unsigned int)(rangePtr->catchOffset)); + fprintf(stdout, " ... found catch at %d, catchTop=%d, " + "unwound to %ld, new pc %u\n", + rangePtr->codeOffset, catchTop - initCatchTop - 1, + (long) *catchTop, (unsigned) rangePtr->catchOffset); } #endif pc = (codePtr->codeStart + rangePtr->catchOffset); - NEXT_INST_F(0, 0, 0); /* restart the execution loop at pc */ + NEXT_INST_F(0, 0, 0); /* Restart the execution loop at pc. */ /* * end of infinite loop dispatching on instructions. @@ -7209,30 +7245,31 @@ TclExecuteByteCode( * initial level. */ - abnormalReturn: - { - TCL_DTRACE_INST_LAST(); - while (tosPtr > initTosPtr) { - Tcl_Obj *objPtr = POP_OBJECT(); - Tcl_DecrRefCount(objPtr); - } + abnormalReturn: + TCL_DTRACE_INST_LAST(); + while (tosPtr > initTosPtr) { + Tcl_Obj *objPtr = POP_OBJECT(); - /* - * Clear all expansions. - */ + Tcl_DecrRefCount(objPtr); + } - while (expandNestList) { - Tcl_Obj *objPtr = expandNestList->internalRep.twoPtrValue.ptr2; - TclDecrRefCount(expandNestList); - expandNestList = objPtr; - } - if (tosPtr < initTosPtr) { - fprintf(stderr, "\nTclExecuteByteCode: abnormal return at pc %u: stack top %d < entry stack top %d\n", - (unsigned int)(pc - codePtr->codeStart), - (unsigned int) CURR_DEPTH, - (unsigned int) 0); - Tcl_Panic("TclExecuteByteCode execution failure: end stack top < start stack top"); - } + /* + * Clear all expansions. + */ + + while (expandNestList) { + Tcl_Obj *objPtr = expandNestList->internalRep.twoPtrValue.ptr2; + + TclDecrRefCount(expandNestList); + expandNestList = objPtr; + } + if (tosPtr < initTosPtr) { + fprintf(stderr, + "\nTclExecuteByteCode: abnormal return at pc %u: " + "stack top %d < entry stack top %d\n", + (unsigned)(pc - codePtr->codeStart), + (unsigned) CURR_DEPTH, (unsigned) 0); + Tcl_Panic("TclExecuteByteCode execution failure: end stack top < start stack top"); } } @@ -7285,17 +7322,17 @@ PrintByteCodeInfo( codePtr->numAuxDataItems, codePtr->maxStackDepth, #ifdef TCL_COMPILE_STATS codePtr->numSrcBytes? - ((float)codePtr->structureSize)/codePtr->numSrcBytes : + ((float)codePtr->structureSize)/codePtr->numSrcBytes : #endif 0.0); #ifdef TCL_COMPILE_STATS fprintf(stdout, " Code %lu = header %lu+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n", (unsigned long) codePtr->structureSize, - (unsigned long) (sizeof(ByteCode) - (sizeof(size_t) + sizeof(Tcl_Time))), + (unsigned long) (sizeof(ByteCode)-sizeof(size_t)-sizeof(Tcl_Time)), codePtr->numCodeBytes, (unsigned long) (codePtr->numLitObjects * sizeof(Tcl_Obj *)), - (unsigned long) (codePtr->numExceptRanges * sizeof(ExceptionRange)), + (unsigned long) (codePtr->numExceptRanges*sizeof(ExceptionRange)), (unsigned long) (codePtr->numAuxDataItems * sizeof(AuxData)), codePtr->numCmdLocBytes); #endif /* TCL_COMPILE_STATS */ @@ -7343,7 +7380,7 @@ ValidatePcAndStackTop( { int stackUpperBound = stackLowerBound + codePtr->maxStackDepth; /* Greatest legal value for stackTop. */ - unsigned int relativePc = (unsigned int) (pc - codePtr->codeStart); + unsigned relativePc = (unsigned) (pc - codePtr->codeStart); unsigned long codeStart = (unsigned long) codePtr->codeStart; unsigned long codeEnd = (unsigned long) (codePtr->codeStart + codePtr->numCodeBytes); @@ -7354,9 +7391,9 @@ ValidatePcAndStackTop( pc); Tcl_Panic("TclExecuteByteCode execution failure: bad pc"); } - if ((unsigned int) opCode > LAST_INST_OPCODE) { + if ((unsigned) opCode > LAST_INST_OPCODE) { fprintf(stderr, "\nBad opcode %d at pc %u in TclExecuteByteCode\n", - (unsigned int) opCode, relativePc); + (unsigned) opCode, relativePc); Tcl_Panic("TclExecuteByteCode execution failure: bad opcode"); } if (checkStack && @@ -7573,7 +7610,7 @@ GetSrcInfoForPc( srcLengthNext = codePtr->srcLengthStart; codeOffset = srcOffset = 0; for (i = 0; i < numCmds; i++) { - if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) { + if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) { codeDeltaNext++; delta = TclGetInt4AtPtr(codeDeltaNext); codeDeltaNext += 4; @@ -7583,7 +7620,7 @@ GetSrcInfoForPc( } codeOffset += delta; - if ((unsigned int) (*codeLengthNext) == (unsigned int) 0xFF) { + if ((unsigned) *codeLengthNext == (unsigned) 0xFF) { codeLengthNext++; codeLen = TclGetInt4AtPtr(codeLengthNext); codeLengthNext += 4; @@ -7593,7 +7630,7 @@ GetSrcInfoForPc( } codeEnd = (codeOffset + codeLen - 1); - if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) { + if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) { srcDeltaNext++; delta = TclGetInt4AtPtr(srcDeltaNext); srcDeltaNext += 4; @@ -7603,7 +7640,7 @@ GetSrcInfoForPc( } srcOffset += delta; - if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) { + if ((unsigned) *srcLengthNext == (unsigned) 0xFF) { srcLengthNext++; srcLen = TclGetInt4AtPtr(srcLengthNext); srcLengthNext += 4; @@ -7676,7 +7713,7 @@ GetExceptRangeForPc( ExceptionRange *rangeArrayPtr; int numRanges = codePtr->numExceptRanges; register ExceptionRange *rangePtr; - int pcOffset = (pc - codePtr->codeStart); + int pcOffset = pc - codePtr->codeStart; register int start; if (numRanges == 0) { @@ -7856,6 +7893,8 @@ EvalStatsCmd( char *litTableStats; LiteralEntry *entryPtr; +#define Percent(a,b) ((a) * 100.0 / (b)) + numInstructions = 0.0; for (i = 0; i < 256; i++) { if (statsPtr->instructionCount[i] != 0) { @@ -7873,7 +7912,7 @@ EvalStatsCmd( numCurrentByteCodes = statsPtr->numCompilations - statsPtr->numByteCodesFreed; currentHeaderBytes = numCurrentByteCodes - * (sizeof(ByteCode) - (sizeof(size_t) + sizeof(Tcl_Time))); + * (sizeof(ByteCode) - sizeof(size_t) - sizeof(Tcl_Time)); literalMgmtBytes = sizeof(LiteralTable) + (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)) + (iPtr->literalTable.numEntries * sizeof(LiteralEntry)); @@ -7896,7 +7935,7 @@ EvalStatsCmd( fprintf(stdout, "Number ByteCodes compiled %ld\n", statsPtr->numCompilations); fprintf(stdout, " Mean executions/compile %.1f\n", - ((float)statsPtr->numExecutions) / statsPtr->numCompilations); + statsPtr->numExecutions / (float)statsPtr->numCompilations); fprintf(stdout, "\nInstructions executed %.0f\n", numInstructions); @@ -8013,21 +8052,21 @@ EvalStatsCmd( fprintf(stdout, "\nCurrent literal objects %d (%0.1f%% of current objects)\n", globalTablePtr->numEntries, - (globalTablePtr->numEntries * 100.0) / (tclObjsAlloced-tclObjsFreed)); + Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed)); fprintf(stdout, " ByteCode literals %ld (%0.1f%% of current literals)\n", numByteCodeLits, - (numByteCodeLits * 100.0) / globalTablePtr->numEntries); + Percent(numByteCodeLits, globalTablePtr->numEntries)); fprintf(stdout, " Literals reused > 1x %d\n", numSharedMultX); fprintf(stdout, " Mean reference count %.2f\n", ((double) refCountSum) / globalTablePtr->numEntries); fprintf(stdout, " Mean len, str reused >1x %.2f\n", - (numSharedMultX? (strBytesSharedMultX/numSharedMultX) : 0.0)); + (numSharedMultX ? strBytesSharedMultX/numSharedMultX : 0.0)); fprintf(stdout, " Mean len, str used 1x %.2f\n", - (numSharedOnce? (strBytesSharedOnce/numSharedOnce) : 0.0)); + (numSharedOnce ? strBytesSharedOnce/numSharedOnce : 0.0)); fprintf(stdout, " Total sharing savings %.6g (%0.1f%% of bytes if no sharing)\n", sharingBytesSaved, - (sharingBytesSaved * 100.0) / (objBytesIfUnshared + strBytesIfUnshared)); + Percent(sharingBytesSaved, objBytesIfUnshared+strBytesIfUnshared)); fprintf(stdout, " Bytes with sharing %.6g\n", currentLiteralBytes); fprintf(stdout, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n", @@ -8044,7 +8083,7 @@ EvalStatsCmd( strBytesIfUnshared, statsPtr->currentLitStringBytes); fprintf(stdout, " Literal mgmt overhead %ld (%0.1f%% of bytes with sharing)\n", literalMgmtBytes, - (literalMgmtBytes * 100.0) / currentLiteralBytes); + Percent(literalMgmtBytes, currentLiteralBytes)); fprintf(stdout, " table %lu + buckets %lu + entries %lu\n", (unsigned long) sizeof(LiteralTable), (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)), @@ -8062,27 +8101,27 @@ EvalStatsCmd( statsPtr->currentByteCodeBytes / numCurrentByteCodes); fprintf(stdout, "Header %12.6g %8.1f%% %8.1f\n", currentHeaderBytes, - (currentHeaderBytes * 100.0) / statsPtr->currentByteCodeBytes, + Percent(currentHeaderBytes, statsPtr->currentByteCodeBytes), currentHeaderBytes / numCurrentByteCodes); fprintf(stdout, "Instructions %12.6g %8.1f%% %8.1f\n", statsPtr->currentInstBytes, - (statsPtr->currentInstBytes*100.0)/statsPtr->currentByteCodeBytes, + Percent(statsPtr->currentInstBytes,statsPtr->currentByteCodeBytes), statsPtr->currentInstBytes / numCurrentByteCodes); fprintf(stdout, "Literal ptr array %12.6g %8.1f%% %8.1f\n", statsPtr->currentLitBytes, - (statsPtr->currentLitBytes*100.0)/statsPtr->currentByteCodeBytes, + Percent(statsPtr->currentLitBytes,statsPtr->currentByteCodeBytes), statsPtr->currentLitBytes / numCurrentByteCodes); fprintf(stdout, "Exception table %12.6g %8.1f%% %8.1f\n", statsPtr->currentExceptBytes, - (statsPtr->currentExceptBytes*100.0)/statsPtr->currentByteCodeBytes, + Percent(statsPtr->currentExceptBytes,statsPtr->currentByteCodeBytes), statsPtr->currentExceptBytes / numCurrentByteCodes); fprintf(stdout, "Auxiliary data %12.6g %8.1f%% %8.1f\n", statsPtr->currentAuxBytes, - (statsPtr->currentAuxBytes*100.0)/statsPtr->currentByteCodeBytes, + Percent(statsPtr->currentAuxBytes,statsPtr->currentByteCodeBytes), statsPtr->currentAuxBytes / numCurrentByteCodes); fprintf(stdout, "Command map %12.6g %8.1f%% %8.1f\n", statsPtr->currentCmdMapBytes, - (statsPtr->currentCmdMapBytes*100.0)/statsPtr->currentByteCodeBytes, + Percent(statsPtr->currentCmdMapBytes,statsPtr->currentByteCodeBytes), statsPtr->currentCmdMapBytes / numCurrentByteCodes); /* @@ -8103,7 +8142,7 @@ EvalStatsCmd( decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->literalCount[i]; fprintf(stdout, " %10d %8.0f%%\n", - decadeHigh, (sum * 100.0) / statsPtr->numLiteralsCreated); + decadeHigh, Percent(sum, statsPtr->numLiteralsCreated)); } litTableStats = TclLiteralStats(globalTablePtr); @@ -8135,7 +8174,7 @@ EvalStatsCmd( decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->srcCount[i]; fprintf(stdout, " %10d %8.0f%%\n", - decadeHigh, (sum * 100.0) / statsPtr->numCompilations); + decadeHigh, Percent(sum, statsPtr->numCompilations)); } fprintf(stdout, "\nByteCode sizes:\n"); @@ -8158,7 +8197,7 @@ EvalStatsCmd( decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->byteCodeCount[i]; fprintf(stdout, " %10d %8.0f%%\n", - decadeHigh, (sum * 100.0) / statsPtr->numCompilations); + decadeHigh, Percent(sum, statsPtr->numCompilations)); } fprintf(stdout, "\nByteCode longevity (excludes Current ByteCodes):\n"); @@ -8181,8 +8220,7 @@ EvalStatsCmd( decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->lifetimeCount[i]; fprintf(stdout, " %12.3f %8.0f%%\n", - decadeHigh / 1000.0, - (sum * 100.0) / statsPtr->numByteCodesFreed); + decadeHigh/1000.0, Percent(sum, statsPtr->numByteCodesFreed)); } /* @@ -8191,11 +8229,11 @@ EvalStatsCmd( fprintf(stdout, "\nInstruction counts:\n"); for (i = 0; i <= LAST_INST_OPCODE; i++) { - if (statsPtr->instructionCount[i]) { + if (statsPtr->instructionCount[i] == 0) { fprintf(stdout, "%20s %8ld %6.1f%%\n", tclInstructionTable[i].name, statsPtr->instructionCount[i], - (statsPtr->instructionCount[i]*100.0) / numInstructions); + Percent(statsPtr->instructionCount[i], numInstructions)); } } diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 56c0435..d3ca07c 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclFileName.c,v 1.83.2.1 2007/06/21 16:04:56 dgp Exp $ + * RCS: @(#) $Id: tclFileName.c,v 1.83.2.2 2007/11/21 06:30:51 dgp Exp $ */ #include "tclInt.h" @@ -1154,7 +1154,7 @@ DoTildeSubst( if (interp) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't find HOME environment " - "variable to expand path", (char *) NULL); + "variable to expand path", NULL); } return NULL; } @@ -1164,7 +1164,7 @@ DoTildeSubst( if (interp) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist", - (char *) NULL); + NULL); } return NULL; } @@ -1598,19 +1598,18 @@ Tcl_GlobObjCmd( if (length == 0) { Tcl_AppendResult(interp, "no files matched glob pattern", - (join || (objc == 1)) ? " \"" : "s \"", (char *) NULL); + (join || (objc == 1)) ? " \"" : "s \"", NULL); if (join) { - Tcl_AppendResult(interp, Tcl_DStringValue(&prefix), - (char *) NULL); + Tcl_AppendResult(interp, Tcl_DStringValue(&prefix), NULL); } else { const char *sep = ""; for (i = 0; i < objc; i++) { string = Tcl_GetString(objv[i]); - Tcl_AppendResult(interp, sep, string, (char *) NULL); + Tcl_AppendResult(interp, sep, string, NULL); sep = " "; } } - Tcl_AppendResult(interp, "\"", (char *) NULL); + Tcl_AppendResult(interp, "\"", NULL); result = TCL_ERROR; } } diff --git a/generic/tclIO.c b/generic/tclIO.c index c47eaea..c65a192 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIO.c,v 1.121.2.4 2007/11/12 19:18:17 dgp Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.121.2.5 2007/11/21 06:30:51 dgp Exp $ */ #include "tclInt.h" @@ -179,6 +179,13 @@ static void CutChannel(Tcl_Channel chan); #define RemovePoint(bufPtr) ((bufPtr)->buf + (bufPtr)->nextRemoved) /* + * For working with channel state flag bits. + */ + +#define SetFlag(statePtr, flag) ((statePtr)->flags |= (flag)) +#define ResetFlag(statePtr, flag) ((statePtr)->flags &= ~(flag)) + +/* * Macro for testing whether a string (in optionName, length len) matches a * value (prefix matching rules). Arguments are the minimum length to match * and the value to match against. (Can't use Tcl_GetIndexFromObj as this is @@ -245,23 +252,21 @@ TclFinalizeIOSubsystem(void) int active = 1; /* Flag == 1 while there's still work to do */ /* - * Walk all channel state structures known to this thread and - * close corresponding channels. + * Walk all channel state structures known to this thread and close + * corresponding channels. */ while (active) { - /* - * Iterate through the open channel list, and find the first - * channel that isn't dead. We start from the head of the list - * each time, because the close action on one channel can close - * others. + * Iterate through the open channel list, and find the first channel + * that isn't dead. We start from the head of the list each time, + * because the close action on one channel can close others. */ active = 0; for (statePtr = tsdPtr->firstCSPtr; - statePtr != NULL; - statePtr = statePtr->nextCSPtr) { + statePtr != NULL; + statePtr = statePtr->nextCSPtr) { chanPtr = statePtr->topChanPtr; if (!(statePtr->flags & CHANNEL_DEAD)) { active = 1; @@ -270,67 +275,65 @@ TclFinalizeIOSubsystem(void) } /* - * We've found a live channel. Close it. + * We've found a live channel. Close it. */ if (active) { - /* - * Set the channel back into blocking mode to ensure that we - * wait for all data to flush out. + * Set the channel back into blocking mode to ensure that we wait + * for all data to flush out. */ - + (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr, - "-blocking", "on"); - + "-blocking", "on"); + if ((chanPtr == (Channel *) tsdPtr->stdinChannel) || - (chanPtr == (Channel *) tsdPtr->stdoutChannel) || - (chanPtr == (Channel *) tsdPtr->stderrChannel)) { + (chanPtr == (Channel *) tsdPtr->stdoutChannel) || + (chanPtr == (Channel *) tsdPtr->stderrChannel)) { /* - * Decrement the refcount which was earlier artificially + * Decrement the refcount which was earlier artificially * bumped up to keep the channel from being closed. */ - + statePtr->refCount--; } - + if (statePtr->refCount <= 0) { /* - * Close it only if the refcount indicates that the channel - * is not referenced from any interpreter. If it is, that + * Close it only if the refcount indicates that the channel is + * not referenced from any interpreter. If it is, that * interpreter will close the channel when it gets destroyed. */ - + (void) Tcl_Close(NULL, (Tcl_Channel) chanPtr); } else { /* * The refcount is greater than zero, so flush the channel. */ - + Tcl_Flush((Tcl_Channel) chanPtr); - + /* - * Call the device driver to actually close the underlying + * Call the device driver to actually close the underlying * device for this channel. */ - + if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) { (chanPtr->typePtr->closeProc)(chanPtr->instanceData, NULL); } else { (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, - NULL, 0); + NULL, 0); } - + /* - * Finally, we clean up the fields in the channel data - * structure since all of them have been deleted already. - * We mark the channel with CHANNEL_DEAD to prevent any - * further IO operations - * on it. + * Finally, we clean up the fields in the channel data + * structure since all of them have been deleted already. We + * mark the channel with CHANNEL_DEAD to prevent any further + * IO operations on it. */ - + chanPtr->instanceData = NULL; - statePtr->flags |= CHANNEL_DEAD; + SetFlag(statePtr, CHANNEL_DEAD); } } } @@ -632,10 +635,10 @@ DeleteChannelTable( * refcount reaches zero. */ - hTblPtr = (Tcl_HashTable *) clientData; + hTblPtr = clientData; for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL; hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) { - chanPtr = (Channel *) Tcl_GetHashValue(hPtr); + chanPtr = Tcl_GetHashValue(hPtr); statePtr = chanPtr->state; /* @@ -793,7 +796,7 @@ Tcl_RegisterChannel( { Tcl_HashTable *hTblPtr; /* Hash table of channels. */ Tcl_HashEntry *hPtr; /* Search variable. */ - int new; /* Is the hash entry new or does it exist? */ + int isNew; /* Is the hash entry new or does it exist? */ Channel *chanPtr; /* The actual channel. */ ChannelState *statePtr; /* State of the actual channel. */ @@ -811,15 +814,15 @@ Tcl_RegisterChannel( } if (interp != NULL) { hTblPtr = GetChannelTable(interp); - hPtr = Tcl_CreateHashEntry(hTblPtr, statePtr->channelName, &new); - if (new == 0) { - if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) { + hPtr = Tcl_CreateHashEntry(hTblPtr, statePtr->channelName, &isNew); + if (!isNew) { + if (chan == Tcl_GetHashValue(hPtr)) { return; } Tcl_Panic("Tcl_RegisterChannel: duplicate channel names"); } - Tcl_SetHashValue(hPtr, (ClientData) chanPtr); + Tcl_SetHashValue(hPtr, chanPtr); } statePtr->refCount++; } @@ -895,7 +898,7 @@ Tcl_UnregisterChannel( if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) { - statePtr->flags |= BUFFER_READY; + SetFlag(statePtr, BUFFER_READY); } Tcl_Preserve((ClientData)statePtr); if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) { @@ -905,13 +908,13 @@ Tcl_UnregisterChannel( if (!(statePtr->flags & CHANNEL_CLOSED)) { if (Tcl_Close(interp, chan) != TCL_OK) { - statePtr->flags |= CHANNEL_CLOSED; + SetFlag(statePtr, CHANNEL_CLOSED); Tcl_Release((ClientData)statePtr); return TCL_ERROR; } } } - statePtr->flags |= CHANNEL_CLOSED; + SetFlag(statePtr, CHANNEL_CLOSED); Tcl_Release((ClientData)statePtr); } return TCL_OK; @@ -1098,9 +1101,7 @@ Tcl_GetChannel( if (hPtr == NULL) { Tcl_AppendResult(interp, "can not find channel named \"", chanName, "\"", NULL); -#if 0 - Tcl_SetErrorCode(interp, "CORE", "LOOKUP", "CHANNEL", chanName, NULL); -#endif + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanName, NULL); return NULL; } @@ -1110,7 +1111,7 @@ Tcl_GetChannel( * compensate where necessary to retrieve the topmost channel again. */ - chanPtr = (Channel *) Tcl_GetHashValue(hPtr); + chanPtr = Tcl_GetHashValue(hPtr); chanPtr = chanPtr->state->bottomChanPtr; if (modePtr != NULL) { *modePtr = (chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE)); @@ -1213,8 +1214,8 @@ Tcl_CreateChannel( * Set the channel up initially in AUTO input translation mode to accept * "\n", "\r" and "\r\n". Output translation mode is set to a platform * specific default value. The eofChar is set to 0 for both input and - * output, so that Tcl does not look for an in-file EOF indicator - * (e.g. ^Z) and does not append an EOF indicator to files. + * output, so that Tcl does not look for an in-file EOF indicator (e.g. + * ^Z) and does not append an EOF indicator to files. */ statePtr->inputTranslation = TCL_TRANSLATE_AUTO; @@ -1321,10 +1322,10 @@ Tcl_CreateChannel( * information about prevChan. * * Side effects: - * A new channel structure is allocated and linked below the existing - * channel. The channel operations and client data of the existing channel - * are copied down to the newly created channel, and the current channel - * has its operations replaced by the new typePtr. + * A new channel structure is allocated and linked below the existing + * channel. The channel operations and client data of the existing + * channel are copied down to the newly created channel, and the current + * channel has its operations replaced by the new typePtr. * *---------------------------------------------------------------------- */ @@ -1332,7 +1333,7 @@ Tcl_CreateChannel( Tcl_Channel Tcl_StackChannel( Tcl_Interp *interp, /* The interpreter we are working in */ - Tcl_ChannelType *typePtr, /* The channel type record for the new + Tcl_ChannelType *typePtr, /* The channel type record for the new * channel. */ ClientData instanceData, /* Instance specific data for the new * channel. */ @@ -1364,7 +1365,7 @@ Tcl_StackChannel( Tcl_AppendResult(interp, "couldn't find state for channel \"", Tcl_GetChannelName(prevChan), "\"", NULL); } - return (Tcl_Channel) NULL; + return NULL; } /* @@ -1386,7 +1387,7 @@ Tcl_StackChannel( "reading and writing both disallowed for channel \"", Tcl_GetChannelName(prevChan), "\"", NULL); } - return (Tcl_Channel) NULL; + return NULL; } /* @@ -1408,7 +1409,7 @@ Tcl_StackChannel( Tcl_AppendResult(interp, "could not flush channel \"", Tcl_GetChannelName(prevChan), "\"", NULL); } - return (Tcl_Channel) NULL; + return NULL; } statePtr->csPtr = csPtr; @@ -1580,7 +1581,7 @@ Tcl_UnstackChannel( * 'DiscardInputQueued' on that. */ - if (((statePtr->flags & TCL_READABLE) != 0) && + if ((((statePtr->flags & TCL_READABLE) != 0)) && ((statePtr->inQueueHead != NULL) || (chanPtr->inQueueHead != NULL))) { @@ -1645,7 +1646,7 @@ Tcl_UnstackChannel( * AK: Tcl_NotifyChannel may hold a reference to this block of memory */ - Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC); + Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC); UpdateInterest(downChanPtr); if (result != 0) { @@ -2172,7 +2173,7 @@ FlushChannel( IsBufferFull(statePtr->curOutPtr)) || ((statePtr->flags & BUFFER_READY) && (statePtr->outQueueHead == NULL))) { - statePtr->flags &= ~BUFFER_READY; + ResetFlag(statePtr, BUFFER_READY); statePtr->curOutPtr->nextPtr = NULL; if (statePtr->outQueueHead == NULL) { statePtr->outQueueHead = statePtr->curOutPtr; @@ -2240,7 +2241,7 @@ FlushChannel( */ if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) { - statePtr->flags |= BG_FLUSH_SCHEDULED; + SetFlag(statePtr, BG_FLUSH_SCHEDULED); UpdateInterest(chanPtr); } errorCode = 0; @@ -2342,7 +2343,7 @@ FlushChannel( if (wroteSome) { return errorCode; } else if (statePtr->outQueueHead == NULL) { - statePtr->flags &= ~BG_FLUSH_SCHEDULED; + ResetFlag(statePtr, BG_FLUSH_SCHEDULED); (chanPtr->typePtr->watchProc)(chanPtr->instanceData, statePtr->interestMask); } @@ -2536,7 +2537,7 @@ CloseChannel( downChanPtr->upChanPtr = NULL; chanPtr->typePtr = NULL; - Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC); + Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC); return Tcl_Close(interp, (Tcl_Channel) downChanPtr); } @@ -2549,8 +2550,8 @@ CloseChannel( chanPtr->typePtr = NULL; - Tcl_EventuallyFree((ClientData) statePtr, TCL_DYNAMIC); - Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC); + Tcl_EventuallyFree(statePtr, TCL_DYNAMIC); + Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC); return errorCode; } @@ -2845,7 +2846,7 @@ Tcl_Close( } return TCL_ERROR; } - statePtr->flags |= CHANNEL_INCLOSE; + SetFlag(statePtr, CHANNEL_INCLOSE); /* * When the channel has an escape sequence driven encoding such as @@ -2885,14 +2886,14 @@ Tcl_Close( ckfree((char *) cbPtr); } - statePtr->flags &= ~CHANNEL_INCLOSE; + ResetFlag(statePtr, CHANNEL_INCLOSE); /* * Ensure that the last output buffer will be flushed. */ if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) { - statePtr->flags |= BUFFER_READY; + SetFlag(statePtr, BUFFER_READY); } /* @@ -2913,7 +2914,7 @@ Tcl_Close( * be flushed and closed asynchronously. */ - statePtr->flags |= CHANNEL_CLOSED; + SetFlag(statePtr, CHANNEL_CLOSED); flushcode = FlushChannel(interp, chanPtr, 0); @@ -3764,13 +3765,13 @@ CheckFlush( if ((statePtr->flags & BUFFER_READY) == 0) { if (IsBufferFull(bufPtr)) { - statePtr->flags |= BUFFER_READY; + SetFlag(statePtr, BUFFER_READY); } else if (statePtr->flags & CHANNEL_LINEBUFFERED) { if (newlineFlag != 0) { - statePtr->flags |= BUFFER_READY; + SetFlag(statePtr, BUFFER_READY); } } else if (statePtr->flags & CHANNEL_UNBUFFERED) { - statePtr->flags |= BUFFER_READY; + SetFlag(statePtr, BUFFER_READY); } } if (statePtr->flags & BUFFER_READY) { @@ -3873,9 +3874,9 @@ Tcl_GetsObj( } /* - * A binary version of Tcl_GetsObj. This could also handle encodings - * that are ascii-7 pure (iso8859, utf-8, ...) with a final encoding - * conversion done on objPtr. + * A binary version of Tcl_GetsObj. This could also handle encodings that + * are ascii-7 pure (iso8859, utf-8, ...) with a final encoding conversion + * done on objPtr. */ if ((statePtr->encoding == NULL) @@ -3907,6 +3908,7 @@ Tcl_GetsObj( if (encoding == NULL) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + if (tsdPtr->binaryEncoding == NULL) { tsdPtr->binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1"); Tcl_CreateThreadExitHandler(FreeBinaryEncoding, NULL); @@ -4002,7 +4004,7 @@ Tcl_GetsObj( offset = eol - objPtr->bytes; dst = dstEnd; if (FilterInputBytes(chanPtr, &gs) != 0) { - goto restore; + goto restore; } dstEnd = dst + gs.bytesWrote; eol = objPtr->bytes + offset; @@ -4024,7 +4026,7 @@ Tcl_GetsObj( eol = dst; skip = 1; if (statePtr->flags & INPUT_SAW_CR) { - statePtr->flags &= ~INPUT_SAW_CR; + ResetFlag(statePtr, INPUT_SAW_CR); if ((eol < dstEnd) && (*eol == '\n')) { /* * Skip the raw bytes that make up the '\n'. @@ -4066,7 +4068,7 @@ Tcl_GetsObj( if (eol >= dstEnd) { eol--; - statePtr->flags |= INPUT_SAW_CR; + SetFlag(statePtr, INPUT_SAW_CR); goto gotEOL; } } @@ -4088,7 +4090,7 @@ Tcl_GetsObj( */ dstEnd = eof; - statePtr->flags |= CHANNEL_EOF | CHANNEL_STICKY_EOF; + SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF); statePtr->inputEncodingFlags |= TCL_ENCODING_END; } if (statePtr->flags & CHANNEL_EOF) { @@ -4136,7 +4138,7 @@ Tcl_GetsObj( Tcl_SetObjLength(objPtr, eol - objPtr->bytes); CommonGetsCleanup(chanPtr); - statePtr->flags &= ~CHANNEL_BLOCKED; + ResetFlag(statePtr, CHANNEL_BLOCKED); copiedTotal = gs.totalChars + gs.charsWrote - skip; goto done; @@ -4173,7 +4175,7 @@ Tcl_GetsObj( * read would be able to consume the buffered data. */ - statePtr->flags |= CHANNEL_NEED_MORE_DATA; + SetFlag(statePtr, CHANNEL_NEED_MORE_DATA); copiedTotal = -1; /* @@ -4269,7 +4271,7 @@ TclGetsObjBinary( if (statePtr->flags & CHANNEL_NONBLOCKING) { goto restore; } - statePtr->flags &= ~CHANNEL_BLOCKED; + ResetFlag(statePtr, CHANNEL_BLOCKED); } if (GetInput(chanPtr) != 0) { goto restore; @@ -4277,7 +4279,7 @@ TclGetsObjBinary( bufPtr = statePtr->inQueueTail; } - dst = (unsigned char*) RemovePoint(bufPtr); + dst = (unsigned char *) RemovePoint(bufPtr); dstEnd = dst + BytesLeft(bufPtr); /* @@ -4314,7 +4316,7 @@ TclGetsObjBinary( * character in the output string. */ - statePtr->flags |= CHANNEL_EOF | CHANNEL_STICKY_EOF; + SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF); statePtr->inputEncodingFlags |= TCL_ENCODING_END; } if (statePtr->flags & CHANNEL_EOF) { @@ -4375,7 +4377,7 @@ TclGetsObjBinary( */ CommonGetsCleanup(chanPtr); - statePtr->flags &= ~CHANNEL_BLOCKED; + ResetFlag(statePtr, CHANNEL_BLOCKED); copiedTotal = byteLen; goto done; @@ -4411,7 +4413,7 @@ TclGetsObjBinary( * read would be able to consume the buffered data. */ - statePtr->flags |= CHANNEL_NEED_MORE_DATA; + SetFlag(statePtr, CHANNEL_NEED_MORE_DATA); copiedTotal = -1; /* @@ -4428,6 +4430,7 @@ TclGetsObjBinary( *--------------------------------------------------------------------------- * * FreeBinaryEncoding -- + * * Frees any "iso8859-1" Tcl_Encoding created by [gets] on a binary * channel in a thread as part of that thread's finalization. * @@ -4442,6 +4445,7 @@ FreeBinaryEncoding( ClientData dummy) /* Not used */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + if (tsdPtr->binaryEncoding != NULL) { Tcl_FreeEncoding(tsdPtr->binaryEncoding); tsdPtr->binaryEncoding = NULL; @@ -4483,7 +4487,7 @@ FilterInputBytes( char *raw, *rawStart, *dst; int offset, toRead, dstNeeded, spaceLeft, result, rawLen, length; Tcl_Obj *objPtr; -#define ENCODING_LINESIZE 20 /* Lower bound on how many bytes to convert at +#define ENCODING_LINESIZE 20 /* Lower bound on how many bytes to convert at * a time. Since we don't know a priori how * many bytes of storage this many source * bytes will use, we actually need at least @@ -4520,7 +4524,7 @@ FilterInputBytes( gsPtr->rawRead = 0; return -1; } - statePtr->flags &= ~CHANNEL_BLOCKED; + ResetFlag(statePtr, CHANNEL_BLOCKED); } if (GetInput(chanPtr) != 0) { gsPtr->charsWrote = 0; @@ -4883,7 +4887,7 @@ Tcl_ReadRaw( if (statePtr->flags & CHANNEL_NONBLOCKING) { goto done; } - statePtr->flags &= ~CHANNEL_BLOCKED; + ResetFlag(statePtr, CHANNEL_BLOCKED); } #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING @@ -4932,7 +4936,7 @@ Tcl_ReadRaw( */ if (nread < (bytesToRead - copied)) { - statePtr->flags |= CHANNEL_BLOCKED; + SetFlag(statePtr, CHANNEL_BLOCKED); } #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING @@ -4942,12 +4946,12 @@ Tcl_ReadRaw( * flag. */ - statePtr->flags &= ~CHANNEL_HAS_MORE_DATA; + ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA); } #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ } else if (nread == 0) { - statePtr->flags |= CHANNEL_EOF; + SetFlag(statePtr, CHANNEL_EOF); statePtr->inputEncodingFlags |= TCL_ENCODING_END; } else if (nread < 0) { @@ -4961,7 +4965,7 @@ Tcl_ReadRaw( return copied; } - statePtr->flags |= CHANNEL_BLOCKED; + SetFlag(statePtr, CHANNEL_BLOCKED); result = EAGAIN; } @@ -5140,7 +5144,7 @@ DoReadChars( if (statePtr->flags & CHANNEL_NONBLOCKING) { break; } - statePtr->flags &= ~CHANNEL_BLOCKED; + ResetFlag(statePtr, CHANNEL_BLOCKED); } result = GetInput(chanPtr); if (result != 0) { @@ -5156,7 +5160,7 @@ DoReadChars( } } - statePtr->flags &= ~CHANNEL_BLOCKED; + ResetFlag(statePtr, CHANNEL_BLOCKED); if (encoding == NULL) { Tcl_SetByteArrayLength(objPtr, offset); } else { @@ -5250,7 +5254,7 @@ ReadBytes( dst += offset; if (statePtr->flags & INPUT_NEED_NL) { - statePtr->flags &= ~INPUT_NEED_NL; + ResetFlag(statePtr, INPUT_NEED_NL); if ((srcLen == 0) || (*src != '\n')) { *dst = '\r'; *offsetPtr += 1; @@ -5379,11 +5383,10 @@ ReadChars( dst = objPtr->bytes + offset; /* - * SF Tcl Bug 1462248 - * The cause of the crash reported in the referenced bug is this: + * [Bug 1462248]: The cause of the crash reported in this bug is this: * * - ReadChars, called with a single buffer, with a incomplete - * multi-byte character at the end (only the first byte of it). + * multi-byte character at the end (only the first byte of it). * - Encoding translation fails, asks for more data * - Data is read, and eof is reached, TCL_ENCODING_END (TEE) is set. * - ReadChar is called again, converts the first buffer, but due to TEE @@ -5415,13 +5418,13 @@ ReadChars( if ((statePtr->inputEncodingFlags & TCL_ENCODING_END) && (bufPtr->nextPtr != NULL)) { - /* + /* * TEE is set for a buffer which is not the last. Squash it for now, * and restore it later, before yielding control to our caller. */ - statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; - encEndFlagSuppressed = 1; + statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; + encEndFlagSuppressed = 1; } oldState = statePtr->inputEncodingState; @@ -5430,7 +5433,7 @@ ReadChars( * We want a '\n' because the last character we saw was '\r'. */ - statePtr->flags &= ~INPUT_NEED_NL; + ResetFlag(statePtr, INPUT_NEED_NL); Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen, statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst, TCL_UTF_MAX + 1, &srcRead, &dstWrote, &numChars); @@ -5461,7 +5464,7 @@ ReadChars( dstNeeded + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars); if (encEndFlagSuppressed) { - statePtr->inputEncodingFlags |= TCL_ENCODING_END; + statePtr->inputEncodingFlags |= TCL_ENCODING_END; } if (srcRead == 0) { @@ -5487,7 +5490,7 @@ ReadChars( * conversion before the current one was complete. */ - statePtr->flags |= CHANNEL_NEED_MORE_DATA; + SetFlag(statePtr, CHANNEL_NEED_MORE_DATA); } return -1; } @@ -5668,7 +5671,7 @@ TranslateInputEOL( if (*src == '\r') { src++; if (src >= srcMax) { - statePtr->flags |= INPUT_NEED_NL; + SetFlag(statePtr, INPUT_NEED_NL); } else if (*src == '\n') { *dst++ = *src++; } else { @@ -5695,13 +5698,13 @@ TranslateInputEOL( if (*src == '\n') { src++; } - statePtr->flags &= ~INPUT_SAW_CR; + ResetFlag(statePtr, INPUT_SAW_CR); } for ( ; src < srcEnd; ) { if (*src == '\r') { src++; if (src >= srcMax) { - statePtr->flags |= INPUT_SAW_CR; + SetFlag(statePtr, INPUT_SAW_CR); } else if (*src == '\n') { if (srcEnd < srcMax) { srcEnd++; @@ -5729,9 +5732,9 @@ TranslateInputEOL( * character in the output string. */ - statePtr->flags |= CHANNEL_EOF | CHANNEL_STICKY_EOF; + SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF); statePtr->inputEncodingFlags |= TCL_ENCODING_END; - statePtr->flags &= ~(INPUT_SAW_CR | INPUT_NEED_NL); + ResetFlag(statePtr, INPUT_SAW_CR | INPUT_NEED_NL); return 1; } @@ -5799,7 +5802,7 @@ Tcl_Ungets( if (statePtr->flags & CHANNEL_STICKY_EOF) { goto done; } - statePtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_EOF); + ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_EOF); bufPtr = AllocChannelBuffer(len); memcpy(InsertPoint(bufPtr), str, (size_t) len); @@ -5869,7 +5872,7 @@ Tcl_Flush( */ if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) { - statePtr->flags |= BUFFER_READY; + SetFlag(statePtr, BUFFER_READY); } result = FlushChannel(NULL, chanPtr, 0); @@ -6095,7 +6098,7 @@ GetInput( */ if (nread < toRead) { - statePtr->flags |= CHANNEL_BLOCKED; + SetFlag(statePtr, CHANNEL_BLOCKED); } #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING @@ -6105,16 +6108,16 @@ GetInput( * flag. */ - statePtr->flags &= ~CHANNEL_HAS_MORE_DATA; + ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA); } #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ } else if (nread == 0) { - statePtr->flags |= CHANNEL_EOF; + SetFlag(statePtr, CHANNEL_EOF); statePtr->inputEncodingFlags |= TCL_ENCODING_END; } else if (nread < 0) { if ((result == EWOULDBLOCK) || (result == EAGAIN)) { - statePtr->flags |= CHANNEL_BLOCKED; + SetFlag(statePtr, CHANNEL_BLOCKED); result = EAGAIN; } Tcl_SetErrno(result); @@ -6241,9 +6244,9 @@ Tcl_Seek( if (result != 0) { return Tcl_LongAsWide(-1); } - statePtr->flags &= ~CHANNEL_NONBLOCKING; + ResetFlag(statePtr, CHANNEL_NONBLOCKING); if (statePtr->flags & BG_FLUSH_SCHEDULED) { - statePtr->flags &= ~BG_FLUSH_SCHEDULED; + ResetFlag(statePtr, BG_FLUSH_SCHEDULED); } } @@ -6253,7 +6256,7 @@ Tcl_Seek( */ if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) { - statePtr->flags |= BUFFER_READY; + SetFlag(statePtr, BUFFER_READY); } /* @@ -6299,7 +6302,7 @@ Tcl_Seek( */ if (wasAsync) { - statePtr->flags |= CHANNEL_NONBLOCKING; + SetFlag(statePtr, CHANNEL_NONBLOCKING); result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING); if (result != 0) { return Tcl_LongAsWide(-1); @@ -6612,9 +6615,9 @@ CheckChannelErrors( */ if ((statePtr->flags & CHANNEL_STICKY_EOF) == 0) { - statePtr->flags &= ~CHANNEL_EOF; + ResetFlag(statePtr, CHANNEL_EOF); } - statePtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA); + ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA); } return 0; @@ -7253,12 +7256,12 @@ Tcl_SetChannelOption( ~(CHANNEL_UNBUFFERED|CHANNEL_LINEBUFFERED); } else if ((newValue[0] == 'l') && (strncmp(newValue, "line", len) == 0)) { - statePtr->flags &= ~CHANNEL_UNBUFFERED; - statePtr->flags |= CHANNEL_LINEBUFFERED; + ResetFlag(statePtr, CHANNEL_UNBUFFERED); + SetFlag(statePtr, CHANNEL_LINEBUFFERED); } else if ((newValue[0] == 'n') && (strncmp(newValue, "none", len) == 0)) { - statePtr->flags &= ~CHANNEL_LINEBUFFERED; - statePtr->flags |= CHANNEL_UNBUFFERED; + ResetFlag(statePtr, CHANNEL_LINEBUFFERED); + SetFlag(statePtr, CHANNEL_UNBUFFERED); } else { if (interp) { Tcl_AppendResult(interp, "bad value for -buffering: " @@ -7302,7 +7305,7 @@ Tcl_SetChannelOption( statePtr->inputEncodingFlags = TCL_ENCODING_START; statePtr->outputEncodingState = NULL; statePtr->outputEncodingFlags = TCL_ENCODING_START; - statePtr->flags &= ~CHANNEL_NEED_MORE_DATA; + ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA); UpdateInterest(chanPtr); } else if (HaveOpt(2, "-eofchar")) { if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) { @@ -7409,7 +7412,7 @@ Tcl_SetChannelOption( if (translation != statePtr->inputTranslation) { statePtr->inputTranslation = translation; - statePtr->flags &= ~(INPUT_SAW_CR | CHANNEL_NEED_MORE_DATA); + ResetFlag(statePtr, INPUT_SAW_CR | CHANNEL_NEED_MORE_DATA); UpdateInterest(chanPtr); } } @@ -7482,12 +7485,11 @@ Tcl_SetChannelOption( */ if (statePtr->outputStage != NULL) { - ckfree((char *) statePtr->outputStage); + ckfree(statePtr->outputStage); statePtr->outputStage = NULL; } if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) { - statePtr->outputStage = (char *) - ckalloc((unsigned) (statePtr->bufSize + 2)); + statePtr->outputStage = ckalloc((unsigned) (statePtr->bufSize + 2)); } return TCL_OK; } @@ -7536,7 +7538,7 @@ CleanupChannelHandlers( } Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, - TclChannelEventScriptInvoker, (ClientData) sPtr); + TclChannelEventScriptInvoker, sPtr); TclDecrRefCount(sPtr->scriptPtr); ckfree((char *) sPtr); @@ -7591,7 +7593,7 @@ Tcl_NotifyChannel( (statePtr->flags & CHANNEL_NONBLOCKING) && (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) && !(statePtr->flags & CHANNEL_TIMER_FEV)) { - statePtr->flags |= CHANNEL_HAS_MORE_DATA; + SetFlag(statePtr, CHANNEL_HAS_MORE_DATA); } #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ @@ -7644,8 +7646,8 @@ Tcl_NotifyChannel( * Preserve the channel struct in case the script closes it. */ - Tcl_Preserve((ClientData) channel); - Tcl_Preserve((ClientData) statePtr); + Tcl_Preserve(channel); + Tcl_Preserve(statePtr); /* * If we are flushing in the background, be sure to call FlushChannel for @@ -7692,8 +7694,8 @@ Tcl_NotifyChannel( UpdateInterest(chanPtr); } - Tcl_Release((ClientData) statePtr); - Tcl_Release((ClientData) channel); + Tcl_Release(statePtr); + Tcl_Release(channel); tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr; } @@ -7787,7 +7789,7 @@ UpdateInterest( if (!statePtr->timer) { statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc, - (ClientData) chanPtr); + chanPtr); } } } @@ -7815,7 +7817,7 @@ static void ChannelTimerProc( ClientData clientData) { - Channel *chanPtr = (Channel *) clientData; + Channel *chanPtr = clientData; ChannelState *statePtr = chanPtr->state; /* State info for channel */ @@ -7828,8 +7830,7 @@ ChannelTimerProc( * before UpdateInterest gets called by Tcl_NotifyChannel. */ - statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc, - (ClientData) chanPtr); + statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,chanPtr); #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING /* @@ -7842,18 +7843,18 @@ ChannelTimerProc( if ((statePtr->flags & CHANNEL_NONBLOCKING) && (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) { - statePtr->flags |= CHANNEL_TIMER_FEV; + SetFlag(statePtr, CHANNEL_TIMER_FEV); } #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ - Tcl_Preserve((ClientData) statePtr); + Tcl_Preserve(statePtr); Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE); #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING - statePtr->flags &= ~CHANNEL_TIMER_FEV; + ResetFlag(statePtr, CHANNEL_TIMER_FEV); #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ - Tcl_Release((ClientData) statePtr); + Tcl_Release(statePtr); } else { statePtr->timer = NULL; UpdateInterest(chanPtr); @@ -8070,7 +8071,7 @@ DeleteScriptRecord( } Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, - TclChannelEventScriptInvoker, (ClientData) esPtr); + TclChannelEventScriptInvoker, esPtr); TclDecrRefCount(esPtr->scriptPtr); ckfree((char *) esPtr); @@ -8120,7 +8121,7 @@ CreateScriptRecord( if (esPtr == NULL) { esPtr = (EventScriptRecord *) ckalloc(sizeof(EventScriptRecord)); Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask, - TclChannelEventScriptInvoker, (ClientData) esPtr); + TclChannelEventScriptInvoker, esPtr); esPtr->nextPtr = statePtr->scriptRecordPtr; statePtr->scriptRecordPtr = esPtr; } @@ -8161,10 +8162,10 @@ TclChannelEventScriptInvoker( * in. */ int result; /* Result of call to eval script. */ - esPtr = (EventScriptRecord *) clientData; - chanPtr = esPtr->chanPtr; - mask = esPtr->mask; - interp = esPtr->interp; + esPtr = clientData; + chanPtr = esPtr->chanPtr; + mask = esPtr->mask; + interp = esPtr->interp; /* * We must preserve the interpreter so we can report errors on it later. @@ -8172,7 +8173,7 @@ TclChannelEventScriptInvoker( * by Tcl_NotifyChannel before calling channel handlers. */ - Tcl_Preserve((ClientData) interp); + Tcl_Preserve(interp); result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL); /* @@ -8189,7 +8190,7 @@ TclChannelEventScriptInvoker( } TclBackgroundException(interp, result); } - Tcl_Release((ClientData) interp); + Tcl_Release(interp); } /* @@ -8241,7 +8242,7 @@ Tcl_FileEventObjCmd( chanName = TclGetString(objv[1]); chan = Tcl_GetChannel(interp, chanName, NULL); - if (chan == (Tcl_Channel) NULL) { + if (chan == NULL) { return TCL_ERROR; } chanPtr = (Channel *) chan; @@ -8492,7 +8493,7 @@ CopyData( size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, 0 /* No append */); } - underflow = (size >= 0) && (size < sizeb); /* Input underflow */ + underflow = (size >= 0) && (size < sizeb); /* Input underflow */ if (size < 0) { readError: @@ -8523,11 +8524,10 @@ CopyData( } if (! Tcl_Eof(inChan) && !(mask & TCL_READABLE)) { if (mask & TCL_WRITABLE) { - Tcl_DeleteChannelHandler(outChan, CopyEventProc, - (ClientData) csPtr); + Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr); } Tcl_CreateChannelHandler(inChan, TCL_READABLE, CopyEventProc, - (ClientData) csPtr); + csPtr); } if (size == 0) { if (bufObj != NULL) { @@ -8613,11 +8613,10 @@ CopyData( if (!underflow && (outStatePtr->flags & BG_FLUSH_SCHEDULED)) { if (!(mask & TCL_WRITABLE)) { if (mask & TCL_READABLE) { - Tcl_DeleteChannelHandler(inChan, CopyEventProc, - (ClientData) csPtr); + Tcl_DeleteChannelHandler(inChan, CopyEventProc, csPtr); } Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, - CopyEventProc, (ClientData) csPtr); + CopyEventProc, csPtr); } if (bufObj != NULL) { TclDecrRefCount(bufObj); @@ -8639,7 +8638,7 @@ CopyData( if (mask == 0) { Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, CopyEventProc, - (ClientData) csPtr); + csPtr); } if (bufObj != NULL) { TclDecrRefCount(bufObj); @@ -8671,7 +8670,7 @@ CopyData( cmdPtr = Tcl_DuplicateObj(cmdPtr); Tcl_IncrRefCount(cmdPtr); StopCopy(csPtr); - Tcl_Preserve((ClientData) interp); + Tcl_Preserve(interp); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(total)); if (errObj) { @@ -8683,7 +8682,7 @@ CopyData( result = TCL_ERROR; } TclDecrRefCount(cmdPtr); - Tcl_Release((ClientData) interp); + Tcl_Release(interp); } else { StopCopy(csPtr); if (interp) { @@ -8739,9 +8738,9 @@ DoRead( */ if (!(statePtr->flags & CHANNEL_STICKY_EOF)) { - statePtr->flags &= ~CHANNEL_EOF; + ResetFlag(statePtr, CHANNEL_EOF); } - statePtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA); + ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA); for (copied = 0; copied < toRead; copied += copiedNow) { copiedNow = CopyAndTranslateBuffer(statePtr, bufPtr + copied, @@ -8754,7 +8753,7 @@ DoRead( if (statePtr->flags & CHANNEL_NONBLOCKING) { goto done; } - statePtr->flags &= ~CHANNEL_BLOCKED; + ResetFlag(statePtr, CHANNEL_BLOCKED); } result = GetInput(chanPtr); if (result != 0) { @@ -8766,7 +8765,7 @@ DoRead( } } - statePtr->flags &= ~CHANNEL_BLOCKED; + ResetFlag(statePtr, CHANNEL_BLOCKED); /* * Update the notifier state so we don't block while there is still data @@ -8881,7 +8880,7 @@ CopyAndTranslateBuffer( if ((statePtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) == (INPUT_SAW_CR | CHANNEL_EOF)) { result[0] = '\r'; - statePtr->flags &= ~INPUT_SAW_CR; + ResetFlag(statePtr, INPUT_SAW_CR); return 1; } return 0; @@ -8904,14 +8903,14 @@ CopyAndTranslateBuffer( for (src = result; src < end; src++) { curByte = *src; if (curByte == '\n') { - statePtr->flags &= ~INPUT_SAW_CR; + ResetFlag(statePtr, INPUT_SAW_CR); } else if (statePtr->flags & INPUT_SAW_CR) { - statePtr->flags &= ~INPUT_SAW_CR; + ResetFlag(statePtr, INPUT_SAW_CR); *dst = '\r'; dst++; } if (curByte == '\r') { - statePtr->flags |= INPUT_SAW_CR; + SetFlag(statePtr, INPUT_SAW_CR); } else { *dst = (char) curByte; dst++; @@ -8944,7 +8943,7 @@ CopyAndTranslateBuffer( for (src = result; src < end; src++) { curByte = *src; if (curByte == '\r') { - statePtr->flags |= INPUT_SAW_CR; + SetFlag(statePtr, INPUT_SAW_CR); *dst = '\n'; dst++; } else { @@ -8952,7 +8951,7 @@ CopyAndTranslateBuffer( *dst = (char) curByte; dst++; } - statePtr->flags &= ~INPUT_SAW_CR; + ResetFlag(statePtr, INPUT_SAW_CR); } } copied = dst - result; @@ -8976,7 +8975,7 @@ CopyAndTranslateBuffer( * caller. */ - statePtr->flags |= CHANNEL_EOF | CHANNEL_STICKY_EOF; + SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF); statePtr->inputEncodingFlags |= TCL_ENCODING_END; copied = i; break; @@ -9219,7 +9218,7 @@ DoWrite( outBufPtr->nextAdded += destCopied; if (!(statePtr->flags & BUFFER_READY)) { if (IsBufferFull(outBufPtr)) { - statePtr->flags |= BUFFER_READY; + SetFlag(statePtr, BUFFER_READY); } else if (statePtr->flags & CHANNEL_LINEBUFFERED) { for (sPtr = src, i = 0, foundNewline = 0; (i < srcCopied) && (!foundNewline); @@ -9230,10 +9229,10 @@ DoWrite( } } if (foundNewline) { - statePtr->flags |= BUFFER_READY; + SetFlag(statePtr, BUFFER_READY); } } else if (statePtr->flags & CHANNEL_UNBUFFERED) { - statePtr->flags |= BUFFER_READY; + SetFlag(statePtr, BUFFER_READY); } } @@ -9330,10 +9329,10 @@ StopCopy( if (csPtr->cmdPtr) { Tcl_DeleteChannelHandler((Tcl_Channel) csPtr->readPtr, CopyEventProc, - (ClientData) csPtr); + csPtr); if (csPtr->readPtr != csPtr->writePtr) { Tcl_DeleteChannelHandler((Tcl_Channel) csPtr->writePtr, - CopyEventProc, (ClientData) csPtr); + CopyEventProc, csPtr); } TclDecrRefCount(csPtr->cmdPtr); } @@ -9431,7 +9430,7 @@ SetBlockMode( * We still need the interp as the destination of the move. */ - if (!TclChanCaughtErrorBypass (interp, (Tcl_Channel) chanPtr)) { + if (!TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) { Tcl_AppendResult(interp, "error setting blocking mode: ", Tcl_PosixError(interp), NULL); } @@ -9448,9 +9447,9 @@ SetBlockMode( return TCL_ERROR; } if (mode == TCL_MODE_BLOCKING) { - statePtr->flags &= ~(CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED); + ResetFlag(statePtr, CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED); } else { - statePtr->flags |= CHANNEL_NONBLOCKING; + SetFlag(statePtr, CHANNEL_NONBLOCKING); } return TCL_OK; } @@ -10335,7 +10334,7 @@ FixLevelCode( } else if (0 == strcmp(TclGetString(lv[i]), "-code")) { if (newcode >= 0) { lvn[j++] = lv[i]; - lvn[j++] = Tcl_NewIntObj (newcode); + lvn[j++] = Tcl_NewIntObj(newcode); newcode = -1; cignore = 1; continue; @@ -10352,10 +10351,10 @@ FixLevelCode( lvn[j++] = lv[i+1]; } if (newlevel >= 0) { - Tcl_Panic ("Defined newlevel not used in rewrite"); + Tcl_Panic("Defined newlevel not used in rewrite"); } - if (newcode >= 0) { - Tcl_Panic ("Defined newcode not used in rewrite"); + if (newcode >= 0) { + Tcl_Panic("Defined newcode not used in rewrite"); } if (explicitResult) { diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 7e5d184..60387ed 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOCmd.c,v 1.40.2.5 2007/11/12 19:18:17 dgp Exp $ + * RCS: @(#) $Id: tclIOCmd.c,v 1.40.2.6 2007/11/21 06:30:52 dgp Exp $ */ #include "tclInt.h" @@ -121,7 +121,7 @@ Tcl_PutsObjCmd( } chan = Tcl_GetChannel(interp, channelId, &mode); - if (chan == (Tcl_Channel) NULL) { + if (chan == NULL) { return TCL_ERROR; } if ((mode & TCL_WRITABLE) == 0) { @@ -192,7 +192,7 @@ Tcl_FlushObjCmd( } channelId = TclGetString(objv[1]); chan = Tcl_GetChannel(interp, channelId, &mode); - if (chan == (Tcl_Channel) NULL) { + if (chan == NULL) { return TCL_ERROR; } if ((mode & TCL_WRITABLE) == 0) { @@ -255,7 +255,7 @@ Tcl_GetsObjCmd( } name = TclGetString(objv[1]); chan = Tcl_GetChannel(interp, name, &mode); - if (chan == (Tcl_Channel) NULL) { + if (chan == NULL) { return TCL_ERROR; } if ((mode & TCL_READABLE) == 0) { @@ -265,18 +265,18 @@ Tcl_GetsObjCmd( } linePtr = Tcl_NewObj(); - lineLen = Tcl_GetsObj(chan, linePtr); if (lineLen < 0) { if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) { Tcl_DecrRefCount(linePtr); /* - * TIP #219. - * Capture error messages put by the driver into the bypass area - * and put them into the regular interpreter result. Fall back to - * the regular message if nothing was found in the bypass. + * TIP #219. Capture error messages put by the driver into the + * bypass area and put them into the regular interpreter result. + * Fall back to the regular message if nothing was found in the + * bypass. */ + if (!TclChanCaughtErrorBypass(interp, chan)) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "error reading \"", name, "\": ", @@ -363,7 +363,7 @@ Tcl_ReadObjCmd( name = TclGetString(objv[i]); chan = Tcl_GetChannel(interp, name, &mode); - if (chan == (Tcl_Channel) NULL) { + if (chan == NULL) { return TCL_ERROR; } if ((mode & TCL_READABLE) == 0) { @@ -477,7 +477,7 @@ Tcl_SeekObjCmd( } chanName = TclGetString(objv[1]); chan = Tcl_GetChannel(interp, chanName, NULL); - if (chan == (Tcl_Channel) NULL) { + if (chan == NULL) { return TCL_ERROR; } if (Tcl_GetWideIntFromObj(interp, objv[2], &offset) != TCL_OK) { @@ -550,7 +550,7 @@ Tcl_TellObjCmd( chanName = TclGetString(objv[1]); chan = Tcl_GetChannel(interp, chanName, NULL); - if (chan == (Tcl_Channel) NULL) { + if (chan == NULL) { return TCL_ERROR; } @@ -605,7 +605,7 @@ Tcl_CloseObjCmd( arg = TclGetString(objv[1]); chan = Tcl_GetChannel(interp, arg, NULL); - if (chan == (Tcl_Channel) NULL) { + if (chan == NULL) { return TCL_ERROR; } @@ -621,11 +621,10 @@ Tcl_CloseObjCmd( * a terminating newline. */ - Tcl_Obj *resultPtr; + Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); char *string; int len; - resultPtr = Tcl_GetObjResult(interp); if (Tcl_IsShared(resultPtr)) { resultPtr = Tcl_DuplicateObj(resultPtr); Tcl_SetObjResult(interp, resultPtr); @@ -677,7 +676,7 @@ Tcl_FconfigureObjCmd( chanName = TclGetString(objv[1]); chan = Tcl_GetChannel(interp, chanName, NULL); - if (chan == (Tcl_Channel) NULL) { + if (chan == NULL) { return TCL_ERROR; } @@ -874,7 +873,7 @@ Tcl_ExecObjCmd( TclStackFree(interp, (void *)argv); - if (chan == (Tcl_Channel) NULL) { + if (chan == NULL) { return TCL_ERROR; } @@ -901,7 +900,7 @@ Tcl_ExecObjCmd( * the regular message if nothing was found in the bypass. */ - if (!TclChanCaughtErrorBypass (interp, chan)) { + if (!TclChanCaughtErrorBypass(interp, chan)) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "error reading output from command: ", Tcl_PosixError(interp), NULL); @@ -1096,7 +1095,7 @@ Tcl_OpenObjCmd( } ckfree((char *) cmdArgv); } - if (chan == (Tcl_Channel) NULL) { + if (chan == NULL) { return TCL_ERROR; } Tcl_RegisterChannel(interp, chan); @@ -1132,15 +1131,14 @@ TcpAcceptCallbacksDeleteProc( * was registered. */ Tcl_Interp *interp) /* Interpreter being deleted - not used. */ { - Tcl_HashTable *hTblPtr; + Tcl_HashTable *hTblPtr = clientData; Tcl_HashEntry *hPtr; Tcl_HashSearch hSearch; - AcceptCallback *acceptCallbackPtr; - hTblPtr = (Tcl_HashTable *) clientData; for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { - acceptCallbackPtr = (AcceptCallback *) Tcl_GetHashValue(hPtr); + AcceptCallback *acceptCallbackPtr = Tcl_GetHashValue(hPtr); + acceptCallbackPtr->interp = NULL; } Tcl_DeleteHashTable(hTblPtr); @@ -1188,14 +1186,14 @@ RegisterTcpServerInterpCleanup( hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable)); Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS); (void) Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks", - TcpAcceptCallbacksDeleteProc, (ClientData) hTblPtr); + TcpAcceptCallbacksDeleteProc, hTblPtr); } hPtr = Tcl_CreateHashEntry(hTblPtr, (char *) acceptCallbackPtr, &isNew); if (!isNew) { Tcl_Panic("RegisterTcpServerCleanup: damaged accept record table"); } - Tcl_SetHashValue(hPtr, (ClientData) acceptCallbackPtr); + Tcl_SetHashValue(hPtr, acceptCallbackPtr); } /* @@ -1267,13 +1265,7 @@ AcceptCallbackProc( char *address, /* Address of client that was accepted. */ int port) /* Port of client that was accepted. */ { - AcceptCallback *acceptCallbackPtr; - Tcl_Interp *interp; - char *script; - char portBuf[TCL_INTEGER_SPACE]; - int result; - - acceptCallbackPtr = (AcceptCallback *) callbackData; + AcceptCallback *acceptCallbackPtr = (AcceptCallback *) callbackData; /* * Check if the callback is still valid; the interpreter may have gone @@ -1282,12 +1274,13 @@ AcceptCallbackProc( */ if (acceptCallbackPtr->interp != NULL) { + char portBuf[TCL_INTEGER_SPACE]; + char *script = acceptCallbackPtr->script; + Tcl_Interp *interp = acceptCallbackPtr->interp; + int result; - script = acceptCallbackPtr->script; - interp = acceptCallbackPtr->interp; - - Tcl_Preserve((ClientData) script); - Tcl_Preserve((ClientData) interp); + Tcl_Preserve(script); + Tcl_Preserve(interp); TclFormatInt(portBuf, port); Tcl_RegisterChannel(interp, chan); @@ -1313,9 +1306,8 @@ AcceptCallbackProc( Tcl_UnregisterChannel(NULL, chan); - Tcl_Release((ClientData) interp); - Tcl_Release((ClientData) script); - + Tcl_Release(interp); + Tcl_Release(script); } else { /* * The interpreter has been deleted, so there is no useful way to @@ -1352,15 +1344,14 @@ TcpServerCloseProc( ClientData callbackData) /* The data passed in the call to * Tcl_CreateCloseHandler. */ { - AcceptCallback *acceptCallbackPtr; + AcceptCallback *acceptCallbackPtr = (AcceptCallback *) callbackData; /* The actual data. */ - acceptCallbackPtr = (AcceptCallback *) callbackData; if (acceptCallbackPtr->interp != NULL) { UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp, acceptCallbackPtr); } - Tcl_EventuallyFree((ClientData) acceptCallbackPtr->script, TCL_DYNAMIC); + Tcl_EventuallyFree(acceptCallbackPtr->script, TCL_DYNAMIC); ckfree((char *) acceptCallbackPtr); } @@ -1394,23 +1385,17 @@ Tcl_SocketObjCmd( enum socketOptions { SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER }; - int optionIndex, a, server, port; - char *arg, *copyScript, *host, *script; - char *myaddr = NULL; - int myport = 0; - int async = 0; + int optionIndex, a, server = 0, port, myport = 0, async = 0; + char *host, *script = NULL, *myaddr = NULL; Tcl_Channel chan; - AcceptCallback *acceptCallbackPtr; - - server = 0; - script = NULL; if (TclpHasSockets(interp) != TCL_OK) { return TCL_ERROR; } for (a = 1; a < objc; a++) { - arg = TclGetString(objv[a]); + const char *arg = Tcl_GetString(objv[a]); + if (arg[0] != '-') { break; } @@ -1504,15 +1489,17 @@ Tcl_SocketObjCmd( } if (server) { - acceptCallbackPtr = (AcceptCallback *) ckalloc((unsigned) - sizeof(AcceptCallback)); - copyScript = ckalloc((unsigned) strlen(script) + 1); - strcpy(copyScript, script); + AcceptCallback *acceptCallbackPtr = (AcceptCallback *) + ckalloc((unsigned) sizeof(AcceptCallback)); + unsigned len = strlen(script) + 1; + char *copyScript = ckalloc(len); + + memcpy(copyScript, script, len); acceptCallbackPtr->script = copyScript; acceptCallbackPtr->interp = interp; chan = Tcl_OpenTcpServer(interp, port, host, AcceptCallbackProc, - (ClientData) acceptCallbackPtr); - if (chan == (Tcl_Channel) NULL) { + acceptCallbackPtr); + if (chan == NULL) { ckfree(copyScript); ckfree((char *) acceptCallbackPtr); return TCL_ERROR; @@ -1533,11 +1520,10 @@ Tcl_SocketObjCmd( * be informed when the interpreter is deleted. */ - Tcl_CreateCloseHandler(chan, TcpServerCloseProc, - (ClientData) acceptCallbackPtr); + Tcl_CreateCloseHandler(chan, TcpServerCloseProc, acceptCallbackPtr); } else { chan = Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async); - if (chan == (Tcl_Channel) NULL) { + if (chan == NULL) { return TCL_ERROR; } } @@ -1573,9 +1559,8 @@ Tcl_FcopyObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel inChan, outChan; - char *arg; - int mode, i; - int toRead, index; + const char *arg; + int mode, i, toRead, index; Tcl_Obj *cmdPtr; static const char* switches[] = { "-size", "-command", NULL }; enum { FcopySize, FcopyCommand }; @@ -1593,7 +1578,7 @@ Tcl_FcopyObjCmd( arg = TclGetString(objv[1]); inChan = Tcl_GetChannel(interp, arg, &mode); - if (inChan == (Tcl_Channel) NULL) { + if (inChan == NULL) { return TCL_ERROR; } if ((mode & TCL_READABLE) == 0) { @@ -1603,7 +1588,7 @@ Tcl_FcopyObjCmd( } arg = TclGetString(objv[2]); outChan = Tcl_GetChannel(interp, arg, &mode); - if (outChan == (Tcl_Channel) NULL) { + if (outChan == NULL) { return TCL_ERROR; } if ((mode & TCL_WRITABLE) == 0) { @@ -1616,7 +1601,7 @@ Tcl_FcopyObjCmd( cmdPtr = NULL; for (i = 3; i < objc; i += 2) { if (Tcl_GetIndexFromObj(interp, objv[i], switches, "switch", 0, - (int *) &index) != TCL_OK) { + &index) != TCL_OK) { return TCL_ERROR; } switch (index) { @@ -1639,9 +1624,8 @@ Tcl_FcopyObjCmd( * * TclChanPendingObjCmd -- * - * This function is invoked to process the Tcl "chan pending" - * command (TIP #287). See the user documentation for details on - * what it does. + * This function is invoked to process the Tcl "chan pending" command + * (TIP #287). See the user documentation for details on what it does. * * Results: * A standard Tcl result. @@ -1665,7 +1649,7 @@ TclChanPendingObjCmd( Tcl_Channel chan; int index, mode; char *arg; - static const char *options[] = {"input", "output", (char *) NULL}; + static const char *options[] = {"input", "output", NULL}; enum options {PENDING_INPUT, PENDING_OUTPUT}; if (objc != 3) { @@ -1673,7 +1657,7 @@ TclChanPendingObjCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], options, "mode", 0, + if (Tcl_GetIndexFromObj(interp, objv[1], options, "mode", 0, &index) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 6ddcce8..1a65770 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIORChan.c,v 1.24 2007/04/24 02:42:18 kennykb Exp $ + * RCS: @(#) $Id: tclIORChan.c,v 1.24.2.1 2007/11/21 06:30:52 dgp Exp $ */ #include <tclInt.h> @@ -217,9 +217,9 @@ typedef enum { /* * Event used to forward driver invocations to the thread actually managing - * the channel. We cannot construct the command to execute and forward - * that. Because then it will contain a mixture of Tcl_Obj's belonging to both - * the command handler thread (CT), and the thread managing the channel (MT), + * the channel. We cannot construct the command to execute and forward that. + * Because then it will contain a mixture of Tcl_Obj's belonging to both the + * command handler thread (CT), and the thread managing the channel (MT), * executed in CT. Tcl_Obj's are not allowed to cross thread boundaries. So we * forward an operation code, the argument details, and reference to results. * The command is assembled in the CT and belongs fully to that thread. No @@ -377,8 +377,7 @@ static void DstExitProc(ClientData clientData); (p)->base.mustFree = 1; \ (p)->base.msgStr = (char *) (emsg) -static void ForwardSetObjError(ForwardParam *p, - Tcl_Obj *objPtr); +static void ForwardSetObjError(ForwardParam *p, Tcl_Obj *objPtr); #endif /* TCL_THREADS */ #define SetChannelErrorStr(c,msgStr) \ @@ -387,7 +386,7 @@ static void ForwardSetObjError(ForwardParam *p, static Tcl_Obj * MarshallError(Tcl_Interp *interp); static void UnmarshallErrorResult(Tcl_Interp *interp, Tcl_Obj *msgObj); - + /* * Static functions for this file: */ @@ -419,7 +418,7 @@ static const char *msg_seek_beforestart = "{Tried to seek before origin}"; static const char *msg_send_originlost = "{Origin thread lost}"; static const char *msg_send_dstlost = "{Destination thread lost}"; #endif /* TCL_THREADS */ - + /* * Main methods to plug into the 'chan' ensemble'. ================== */ @@ -498,7 +497,7 @@ TclChanCreateObjCmd( /* * Second argument is command prefix, i.e. list of words, first word is - * name of handler command, other words are fixed arguments. Run + * name of handler command, other words are fixed arguments. Run the * 'initialize' method to get the list of supported methods. Validate * this. */ @@ -669,6 +668,7 @@ TclChanCreateObjCmd( /* * Signal to ReflectClose to not call 'finalize'. */ + rcPtr->methods = 0; Tcl_Close(interp, chan); return TCL_ERROR; @@ -1258,8 +1258,7 @@ ReflectSeekWide( int *errorCodePtr) { ReflectedChannel *rcPtr = (ReflectedChannel *) clientData; - Tcl_Obj *offObj; - Tcl_Obj *baseObj; + Tcl_Obj *offObj, *baseObj; Tcl_Obj *resObj; /* Result for 'seek' */ Tcl_WideInt newLoc; @@ -1491,8 +1490,7 @@ ReflectSetOption( const char *newValue) /* The new value */ { ReflectedChannel *rcPtr = (ReflectedChannel *) clientData; - Tcl_Obj *optionObj; - Tcl_Obj *valueObj; + Tcl_Obj *optionObj, *valueObj; int result; /* Result code for 'configure' */ Tcl_Obj *resObj; /* Result data for 'configure' */ @@ -1683,9 +1681,9 @@ ReflectGetOption( * EncodeEventMask -- * * This function takes a list of event items and constructs the - * equivalent internal bitmask. The list has to contain at least one - * element. Elements are "read", "write", or any unique abbreviation - * thereof. Note that the bitmask is not changed if problems are + * equivalent internal bitmask. The list must contain at least one + * element. Elements are "read", "write", or any unique abbreviation of + * them. Note that the bitmask is not changed if problems are * encountered. * * Results: @@ -1812,9 +1810,8 @@ NewReflectedChannel( Tcl_Obj *handleObj) { ReflectedChannel *rcPtr; - int listc; + int i, listc; Tcl_Obj **listv; - int i; rcPtr = (ReflectedChannel *) ckalloc(sizeof(ReflectedChannel)); @@ -1849,7 +1846,7 @@ NewReflectedChannel( */ rcPtr->argc = listc + 2; - rcPtr->argv = (Tcl_Obj**) ckalloc(sizeof(Tcl_Obj*) * (listc+4)); + rcPtr->argv = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * (listc+4)); /* * Duplicate object references. @@ -1857,14 +1854,16 @@ NewReflectedChannel( for (i=0; i<listc ; i++) { Tcl_Obj *word = rcPtr->argv[i] = listv[i]; + Tcl_IncrRefCount(word); } i++; /* Skip placeholder for method */ /* - * [SF Bug 1667990] See [x] in FreeReflectedChannel for release + * [Bug 1667990]: See [x] in FreeReflectedChannel for release */ + rcPtr->argv[i] = handleObj; Tcl_IncrRefCount(handleObj); @@ -1942,9 +1941,9 @@ FreeReflectedChannel( } /* - * [SF Bug 1667990] See [x] in NewReflectedChannel for lock - * n+1 = argc-1. + * [Bug 1667990]: See [x] in NewReflectedChannel for lock. n+1 = argc-1. */ + Tcl_DecrRefCount(rcPtr->argv[n+1]); ckfree((char*) rcPtr->argv); @@ -1985,9 +1984,8 @@ InvokeTclMethod( Tcl_Obj *resObj = NULL; /* Result of method invokation. */ /* - * NOTE (5): Decide impl. issue: Cache objects with method names? - * Requires TSD data as reflections can be created in many different - * threads. + * NOTE (5): Decide impl. issue: Cache objects with method names? Needs + * TSD data as reflections can be created in many different threads. */ /* @@ -2047,6 +2045,7 @@ InvokeTclMethod( * This is complex and ugly, and would be completely unnecessary * if we only added support for a TCL_FORBID_EXCEPTIONS flag. */ + if (result != TCL_ERROR) { Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rcPtr->argv); int cmdLen; @@ -2056,7 +2055,8 @@ InvokeTclMethod( Tcl_ResetResult(rcPtr->interp); Tcl_SetObjResult(rcPtr->interp, Tcl_ObjPrintf( "chan handler returned bad code: %d", result)); - Tcl_LogCommandInfo(rcPtr->interp, cmdString, cmdString, cmdLen); + Tcl_LogCommandInfo(rcPtr->interp, cmdString, cmdString, + cmdLen); Tcl_DecrRefCount(cmd); result = TCL_ERROR; } @@ -2160,8 +2160,8 @@ ForwardOpToOwnerThread( while (resultPtr->result < 0) { /* * NOTE (1): Is it possible that the current thread goes away while - * waiting here? IOW Is it possible that "SrcExitProc" is called - * while we are here? See complementary note (2) in "SrcExitProc" + * waiting here? IOW Is it possible that "SrcExitProc" is called while + * we are here? See complementary note (2) in "SrcExitProc" */ Tcl_ConditionWait(&resultPtr->done, &rcForwardMutex, NULL); @@ -2242,7 +2242,7 @@ ForwardProc( * No parameters/results. */ - if (InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj) != TCL_OK) { + if (InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj)!=TCL_OK) { ForwardSetObjError(paramPtr, resObj); } @@ -2258,7 +2258,7 @@ ForwardProc( case ForwardedInput: { Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead); - if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj) != TCL_OK) { + if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK){ ForwardSetObjError(paramPtr, resObj); paramPtr->input.toRead = -1; } else { @@ -2266,8 +2266,8 @@ ForwardProc( * Process a regular result. */ - int bytec; /* Number of returned bytes */ - unsigned char *bytev; /* Array of returned bytes */ + int bytec; /* Number of returned bytes */ + unsigned char *bytev; /* Array of returned bytes */ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); @@ -2317,7 +2317,7 @@ ForwardProc( (paramPtr->seek.seekMode==SEEK_SET) ? "start" : (paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1); - if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj) != TCL_OK) { + if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj)!=TCL_OK){ ForwardSetObjError(paramPtr, resObj); paramPtr->seek.offset = -1; } else { @@ -2354,7 +2354,8 @@ ForwardProc( case ForwardedBlock: { Tcl_Obj *blockObj = Tcl_NewBooleanObj(!paramPtr->block.nonblocking); - if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL, &resObj) != TCL_OK) { + if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL, + &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } break; @@ -2364,7 +2365,8 @@ ForwardProc( Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->setOpt.name, -1); Tcl_Obj *valueObj = Tcl_NewStringObj(paramPtr->setOpt.value, -1); - if (InvokeTclMethod(rcPtr, "configure", optionObj, valueObj, &resObj) != TCL_OK) { + if (InvokeTclMethod(rcPtr, "configure", optionObj, valueObj, + &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } break; @@ -2377,10 +2379,11 @@ ForwardProc( Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1); - if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj) != TCL_OK) { + if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj)!=TCL_OK){ ForwardSetObjError(paramPtr, resObj); } else { - Tcl_DStringAppend(paramPtr->getOpt.value, TclGetString(resObj),-1); + Tcl_DStringAppend(paramPtr->getOpt.value, + TclGetString(resObj), -1); } break; } @@ -2390,7 +2393,7 @@ ForwardProc( * Retrieve all options. */ - if (InvokeTclMethod(rcPtr, "cgetall", NULL, NULL, &resObj) != TCL_OK) { + if (InvokeTclMethod(rcPtr, "cgetall", NULL, NULL, &resObj) != TCL_OK){ ForwardSetObjError(paramPtr, resObj); } else { /* @@ -2399,7 +2402,7 @@ ForwardProc( */ int listc; - Tcl_Obj** listv; + Tcl_Obj **listv; if (Tcl_ListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) { @@ -2431,6 +2434,7 @@ ForwardProc( /* * Bad operation code. */ + Tcl_Panic("Bad operation code in ForwardProc"); break; } diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index a264c36..b324c8d 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIndexObj.c,v 1.32.2.3 2007/11/12 19:18:18 dgp Exp $ + * RCS: @(#) $Id: tclIndexObj.c,v 1.32.2.4 2007/11/21 06:30:52 dgp Exp $ */ #include "tclInt.h" @@ -56,7 +56,7 @@ typedef struct { */ #define STRING_AT(table, offset, index) \ - (*((CONST char * CONST *)(((char *)(table)) + ((offset) * (index))))) + (*((const char *const *)(((char *)(table)) + ((offset) * (index))))) #define NEXT_ENTRY(table, offset) \ (&(STRING_AT(table, offset, 1))) #define EXPAND_OF(indexRep) \ @@ -91,10 +91,10 @@ int Tcl_GetIndexFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* Object containing the string to lookup. */ - CONST char **tablePtr, /* Array of strings to compare against the + const char **tablePtr, /* Array of strings to compare against the * value of objPtr; last entry must be NULL * and there must not be duplicate entries. */ - CONST char *msg, /* Identifying word to use in error + const char *msg, /* Identifying word to use in error * messages. */ int flags, /* 0 or TCL_EXACT */ int *indexPtr) /* Place to store resulting integer index. */ @@ -107,7 +107,7 @@ Tcl_GetIndexFromObj( */ if (objPtr->typePtr == &indexType) { - IndexRep *indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr; + IndexRep *indexRep = objPtr->internalRep.otherValuePtr; /* * Here's hoping we don't get hit by unfortunate packing constraints @@ -154,21 +154,21 @@ int Tcl_GetIndexFromObjStruct( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* Object containing the string to lookup. */ - CONST VOID *tablePtr, /* The first string in the table. The second + const void *tablePtr, /* The first string in the table. The second * string will be at this address plus the * offset, the third plus the offset again, * etc. The last entry must be NULL and there * must not be duplicate entries. */ int offset, /* The number of bytes between entries */ - CONST char *msg, /* Identifying word to use in error + const char *msg, /* Identifying word to use in error * messages. */ int flags, /* 0 or TCL_EXACT */ int *indexPtr) /* Place to store resulting integer index. */ { int index, idx, numAbbrev; char *key, *p1; - CONST char *p2; - CONST char * CONST *entryPtr; + const char *p2; + const char *const *entryPtr; Tcl_Obj *resultPtr; IndexRep *indexRep; @@ -177,7 +177,7 @@ Tcl_GetIndexFromObjStruct( */ if (objPtr->typePtr == &indexType) { - indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr; + indexRep = objPtr->internalRep.otherValuePtr; if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) { *indexPtr = indexRep->index; return TCL_OK; @@ -238,11 +238,11 @@ Tcl_GetIndexFromObjStruct( */ if (objPtr->typePtr == &indexType) { - indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr; + indexRep = objPtr->internalRep.otherValuePtr; } else { TclFreeIntRep(objPtr); indexRep = (IndexRep *) ckalloc(sizeof(IndexRep)); - objPtr->internalRep.otherValuePtr = (void *) indexRep; + objPtr->internalRep.otherValuePtr = indexRep; objPtr->typePtr = &indexType; } indexRep->tablePtr = (void *) tablePtr; @@ -275,6 +275,7 @@ Tcl_GetIndexFromObjStruct( Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr, NULL); } } + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", msg, key, NULL); } return TCL_ERROR; } @@ -331,10 +332,10 @@ static void UpdateStringOfIndex( Tcl_Obj *objPtr) { - IndexRep *indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr; + IndexRep *indexRep = objPtr->internalRep.otherValuePtr; register char *buf; register unsigned len; - register CONST char *indexStr = EXPAND_OF(indexRep); + register const char *indexStr = EXPAND_OF(indexRep); len = strlen(indexStr); buf = (char *) ckalloc(len + 1); @@ -366,11 +367,11 @@ DupIndex( Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) { - IndexRep *srcIndexRep = (IndexRep *) srcPtr->internalRep.otherValuePtr; + IndexRep *srcIndexRep = srcPtr->internalRep.otherValuePtr; IndexRep *dupIndexRep = (IndexRep *) ckalloc(sizeof(IndexRep)); memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep)); - dupPtr->internalRep.otherValuePtr = (void *) dupIndexRep; + dupPtr->internalRep.otherValuePtr = dupIndexRep; dupPtr->typePtr = &indexType; } @@ -441,9 +442,9 @@ void Tcl_WrongNumArgs( Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments to print from objv. */ - Tcl_Obj *CONST objv[], /* Initial argument objects, which should be + Tcl_Obj *const objv[], /* Initial argument objects, which should be * included in the error message. */ - CONST char *message) /* Error message to print after the leading + const char *message) /* Error message to print after the leading * objects in objv. The message may be * NULL. */ { @@ -491,7 +492,7 @@ Tcl_WrongNumArgs( if (iPtr->ensembleRewrite.sourceObjs != NULL) { int toSkip = iPtr->ensembleRewrite.numInsertedObjs; int toPrint = iPtr->ensembleRewrite.numRemovedObjs; - Tcl_Obj * CONST *origObjv = iPtr->ensembleRewrite.sourceObjs; + Tcl_Obj *const *origObjv = iPtr->ensembleRewrite.sourceObjs; /* * We only know how to do rewriting if all the replaced objects are diff --git a/generic/tclInt.h b/generic/tclInt.h index 9fb2502..63fcf9b 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.310.2.15 2007/11/16 07:20:54 dgp Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.310.2.16 2007/11/21 06:30:52 dgp Exp $ */ #ifndef _TCLINT @@ -401,6 +401,12 @@ typedef struct { } EnsembleCmdRep; /* + * Flag to enable bytecode compilation of an ensemble. + */ + +#define ENSEMBLE_COMPILE 0x4 + +/* *---------------------------------------------------------------- * Data structures related to variables. These are used primarily in tclVar.c *---------------------------------------------------------------- @@ -641,23 +647,24 @@ typedef struct VarInHash { #define VAR_ARRAY_ELEMENT 0x1000 #define VAR_NAMESPACE_VAR 0x80 /* KEEP OLD VALUE for Itcl */ -#define VAR_ALL_HASH (VAR_IN_HASHTABLE|VAR_DEAD_HASH|VAR_NAMESPACE_VAR|VAR_ARRAY_ELEMENT) +#define VAR_ALL_HASH \ + (VAR_IN_HASHTABLE|VAR_DEAD_HASH|VAR_NAMESPACE_VAR|VAR_ARRAY_ELEMENT) /* Trace and search state */ #define VAR_TRACED_READ 0x10 /* TCL_TRACE_READS */ #define VAR_TRACED_WRITE 0x20 /* TCL_TRACE_WRITES */ #define VAR_TRACED_UNSET 0x40 /* TCL_TRACE_UNSETS */ -#define VAR_TRACED_ARRAY 0x800 /* TCL_TRACE_ARRAY */ +#define VAR_TRACED_ARRAY 0x800 /* TCL_TRACE_ARRAY */ #define VAR_TRACE_ACTIVE 0x2000 #define VAR_SEARCH_ACTIVE 0x4000 #define VAR_ALL_TRACES \ - (VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_ARRAY|VAR_TRACED_UNSET) + (VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_ARRAY|VAR_TRACED_UNSET) /* Special handling on initialisation (only CompiledLocal) */ -#define VAR_ARGUMENT 0x100 /* KEEP OLD VALUE! See tclProc.c */ -#define VAR_TEMPORARY 0x200 /* KEEP OLD VALUE! See tclProc.c */ +#define VAR_ARGUMENT 0x100 /* KEEP OLD VALUE! See tclProc.c */ +#define VAR_TEMPORARY 0x200 /* KEEP OLD VALUE! See tclProc.c */ #define VAR_IS_ARGS 0x400 #define VAR_RESOLVED 0x8000 @@ -699,14 +706,14 @@ typedef struct VarInHash { #define TclSetVarNamespaceVar(varPtr) \ if (!TclIsVarNamespaceVar(varPtr)) {\ - (varPtr)->flags |= VAR_NAMESPACE_VAR;\ - ((VarInHash *)(varPtr))->refCount++;\ - } + (varPtr)->flags |= VAR_NAMESPACE_VAR;\ + ((VarInHash *)(varPtr))->refCount++;\ + } #define TclClearVarNamespaceVar(varPtr) \ if (TclIsVarNamespaceVar(varPtr)) {\ - (varPtr)->flags &= ~VAR_NAMESPACE_VAR;\ - ((VarInHash *)(varPtr))->refCount--;\ + (varPtr)->flags &= ~VAR_NAMESPACE_VAR;\ + ((VarInHash *)(varPtr))->refCount--;\ } /* @@ -990,7 +997,8 @@ typedef struct LocalCache { #define localName(framePtr, i) \ ((&((framePtr)->localCachePtr->varName0))[(i)]) -MODULE_SCOPE void TclFreeLocalCache(Tcl_Interp *interp, LocalCache *localCachePtr); +MODULE_SCOPE void TclFreeLocalCache(Tcl_Interp *interp, + LocalCache *localCachePtr); typedef struct CallFrame { Namespace *nsPtr; /* Points to the namespace used to resolve @@ -1004,7 +1012,7 @@ typedef struct CallFrame { * have local vars. */ int objc; /* This and objv below describe the arguments * for this procedure call. */ - Tcl_Obj *CONST *objv; /* Array of argument objects. */ + Tcl_Obj *const *objv; /* Array of argument objects. */ struct CallFrame *callerPtr; /* Value of interp->framePtr when this * procedure was invoked (i.e. next higher in @@ -1070,7 +1078,9 @@ typedef struct CallFrame { */ typedef struct CmdFrame { - /* General data. Always available. */ + /* + * General data. Always available. + */ int type; /* Values see below. */ int level; /* #Frames in stack, prevent O(n) scan of @@ -1087,29 +1097,29 @@ typedef struct CmdFrame { * * EXECUTION CONTEXTS and usage of CmdFrame * - * Field TEBC EvalEx EvalObjEx - * ======= ==== ====== ========= - * level yes yes yes - * type BC/PREBC SRC/EVAL EVAL_LIST - * line0 yes yes yes - * framePtr yes yes yes - * ======= ==== ====== ========= + * Field TEBC EvalEx EvalObjEx + * ======= ==== ====== ========= + * level yes yes yes + * type BC/PREBC SRC/EVAL EVAL_LIST + * line0 yes yes yes + * framePtr yes yes yes + * ======= ==== ====== ========= * - * ======= ==== ====== ========= union data - * line1 - yes - - * line3 - yes - - * path - yes - - * ------- ---- ------ --------- - * codePtr yes - - - * pc yes - - - * ======= ==== ====== ========= + * ======= ==== ====== ========= union data + * line1 - yes - + * line3 - yes - + * path - yes - + * ------- ---- ------ --------- + * codePtr yes - - + * pc yes - - + * ======= ==== ====== ========= * - * ======= ==== ====== ========= | union cmd - * listPtr - - yes | - * ------- ---- ------ --------- | - * cmd yes yes - | - * cmdlen yes yes - | - * ------- ---- ------ --------- | + * ======= ==== ====== ========= | union cmd + * listPtr - - yes | + * ------- ---- ------ --------- | + * cmd yes yes - | + * cmdlen yes yes - | + * ------- ---- ------ --------- | */ union { @@ -1118,13 +1128,13 @@ typedef struct CmdFrame { * in. */ } eval; struct { - CONST void *codePtr;/* Byte code currently executed */ - CONST char *pc; /* and instruction pointer. */ + const void *codePtr;/* Byte code currently executed */ + const char *pc; /* and instruction pointer. */ } tebc; } data; union { struct { - CONST char *cmd; /* The executed command, if possible */ + const char *cmd; /* The executed command, if possible */ int len; /* And its length */ } str; Tcl_Obj *listPtr; /* Tcl_EvalObjEx, cmd list */ @@ -1136,23 +1146,25 @@ typedef struct CmdFrame { * CmdFrame structure above. Some of the values occur only in the extended * location data referenced via the 'baseLocPtr'. * - * TCL_LOCATION_EVAL : Frame is for a script evaluated by EvalEx. + * TCL_LOCATION_EVAL : Frame is for a script evaluated by EvalEx. * TCL_LOCATION_EVAL_LIST : Frame is for a script evaluated by the list - * optimization path of EvalObjEx. - * TCL_LOCATION_BC : Frame is for bytecode. - * TCL_LOCATION_PREBC : Frame is for precompiled bytecode. - * TCL_LOCATION_SOURCE : Frame is for a script evaluated by EvalEx, from a - * sourced file. - * TCL_LOCATION_PROC : Frame is for bytecode of a procedure. + * optimization path of EvalObjEx. + * TCL_LOCATION_BC : Frame is for bytecode. + * TCL_LOCATION_PREBC : Frame is for precompiled bytecode. + * TCL_LOCATION_SOURCE : Frame is for a script evaluated by EvalEx, from a + * sourced file. + * TCL_LOCATION_PROC : Frame is for bytecode of a procedure. * * A TCL_LOCATION_BC type in a frame can be overridden by _SOURCE and _PROC * types, per the context of the byte code in execution. */ #define TCL_LOCATION_EVAL (0) /* Location in a dynamic eval script */ -#define TCL_LOCATION_EVAL_LIST (1) /* Location in a dynamic eval script, list-path */ -#define TCL_LOCATION_BC (2) /* Location in byte code */ -#define TCL_LOCATION_PREBC (3) /* Location in precompiled byte code, no location */ +#define TCL_LOCATION_EVAL_LIST (1) /* Location in a dynamic eval script, + * list-path */ +#define TCL_LOCATION_BC (2) /* Location in byte code */ +#define TCL_LOCATION_PREBC (3) /* Location in precompiled byte code, no + * location */ #define TCL_LOCATION_SOURCE (4) /* Location in a file */ #define TCL_LOCATION_PROC (5) /* Location in a dynamic proc */ @@ -1192,9 +1204,8 @@ typedef void **TclHandle; /* *---------------------------------------------------------------- - * Experimental flag value passed to Tcl_GetRegExpFromObj. - * Intended for use only by Expect. - * It will probably go away in a later release. + * Experimental flag value passed to Tcl_GetRegExpFromObj. Intended for use + * only by Expect. It will probably go away in a later release. *---------------------------------------------------------------- */ @@ -1257,7 +1268,7 @@ struct CompileEnv; #define TCL_OUT_LINE_COMPILE TCL_ERROR typedef int (CompileProc) (Tcl_Interp *interp, Tcl_Parse *parsePtr, - struct CompileEnv *compEnvPtr); + struct Command *cmdPtr, struct CompileEnv *compEnvPtr); /* * The type of procedure called from the compilation hook point in @@ -1627,7 +1638,7 @@ typedef struct Interp { /* First in list of active traces for interp, * or NULL if no active traces. */ int returnCode; /* [return -code] parameter */ - CallFrame *rootFramePtr; /* Global frame pointer for this interpreter */ + CallFrame *rootFramePtr; /* Global frame pointer for this interpreter */ Namespace *lookupNsPtr; /* Namespace to use ONLY on the next * TCL_EVAL_INVOKE call to Tcl_EvalObjv */ @@ -1776,7 +1787,7 @@ typedef struct Interp { */ struct { - Tcl_Obj *CONST *sourceObjs; + Tcl_Obj *const *sourceObjs; /* What arguments were actually input into the * *root* ensemble command? (Nested ensembles * don't rewrite this.) NULL if we're not @@ -1798,49 +1809,44 @@ typedef struct Interp { * code returned by a channel operation. */ /* TIP #280 */ - CmdFrame* cmdFramePtr; /* Points to the command frame containing + CmdFrame *cmdFramePtr; /* Points to the command frame containing * the location information for the current * command. */ - CONST CmdFrame* invokeCmdFramePtr; /* Points to the command frame which is the - * invoking context of the bytecode compiler. - * NULL when the byte code compiler is not - * active */ - int invokeWord; /* Index of the word in the command which + const CmdFrame *invokeCmdFramePtr; + /* Points to the command frame which is the + * invoking context of the bytecode compiler. + * NULL when the byte code compiler is not + * active */ + int invokeWord; /* Index of the word in the command which * is getting compiled. */ - Tcl_HashTable* linePBodyPtr; - /* This table remembers for each - * statically defined procedure the - * location information for its - * body. It is keyed by the address of - * the Proc structure for a procedure. - */ - Tcl_HashTable* lineBCPtr; - /* This table remembers for each - * ByteCode object the location - * information for its body. It is - * keyed by the address of the Proc - * structure for a procedure. - */ + Tcl_HashTable *linePBodyPtr;/* This table remembers for each statically + * defined procedure the location information + * for its body. It is keyed by the address of + * the Proc structure for a procedure. */ + Tcl_HashTable *lineBCPtr; /* This table remembers for each ByteCode + * object the location information for its + * body. It is keyed by the address of the + * Proc structure for a procedure. */ /* * TIP #268. The currently active selection mode, i.e. the package require * preferences. */ - int packagePrefer; /* Current package selection mode. */ + int packagePrefer; /* Current package selection mode. */ /* * Hashtables for variable traces and searches */ - Tcl_HashTable varTraces; /* Hashtable holding the start of a variable's + Tcl_HashTable varTraces; /* Hashtable holding the start of a variable's * active trace list; varPtr is the key. */ - Tcl_HashTable varSearches; /* Hashtable holding the start of a variable's + Tcl_HashTable varSearches; /* Hashtable holding the start of a variable's * active searches list; varPtr is the key */ /* * The thread-specific data ekeko: cache pointers or values that * (a) do not change during the thread's lifetime * (b) require access to TSD to determine at runtime - * (c) are accessed very often (eg, at each command call) + * (c) are accessed very often (e.g., at each command call) * * Note that these are the same for all interps in the same thread. They * just have to be initialised for the thread's master interp, slaves @@ -1849,17 +1855,17 @@ typedef struct Interp { * They are used by the macros defined below. */ - void *allocCache; - void *pendingObjDataPtr; /* Pointer to the Cache and PendingObjData - * structs for this interp's thread; see - * tclObj.c and tclThreadAlloc.c */ - int *asyncReadyPtr; /* Pointer to the asyncReady indicator for - * this interp's thread; see tclAsync.c */ - int *stackBound; /* Pointer to the limit stack address - * allowable for invoking a new command - * without "risking" a C-stack overflow; - * see TclpCheckStackSpace in the - * platform's directory. */ + void *allocCache; + void *pendingObjDataPtr; /* Pointer to the Cache and PendingObjData + * structs for this interp's thread; see + * tclObj.c and tclThreadAlloc.c */ + int *asyncReadyPtr; /* Pointer to the asyncReady indicator for + * this interp's thread; see tclAsync.c */ + int *stackBound; /* Pointer to the limit stack address + * allowable for invoking a new command + * without "risking" a C-stack overflow; see + * TclpCheckStackSpace in the platform's + * directory. */ #ifdef TCL_COMPILE_STATS @@ -2401,17 +2407,17 @@ MODULE_SCOPE char tclEmptyString; *---------------------------------------------------------------- */ -MODULE_SCOPE void TclAdvanceLines(int* line, CONST char* start, - CONST char* end); +MODULE_SCOPE void TclAdvanceLines(int *line, const char *start, + const char *end); MODULE_SCOPE int TclArraySet(Tcl_Interp *interp, Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj); MODULE_SCOPE double TclBignumToDouble(mp_int *bignum); MODULE_SCOPE double TclCeil(mp_int *a); -MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp,CONST char *value); +MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp,const char *value); MODULE_SCOPE int TclChanCreateObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclChanPostEventObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp, Tcl_Channel chan); MODULE_SCOPE void TclCleanupLiteralTable(Tcl_Interp *interp, @@ -2419,19 +2425,19 @@ MODULE_SCOPE void TclCleanupLiteralTable(Tcl_Interp *interp, MODULE_SCOPE int TclDoubleDigits(char *buf, double value, int *signum); MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); /* TIP #280 - Modified token based evulation, with line information */ -MODULE_SCOPE int TclEvalEx (Tcl_Interp *interp, CONST char *script, - int numBytes, int flags, int line); +MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script, + int numBytes, int flags, int line); MODULE_SCOPE void TclExpandTokenArray(Tcl_Parse *parsePtr); MODULE_SCOPE int TclFileAttrsCmd(Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclFileCopyCmd(Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclFileDeleteCmd(Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclFileMakeDirsCmd(Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclFileRenameCmd(Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); MODULE_SCOPE void TclFinalizeAllocSubsystem(void); MODULE_SCOPE void TclFinalizeAsync(void); MODULE_SCOPE void TclFinalizeDoubleConversion(void); @@ -2453,14 +2459,14 @@ MODULE_SCOPE void TclFinalizeThreadData(void); MODULE_SCOPE double TclFloor(mp_int *a); MODULE_SCOPE void TclFormatNaN(double value, char *buffer); MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr, - CONST char *attributeName, int *indexPtr); + const char *attributeName, int *indexPtr); MODULE_SCOPE int * TclGetAsyncReadyPtr(void); MODULE_SCOPE Tcl_Obj * TclGetBgErrorHandler(Tcl_Interp *interp); MODULE_SCOPE int TclGetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientDataPtr, int *typePtr); MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp, - CONST char *modeString, int *seekFlagPtr, + const char *modeString, int *seekFlagPtr, int *binaryPtr); MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); MODULE_SCOPE const char *TclGetSrcInfoForCmd(Interp *iPtr, int *lenPtr); @@ -2472,14 +2478,14 @@ MODULE_SCOPE int TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr, MODULE_SCOPE Tcl_Obj * TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags); MODULE_SCOPE int TclInfoExistsCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Obj * TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr); MODULE_SCOPE int TclInfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclInfoVarsCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); MODULE_SCOPE void TclInitAlloc(void); MODULE_SCOPE void TclInitDbCkalloc(void); MODULE_SCOPE void TclInitDoubleConversion(void); @@ -2493,19 +2499,19 @@ MODULE_SCOPE void TclInitNotifier(void); MODULE_SCOPE void TclInitObjSubsystem(void); MODULE_SCOPE void TclInitSubsystems(void); MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp); -MODULE_SCOPE int TclIsLocalScalar(CONST char *src, int len); +MODULE_SCOPE int TclIsLocalScalar(const char *src, int len); MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int *result); MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp); MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *argPtr); MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, - int indexCount, Tcl_Obj *CONST indexArray[]); + int indexCount, Tcl_Obj *const indexArray[]); /* TIP #280 */ -MODULE_SCOPE void TclListLines (CONST char* listStr, int line, - int n, int* lines); +MODULE_SCOPE void TclListLines(const char *listStr, int line, int n, + int *lines); MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr); MODULE_SCOPE int TclLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, - int symc, CONST char *symbols[], + int symc, const char *symbols[], Tcl_PackageInitProc **procPtrs[], Tcl_LoadHandle *handlePtr, ClientData *clientDataPtr, @@ -2513,33 +2519,33 @@ MODULE_SCOPE int TclLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, MODULE_SCOPE Tcl_Obj * TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *indexPtr, Tcl_Obj *valuePtr); MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, - int indexCount, Tcl_Obj *CONST indexArray[], + int indexCount, Tcl_Obj *const indexArray[], Tcl_Obj *valuePtr); -MODULE_SCOPE int TclMarkList (Tcl_Interp *interp, CONST char *list, - CONST char* end, int *argcPtr, - CONST int** argszPtr, CONST char ***argvPtr); +MODULE_SCOPE int TclMarkList(Tcl_Interp *interp, const char *list, + const char *end, int *argcPtr, + const int **argszPtr, const char ***argvPtr); MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[], Tcl_Obj **optionsPtrPtr, + Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr, int *codePtr, int *levelPtr); MODULE_SCOPE int TclNokia770Doubles(); MODULE_SCOPE void TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const char *operation, const char *reason, int index); MODULE_SCOPE int TclObjInvokeNamespace(Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[], + int objc, Tcl_Obj *const objv[], Tcl_Namespace *nsPtr, int flags); MODULE_SCOPE int TclObjUnsetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); -MODULE_SCOPE int TclParseBackslash(CONST char *src, +MODULE_SCOPE int TclParseBackslash(const char *src, int numBytes, int *readPtr, char *dst); -MODULE_SCOPE int TclParseHex(CONST char *src, int numBytes, +MODULE_SCOPE int TclParseHex(const char *src, int numBytes, Tcl_UniChar *resultPtr); MODULE_SCOPE int TclParseNumber(Tcl_Interp *interp, Tcl_Obj *objPtr, - CONST char *expected, CONST char *bytes, - int numBytes, CONST char **endPtrPtr, int flags); -MODULE_SCOPE void TclParseInit(Tcl_Interp *interp, CONST char *string, + const char *expected, const char *bytes, + int numBytes, const char **endPtrPtr, int flags); +MODULE_SCOPE void TclParseInit(Tcl_Interp *interp, const char *string, int numBytes, Tcl_Parse *parsePtr); -MODULE_SCOPE int TclParseAllWhiteSpace(CONST char *src, int numBytes); +MODULE_SCOPE int TclParseAllWhiteSpace(const char *src, int numBytes); MODULE_SCOPE int TclProcessReturn(Tcl_Interp *interp, int code, int level, Tcl_Obj *returnOpts); #ifndef TCL_NO_STACK_CHECK @@ -2547,9 +2553,9 @@ MODULE_SCOPE int TclpGetCStackParams(int **stackBoundPtr); #endif MODULE_SCOPE int TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); MODULE_SCOPE Tcl_Obj * TclpTempFileName(void); -MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, +MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep, int len); -MODULE_SCOPE int TclpDeleteFile(CONST char *path); +MODULE_SCOPE int TclpDeleteFile(const char *path); MODULE_SCOPE void TclpFinalizeCondition(Tcl_Condition *condPtr); MODULE_SCOPE void TclpFinalizeMutex(Tcl_Mutex *mutexPtr); MODULE_SCOPE void TclpFinalizePipes(void); @@ -2557,14 +2563,14 @@ MODULE_SCOPE void TclpFinalizeSockets(void); MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags); -MODULE_SCOPE int TclpFindVariable(CONST char *name, int *lengthPtr); +MODULE_SCOPE int TclpFindVariable(const char *name, int *lengthPtr); MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr, int *lengthPtr, Tcl_Encoding *encodingPtr); MODULE_SCOPE void TclpInitLock(void); MODULE_SCOPE void TclpInitPlatform(void); MODULE_SCOPE void TclpInitUnlock(void); MODULE_SCOPE int TclpLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, - CONST char *sym1, CONST char *sym2, + const char *sym1, const char *sym2, Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, ClientData *clientDataPtr, @@ -2584,7 +2590,7 @@ MODULE_SCOPE int TclCrossFilesystemCopy(Tcl_Interp *interp, Tcl_Obj *source, Tcl_Obj *target); MODULE_SCOPE int TclpMatchInDirectory(Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, - CONST char *pattern, Tcl_GlobTypeData *types); + const char *pattern, Tcl_GlobTypeData *types); MODULE_SCOPE ClientData TclpGetNativeCwd(ClientData clientData); MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep; MODULE_SCOPE Tcl_Obj* TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr, @@ -2592,8 +2598,8 @@ MODULE_SCOPE Tcl_Obj* TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr, MODULE_SCOPE int TclpObjChdir(Tcl_Obj *pathPtr); MODULE_SCOPE Tcl_Obj * TclPathPart(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_PathPart portion); -MODULE_SCOPE void TclpPanic(CONST char *format, ...); -MODULE_SCOPE char * TclpReadlink(CONST char *fileName, +MODULE_SCOPE void TclpPanic(const char *format, ...); +MODULE_SCOPE char * TclpReadlink(const char *fileName, Tcl_DString *linkPtr); MODULE_SCOPE void TclpReleaseFile(TclFile file); MODULE_SCOPE void TclpSetInterfaces(void); @@ -2610,7 +2616,7 @@ MODULE_SCOPE void TclRememberMutex(Tcl_Mutex *mutex); MODULE_SCOPE void TclRemoveScriptLimitCallbacks(Tcl_Interp *interp); MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp, Tcl_Obj *cmdPrefix); -MODULE_SCOPE void TclSetBignumIntRep (Tcl_Obj *objPtr, +MODULE_SCOPE void TclSetBignumIntRep(Tcl_Obj *objPtr, mp_int *bignumValue); MODULE_SCOPE void TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Command *cmdPtr); @@ -2627,7 +2633,7 @@ MODULE_SCOPE void TclTransferResult(Tcl_Interp *sourceInterp, int result, MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData); MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr); MODULE_SCOPE Tcl_PackageInitProc *TclpFindSymbol(Tcl_Interp *interp, - Tcl_LoadHandle loadHandle, CONST char *symbol); + Tcl_LoadHandle loadHandle, const char *symbol); MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr); @@ -2655,267 +2661,267 @@ MODULE_SCOPE Tcl_Obj * TclDisassembleByteCodeObj(Tcl_Obj *objPtr); MODULE_SCOPE int Tcl_AfterObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_AppendObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ApplyObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ArrayObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_BinaryObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_BreakObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_CaseObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_CatchObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_CdObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclChanPendingObjCmd( ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); /* TIP 287 */ + int objc, Tcl_Obj *const objv[]); /* TIP 287 */ MODULE_SCOPE int TclChanTruncateObjCmd( ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); MODULE_SCOPE void TclClockInit(Tcl_Interp*); MODULE_SCOPE int TclClockOldscanObjCmd( ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_CloseObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ConcatObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ContinueObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler( Tcl_Time *timePtr, Tcl_TimerProc *proc, ClientData clientData); MODULE_SCOPE int TclDefaultBgErrorHandlerObjCmd( ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_DictObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_DisassembleObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_EncodingObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_EofObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ErrorObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_EvalObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ExecObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ExitObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ExprObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_FblockedObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_FconfigureObjCmd( ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_FcopyObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_FileObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_FileEventObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_FlushObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ForObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ForeachObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_FormatObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_GetsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_GlobalObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_GlobObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_IfObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_IncrObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitInfoCmd(Tcl_Interp *interp); MODULE_SCOPE int Tcl_InterpObjCmd(ClientData clientData, Tcl_Interp *interp, int argc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_JoinObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LappendObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LassignObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LindexObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LinsertObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LlengthObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ListObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LoadObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LrangeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LrepeatObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LreplaceObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LreverseObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LsearchObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LsetObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LsortObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_NamespaceObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_OpenObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_PackageObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_PidObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_PutsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_PwdObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ReadObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_RegexpObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_RegsubObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_RenameObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ReturnObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_ScanObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_SeekObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_SetObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_SplitObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_SocketObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_SourceObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_StringObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_SubstObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_SwitchObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_TellObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_TimeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_TraceObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_UnloadObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_UnsetObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_UpdateObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_UplevelObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_UpvarObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_VariableObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_VwaitObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_WhileObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); /* *---------------------------------------------------------------- @@ -2924,177 +2930,231 @@ MODULE_SCOPE int Tcl_WhileObjCmd(ClientData clientData, */ MODULE_SCOPE int TclCompileAppendCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileBreakCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileCatchCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileContinueCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileDictCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileEnsemble(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileExprCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileForCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileForeachCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclCompileGlobalCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileGlobalCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileIfCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclCompileInfoCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileInfoExistsCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileIncrCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileLappendCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileLassignCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileLindexCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileListCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileLlengthCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileLsetCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileNamespaceCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileNoOp(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileRegexpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileReturnCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileSetCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileStringCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileSwitchCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileUpvarCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileVariableCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileWhileCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclInvertOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileInvertOpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclNotOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileNotOpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclAddOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileAddOpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclMulOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileMulOpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclAndOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileAndOpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclOrOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileOrOpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclXorOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileXorOpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclPowOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompilePowOpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclLshiftOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileLshiftOpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclRshiftOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileRshiftOpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclModOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileModOpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclNeqOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileNeqOpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclStrneqOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileStrneqOpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclInOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileInOpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclNiOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileNiOpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclMinusOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileMinusOpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclDivOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileDivOpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclLessOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileLessOpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclLeqOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileLeqOpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclGreaterOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileGreaterOpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclGeqOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileGeqOpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclEqOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileEqOpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclStreqOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr); + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); /* * Functions defined in generic/tclVar.c and currenttly exported only for use @@ -3104,24 +3164,24 @@ MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp, MODULE_SCOPE Var * TclObjLookupVarEx(Tcl_Interp * interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags, - CONST char * msg, CONST int createPart1, - CONST int createPart2, Var **arrayPtrPtr); + const char * msg, const int createPart1, + const int createPart2, Var **arrayPtrPtr); MODULE_SCOPE Var * TclLookupArrayElement(Tcl_Interp *interp, Tcl_Obj *arrayNamePtr, Tcl_Obj *elNamePtr, - CONST int flags, CONST char *msg, - CONST int createPart1, CONST int createPart2, + const int flags, const char *msg, + const int createPart1, const int createPart2, Var *arrayPtr, int index); MODULE_SCOPE Tcl_Obj * TclPtrGetVar(Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr, - Tcl_Obj *part2Ptr, CONST int flags, int index); + Tcl_Obj *part2Ptr, const int flags, int index); MODULE_SCOPE Tcl_Obj * TclPtrSetVar(Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, - CONST int flags, int index); -MODULE_SCOPE Tcl_Obj * TclPtrIncrObjVar (Tcl_Interp *interp, + const int flags, int index); +MODULE_SCOPE Tcl_Obj * TclPtrIncrObjVar(Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, - CONST int flags, int index); + const int flags, int index); MODULE_SCOPE int TclPtrObjMakeUpvar(Tcl_Interp *interp, Var *otherPtr, Tcl_Obj *myNamePtr, int myFlags, int index); MODULE_SCOPE void TclInvalidateNsPath(Namespace *nsPtr); @@ -3383,7 +3443,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr); * string handling. The macro's expression result is 1 for the 1-byte case or * the result of Tcl_UtfToUniChar. The ANSI C "prototype" for this macro is: * - * MODULE_SCOPE int TclUtfToUniChar(CONST char *string, Tcl_UniChar *ch); + * MODULE_SCOPE int TclUtfToUniChar(const char *string, Tcl_UniChar *ch); *---------------------------------------------------------------- */ @@ -3399,8 +3459,8 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr); * lexically correct on little-endian systems. The ANSI C "prototype" for * this macro is: * - * MODULE_SCOPE int TclUniCharNcmp(CONST Tcl_UniChar *cs, - * CONST Tcl_UniChar *ct, unsigned long n); + * MODULE_SCOPE int TclUniCharNcmp(const Tcl_UniChar *cs, + * const Tcl_UniChar *ct, unsigned long n); *---------------------------------------------------------------- */ @@ -3444,7 +3504,7 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum, * Macro used by the Tcl core to check whether a pattern has any characters * special to [string match]. The ANSI C "prototype" for this macro is: * - * MODULE_SCOPE int TclMatchIsTrivial(CONST char *pattern); + * MODULE_SCOPE int TclMatchIsTrivial(const char *pattern); *---------------------------------------------------------------- */ diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 4251088..b6db62e 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInterp.c,v 1.74.2.5 2007/11/12 19:18:19 dgp Exp $ + * RCS: @(#) $Id: tclInterp.c,v 1.74.2.6 2007/11/21 06:30:52 dgp Exp $ */ #include "tclInt.h" @@ -187,7 +187,7 @@ typedef struct ScriptLimitCallbackKey { static int AliasCreate(Tcl_Interp *interp, Tcl_Interp *slaveInterp, Tcl_Interp *masterInterp, Tcl_Obj *namePtr, Tcl_Obj *targetPtr, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int AliasDelete(Tcl_Interp *interp, Tcl_Interp *slaveInterp, Tcl_Obj *namePtr); static int AliasDescribe(Tcl_Interp *interp, @@ -195,45 +195,45 @@ static int AliasDescribe(Tcl_Interp *interp, static int AliasList(Tcl_Interp *interp, Tcl_Interp *slaveInterp); static int AliasObjCmd(ClientData dummy, Tcl_Interp *currentInterp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static void AliasObjCmdDeleteProc(ClientData clientData); static Tcl_Interp * GetInterp(Tcl_Interp *interp, Tcl_Obj *pathPtr); static Tcl_Interp * GetInterp2(Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static void InterpInfoDeleteProc(ClientData clientData, Tcl_Interp *interp); static int SlaveBgerror(Tcl_Interp *interp, Tcl_Interp *slaveInterp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static Tcl_Interp * SlaveCreate(Tcl_Interp *interp, Tcl_Obj *pathPtr, int safe); static int SlaveEval(Tcl_Interp *interp, Tcl_Interp *slaveInterp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int SlaveExpose(Tcl_Interp *interp, Tcl_Interp *slaveInterp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int SlaveHide(Tcl_Interp *interp, Tcl_Interp *slaveInterp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int SlaveHidden(Tcl_Interp *interp, Tcl_Interp *slaveInterp); static int SlaveInvokeHidden(Tcl_Interp *interp, Tcl_Interp *slaveInterp, - CONST char *namespaceName, - int objc, Tcl_Obj *CONST objv[]); + const char *namespaceName, + int objc, Tcl_Obj *const objv[]); static int SlaveMarkTrusted(Tcl_Interp *interp, Tcl_Interp *slaveInterp); static int SlaveObjCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static void SlaveObjCmdDeleteProc(ClientData clientData); static int SlaveRecursionLimit(Tcl_Interp *interp, Tcl_Interp *slaveInterp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int SlaveCommandLimitCmd(Tcl_Interp *interp, Tcl_Interp *slaveInterp, int consumedObjc, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int SlaveTimeLimitCmd(Tcl_Interp *interp, Tcl_Interp *slaveInterp, int consumedObjc, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static void InheritLimitsFromMaster(Tcl_Interp *slaveInterp, Tcl_Interp *masterInterp); static void SetScriptLimitCallback(Tcl_Interp *interp, int type, @@ -433,7 +433,7 @@ TclInterpInit( Slave *slavePtr; interpInfoPtr = (InterpInfo *) ckalloc(sizeof(InterpInfo)); - ((Interp *) interp)->interpInfo = (ClientData) interpInfoPtr; + ((Interp *) interp)->interpInfo = interpInfoPtr; masterPtr = &interpInfoPtr->master; Tcl_InitHashTable(&masterPtr->slaveTable, TCL_STRING_KEYS); @@ -553,10 +553,10 @@ Tcl_InterpObjCmd( ClientData clientData, /* Unused. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { int index; - static CONST char *options[] = { + static const char *options[] = { "alias", "aliases", "bgerror", "create", "delete", "eval", "exists", "expose", "hide", "hidden", "issafe", "invokehidden", @@ -591,7 +591,7 @@ Tcl_InterpObjCmd( return TCL_ERROR; } slaveInterp = GetInterp(interp, objv[2]); - if (slaveInterp == (Tcl_Interp *) NULL) { + if (slaveInterp == NULL) { return TCL_ERROR; } if (objc == 4) { @@ -602,7 +602,7 @@ Tcl_InterpObjCmd( } if (objc > 5) { masterInterp = GetInterp(interp, objv[4]); - if (masterInterp == (Tcl_Interp *) NULL) { + if (masterInterp == NULL) { return TCL_ERROR; } if (TclGetString(objv[5])[0] == '\0') { @@ -642,8 +642,8 @@ Tcl_InterpObjCmd( int i, last, safe; Tcl_Obj *slavePtr; char buf[16 + TCL_INTEGER_SPACE]; - static CONST char *options[] = { - "-safe", "--", NULL + static const char *options[] = { + "-safe", "--", NULL }; enum option { OPT_SAFE, OPT_LAST @@ -776,7 +776,7 @@ Tcl_InterpObjCmd( return TCL_ERROR; } slaveInterp = GetInterp(interp, objv[2]); - if (slaveInterp == (Tcl_Interp *) NULL) { + if (slaveInterp == NULL) { return TCL_ERROR; } return SlaveHide(interp, slaveInterp, objc - 3, objv + 3); @@ -802,10 +802,10 @@ Tcl_InterpObjCmd( } case OPT_INVOKEHID: { int i, index; - CONST char *namespaceName; + const char *namespaceName; Tcl_Interp *slaveInterp; - static CONST char *hiddenOptions[] = { - "-global", "-namespace", "--", NULL + static const char *hiddenOptions[] = { + "-global", "-namespace", "--", NULL }; enum hiddenOption { OPT_GLOBAL, OPT_NAMESPACE, OPT_LAST @@ -839,7 +839,7 @@ Tcl_InterpObjCmd( return TCL_ERROR; } slaveInterp = GetInterp(interp, objv[2]); - if (slaveInterp == (Tcl_Interp *) NULL) { + if (slaveInterp == NULL) { return TCL_ERROR; } return SlaveInvokeHidden(interp, slaveInterp, namespaceName, objc - i, @@ -847,7 +847,7 @@ Tcl_InterpObjCmd( } case OPT_LIMIT: { Tcl_Interp *slaveInterp; - static CONST char *limitTypes[] = { + static const char *limitTypes[] = { "commands", "time", NULL }; enum LimitTypes { @@ -923,6 +923,7 @@ Tcl_InterpObjCmd( Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } + case OPT_TRANSFER: case OPT_SHARE: { Tcl_Interp *slaveInterp; /* A slave. */ Tcl_Interp *masterInterp; /* Its master. */ @@ -946,6 +947,17 @@ Tcl_InterpObjCmd( return TCL_ERROR; } Tcl_RegisterChannel(slaveInterp, chan); + if (index == OPT_TRANSFER) { + /* + * When transferring, as opposed to sharing, we must unhitch the + * channel from the interpreter where it started. + */ + + if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) { + TclTransferResult(masterInterp, TCL_OK, interp); + return TCL_ERROR; + } + } return TCL_OK; } case OPT_TARGET: { @@ -971,44 +983,17 @@ Tcl_InterpObjCmd( hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName); if (hPtr == NULL) { Tcl_AppendResult(interp, "alias \"", aliasName, "\" in path \"", - Tcl_GetString(objv[2]), "\" not found", (char *) NULL); + Tcl_GetString(objv[2]), "\" not found", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, + NULL); return TCL_ERROR; } - aliasPtr = (Alias *) Tcl_GetHashValue(hPtr); + aliasPtr = Tcl_GetHashValue(hPtr); if (Tcl_GetInterpPath(interp, aliasPtr->targetInterp) != TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "target interpreter for alias \"", aliasName, "\" in path \"", Tcl_GetString(objv[2]), - "\" is not my descendant", (char *) NULL); - return TCL_ERROR; - } - return TCL_OK; - } - case OPT_TRANSFER: { - Tcl_Interp *slaveInterp; /* A slave. */ - Tcl_Interp *masterInterp; /* Its master. */ - Tcl_Channel chan; - - if (objc != 5) { - Tcl_WrongNumArgs(interp, 2, objv, "srcPath channelId destPath"); - return TCL_ERROR; - } - masterInterp = GetInterp(interp, objv[2]); - if (masterInterp == NULL) { - return TCL_ERROR; - } - chan = Tcl_GetChannel(masterInterp, TclGetString(objv[3]), NULL); - if (chan == NULL) { - TclTransferResult(masterInterp, TCL_OK, interp); - return TCL_ERROR; - } - slaveInterp = GetInterp(interp, objv[4]); - if (slaveInterp == NULL) { - return TCL_ERROR; - } - Tcl_RegisterChannel(slaveInterp, chan); - if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) { - TclTransferResult(masterInterp, TCL_OK, interp); + "\" is not my descendant", NULL); return TCL_ERROR; } return TCL_OK; @@ -1043,7 +1028,7 @@ GetInterp2( Tcl_Interp *interp, /* Default interp if no interp was specified * on the command line. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc == 2) { return interp; @@ -1074,11 +1059,11 @@ GetInterp2( int Tcl_CreateAlias( Tcl_Interp *slaveInterp, /* Interpreter for source command. */ - CONST char *slaveCmd, /* Command to install in slave. */ + const char *slaveCmd, /* Command to install in slave. */ Tcl_Interp *targetInterp, /* Interpreter for target command. */ - CONST char *targetCmd, /* Name of target command. */ + const char *targetCmd, /* Name of target command. */ int argc, /* How many additional arguments? */ - CONST char *CONST *argv) /* These are the additional args. */ + const char *const *argv) /* These are the additional args. */ { Tcl_Obj *slaveObjPtr, *targetObjPtr; Tcl_Obj **objv; @@ -1130,11 +1115,11 @@ Tcl_CreateAlias( int Tcl_CreateAliasObj( Tcl_Interp *slaveInterp, /* Interpreter for source command. */ - CONST char *slaveCmd, /* Command to install in slave. */ + const char *slaveCmd, /* Command to install in slave. */ Tcl_Interp *targetInterp, /* Interpreter for target command. */ - CONST char *targetCmd, /* Name of target command. */ + const char *targetCmd, /* Name of target command. */ int objc, /* How many additional arguments? */ - Tcl_Obj *CONST objv[]) /* Argument vector. */ + Tcl_Obj *const objv[]) /* Argument vector. */ { Tcl_Obj *slaveObjPtr, *targetObjPtr; int result; @@ -1172,27 +1157,26 @@ Tcl_CreateAliasObj( int Tcl_GetAlias( Tcl_Interp *interp, /* Interp to start search from. */ - CONST char *aliasName, /* Name of alias to find. */ + const char *aliasName, /* Name of alias to find. */ Tcl_Interp **targetInterpPtr, /* (Return) target interpreter. */ - CONST char **targetNamePtr, /* (Return) name of target command. */ + const char **targetNamePtr, /* (Return) name of target command. */ int *argcPtr, /* (Return) count of addnl args. */ - CONST char ***argvPtr) /* (Return) additional arguments. */ + const char ***argvPtr) /* (Return) additional arguments. */ { - InterpInfo *iiPtr; + InterpInfo *iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo; Tcl_HashEntry *hPtr; Alias *aliasPtr; int i, objc; Tcl_Obj **objv; - iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo; hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName); if (hPtr == NULL) { - Tcl_AppendResult(interp, "alias \"", aliasName, - "\" not found", (char *) NULL); + Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL); return TCL_ERROR; } - aliasPtr = (Alias *) Tcl_GetHashValue(hPtr); + aliasPtr = Tcl_GetHashValue(hPtr); objc = aliasPtr->objc; objv = &aliasPtr->objPtr; @@ -1206,8 +1190,8 @@ Tcl_GetAlias( *argcPtr = objc - 1; } if (argvPtr != NULL) { - *argvPtr = (CONST char **) - ckalloc((unsigned) sizeof(CONST char *) * (objc - 1)); + *argvPtr = (const char **) + ckalloc((unsigned) sizeof(const char *) * (objc - 1)); for (i = 1; i < objc; i++) { *argvPtr[i - 1] = TclGetString(objv[i]); } @@ -1234,40 +1218,39 @@ Tcl_GetAlias( int Tcl_GetAliasObj( Tcl_Interp *interp, /* Interp to start search from. */ - CONST char *aliasName, /* Name of alias to find. */ + const char *aliasName, /* Name of alias to find. */ Tcl_Interp **targetInterpPtr, /* (Return) target interpreter. */ - CONST char **targetNamePtr, /* (Return) name of target command. */ + const char **targetNamePtr, /* (Return) name of target command. */ int *objcPtr, /* (Return) count of addnl args. */ Tcl_Obj ***objvPtr) /* (Return) additional args. */ { - InterpInfo *iiPtr; + InterpInfo *iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo; Tcl_HashEntry *hPtr; Alias *aliasPtr; int objc; Tcl_Obj **objv; - iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo; hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName); - if (hPtr == (Tcl_HashEntry *) NULL) { - Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found", - (char *) NULL); + if (hPtr == NULL) { + Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL); return TCL_ERROR; } - aliasPtr = (Alias *) Tcl_GetHashValue(hPtr); + aliasPtr = Tcl_GetHashValue(hPtr); objc = aliasPtr->objc; objv = &aliasPtr->objPtr; - if (targetInterpPtr != (Tcl_Interp **) NULL) { + if (targetInterpPtr != NULL) { *targetInterpPtr = aliasPtr->targetInterp; } - if (targetNamePtr != (CONST char **) NULL) { + if (targetNamePtr != NULL) { *targetNamePtr = TclGetString(objv[0]); } - if (objcPtr != (int *) NULL) { + if (objcPtr != NULL) { *objcPtr = objc - 1; } - if (objvPtr != (Tcl_Obj ***) NULL) { + if (objvPtr != NULL) { *objvPtr = objv + 1; } return TCL_OK; @@ -1340,7 +1323,7 @@ TclPreventAliasLoop( Tcl_AppendResult(interp, "cannot define or rename alias \"", Tcl_GetCommandName(cmdInterp, cmd), - "\": interpreter deleted", (char *) NULL); + "\": interpreter deleted", NULL); return TCL_ERROR; } cmdNamePtr = nextAliasPtr->objPtr; @@ -1348,14 +1331,14 @@ TclPreventAliasLoop( TclGetString(cmdNamePtr), Tcl_GetGlobalNamespace(nextAliasPtr->targetInterp), /*flags*/ 0); - if (aliasCmd == (Tcl_Command) NULL) { + if (aliasCmd == NULL) { return TCL_OK; } aliasCmdPtr = (Command *) aliasCmd; if (aliasCmdPtr == cmdPtr) { Tcl_AppendResult(interp, "cannot define or rename alias \"", Tcl_GetCommandName(cmdInterp, cmd), - "\": would create a loop", (char *) NULL); + "\": would create a loop", NULL); return TCL_ERROR; } @@ -1401,7 +1384,7 @@ AliasCreate( Tcl_Obj *namePtr, /* Name of alias cmd. */ Tcl_Obj *targetNamePtr, /* Name of target cmd. */ int objc, /* Additional arguments to store */ - Tcl_Obj *CONST objv[]) /* with alias. */ + Tcl_Obj *const objv[]) /* with alias. */ { Alias *aliasPtr; Tcl_HashEntry *hPtr; @@ -1431,7 +1414,7 @@ AliasCreate( Tcl_Preserve(masterInterp); aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp, - TclGetString(namePtr), AliasObjCmd, (ClientData) aliasPtr, + TclGetString(namePtr), AliasObjCmd, aliasPtr, AliasObjCmdDeleteProc); if (TclPreventAliasLoop(interp, slaveInterp, @@ -1503,7 +1486,7 @@ AliasCreate( } aliasPtr->aliasEntryPtr = hPtr; - Tcl_SetHashValue(hPtr, (ClientData) aliasPtr); + Tcl_SetHashValue(hPtr, aliasPtr); /* * Create the new command. We must do it after deleting any old command, @@ -1569,11 +1552,13 @@ AliasDelete( slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave; hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, TclGetString(namePtr)); if (hPtr == NULL) { - Tcl_AppendResult(interp, "alias \"", Tcl_GetString(namePtr), + Tcl_AppendResult(interp, "alias \"", TclGetString(namePtr), "\" not found", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", + TclGetString(namePtr), NULL); return TCL_ERROR; } - aliasPtr = (Alias *) Tcl_GetHashValue(hPtr); + aliasPtr = Tcl_GetHashValue(hPtr); Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd); return TCL_OK; } @@ -1618,7 +1603,7 @@ AliasDescribe( if (hPtr == NULL) { return TCL_OK; } - aliasPtr = (Alias *) Tcl_GetHashValue(hPtr); + aliasPtr = Tcl_GetHashValue(hPtr); prefixPtr = Tcl_NewListObj(aliasPtr->objc, &aliasPtr->objPtr); Tcl_SetObjResult(interp, prefixPtr); return TCL_OK; @@ -1655,7 +1640,7 @@ AliasList( entryPtr = Tcl_FirstHashEntry(&slavePtr->aliasTable, &hashSearch); for ( ; entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&hashSearch)) { - aliasPtr = (Alias *) Tcl_GetHashValue(entryPtr); + aliasPtr = Tcl_GetHashValue(entryPtr); Tcl_ListObjAppendElement(NULL, resultPtr, aliasPtr->token); } Tcl_SetObjResult(interp, resultPtr); @@ -1689,7 +1674,7 @@ AliasObjCmd( ClientData clientData, /* Alias record. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument vector. */ + Tcl_Obj *const objv[]) /* Argument vector. */ { #define ALIAS_CMDV_PREALLOC 10 Alias *aliasPtr = clientData; @@ -1744,7 +1729,7 @@ AliasObjCmd( */ if (targetInterp != interp) { - Tcl_Preserve((ClientData) targetInterp); + Tcl_Preserve(targetInterp); } /* @@ -1771,7 +1756,7 @@ AliasObjCmd( if (targetInterp != interp) { TclTransferResult(targetInterp, result, interp); - Tcl_Release((ClientData) targetInterp); + Tcl_Release(targetInterp); } for (i=0; i<cmdc; i++) { @@ -1806,13 +1791,11 @@ static void AliasObjCmdDeleteProc( ClientData clientData) /* The alias record for this alias. */ { - Alias *aliasPtr; + Alias *aliasPtr = clientData; Target *targetPtr; int i; Tcl_Obj **objv; - aliasPtr = (Alias *) clientData; - Tcl_DecrRefCount(aliasPtr->token); objv = &aliasPtr->objPtr; for (i = 0; i < aliasPtr->objc; i++) { @@ -1830,6 +1813,7 @@ AliasObjCmdDeleteProc( } else { Master *masterPtr = &((InterpInfo *) ((Interp *) aliasPtr->targetInterp)->interpInfo)->master; + masterPtr->targetsPtr = targetPtr->nextPtr; } if (targetPtr->nextPtr != NULL) { @@ -1866,7 +1850,7 @@ AliasObjCmdDeleteProc( Tcl_Interp * Tcl_CreateSlave( Tcl_Interp *interp, /* Interpreter to start search at. */ - CONST char *slavePath, /* Name of slave to create. */ + const char *slavePath, /* Name of slave to create. */ int isSafe) /* Should new slave be "safe" ? */ { Tcl_Obj *pathPtr; @@ -1898,7 +1882,7 @@ Tcl_CreateSlave( Tcl_Interp * Tcl_GetSlave( Tcl_Interp *interp, /* Interpreter to start search from. */ - CONST char *slavePath) /* Path of slave to find. */ + const char *slavePath) /* Path of slave to find. */ { Tcl_Obj *pathPtr; Tcl_Interp *slaveInterp; @@ -1932,7 +1916,7 @@ Tcl_GetMaster( { Slave *slavePtr; /* Slave record of this interpreter. */ - if (interp == (Tcl_Interp *) NULL) { + if (interp == NULL) { return NULL; } slavePtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->slave; @@ -2028,7 +2012,7 @@ GetInterp( searchInterp = NULL; break; } - slavePtr = (Slave *) Tcl_GetHashValue(hPtr); + slavePtr = Tcl_GetHashValue(hPtr); searchInterp = slavePtr->slaveInterp; if (searchInterp == NULL) { break; @@ -2036,7 +2020,9 @@ GetInterp( } if (searchInterp == NULL) { Tcl_AppendResult(interp, "could not find interpreter \"", - Tcl_GetString(pathPtr), "\"", (char *) NULL); + TclGetString(pathPtr), "\"", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INTERP", + TclGetString(pathPtr), NULL); } return searchInterp; } @@ -2064,7 +2050,7 @@ SlaveBgerror( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *slaveInterp, /* Interp in which limit is set/queried. */ int objc, /* Set or Query. */ - Tcl_Obj *CONST objv[]) /* Argument strings. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { if (objc) { int length; @@ -2072,7 +2058,7 @@ SlaveBgerror( if (TCL_ERROR == TclListObjLength(NULL, objv[0], &length) || (length < 1)) { Tcl_AppendResult(interp, "cmdPrefix must be list of length >= 1", - (char *) NULL); + NULL); return TCL_ERROR; } TclSetBgErrorHandler(interp, objv[0]); @@ -2136,10 +2122,11 @@ SlaveCreate( } masterInfoPtr = (InterpInfo *) ((Interp *) masterInterp)->interpInfo; - hPtr = Tcl_CreateHashEntry(&masterInfoPtr->master.slaveTable, path, &isNew); + hPtr = Tcl_CreateHashEntry(&masterInfoPtr->master.slaveTable, path, + &isNew); if (isNew == 0) { Tcl_AppendResult(interp, "interpreter named \"", path, - "\" already exists, cannot create", (char *) NULL); + "\" already exists, cannot create", NULL); return NULL; } @@ -2149,9 +2136,9 @@ SlaveCreate( slavePtr->slaveEntryPtr = hPtr; slavePtr->slaveInterp = slaveInterp; slavePtr->interpCmd = Tcl_CreateObjCommand(masterInterp, path, - SlaveObjCmd, (ClientData) slaveInterp, SlaveObjCmdDeleteProc); + SlaveObjCmd, slaveInterp, SlaveObjCmdDeleteProc); Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS); - Tcl_SetHashValue(hPtr, (ClientData) slavePtr); + Tcl_SetHashValue(hPtr, slavePtr); Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY); /* @@ -2197,7 +2184,7 @@ SlaveCreate( TclNewLiteralStringObj(clockObj, "clock"); Tcl_IncrRefCount(clockObj); status = AliasCreate(interp, slaveInterp, masterInterp, clockObj, - clockObj, 0, (Tcl_Obj *CONST *) NULL); + clockObj, 0, NULL); Tcl_DecrRefCount(clockObj); if (status != TCL_OK) { goto error2; @@ -2236,11 +2223,11 @@ SlaveObjCmd( ClientData clientData, /* Slave interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - Tcl_Interp *slaveInterp; + Tcl_Interp *slaveInterp = clientData; int index; - static CONST char *options[] = { + static const char *options[] = { "alias", "aliases", "bgerror", "eval", "expose", "hide", "hidden", "issafe", "invokehidden", "limit", "marktrusted", "recursionlimit", NULL @@ -2251,7 +2238,6 @@ SlaveObjCmd( OPT_INVOKEHIDDEN, OPT_LIMIT, OPT_MARKTRUSTED, OPT_RECLIMIT }; - slaveInterp = (Tcl_Interp *) clientData; if (slaveInterp == NULL) { Tcl_Panic("SlaveObjCmd: interpreter has been deleted"); } @@ -2284,7 +2270,7 @@ SlaveObjCmd( return TCL_ERROR; case OPT_ALIASES: if (objc != 2) { - Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL); + Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } return AliasList(interp, slaveInterp); @@ -2320,17 +2306,16 @@ SlaveObjCmd( return SlaveHidden(interp, slaveInterp); case OPT_ISSAFE: if (objc != 2) { - Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL); + Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(slaveInterp))); return TCL_OK; case OPT_INVOKEHIDDEN: { int i, index; - CONST char *namespaceName; - static CONST char *hiddenOptions[] = { - "-global", "-namespace", "--", - NULL + const char *namespaceName; + static const char *hiddenOptions[] = { + "-global", "-namespace", "--", NULL }; enum hiddenOption { OPT_GLOBAL, OPT_NAMESPACE, OPT_LAST @@ -2367,7 +2352,7 @@ SlaveObjCmd( objc - i, objv + i); } case OPT_LIMIT: { - static CONST char *limitTypes[] = { + static const char *limitTypes[] = { "commands", "time", NULL }; enum LimitTypes { @@ -2431,9 +2416,9 @@ SlaveObjCmdDeleteProc( ClientData clientData) /* The SlaveRecord for the command. */ { Slave *slavePtr; /* Interim storage for Slave record. */ - Tcl_Interp *slaveInterp; /* And for a slave interp. */ + Tcl_Interp *slaveInterp = clientData; + /* And for a slave interp. */ - slaveInterp = (Tcl_Interp *) clientData; slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave; /* @@ -2477,18 +2462,21 @@ SlaveEval( Tcl_Interp *slaveInterp, /* The slave interpreter in which command * will be evaluated. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { int result; Tcl_Obj *objPtr; - Tcl_Preserve((ClientData) slaveInterp); + Tcl_Preserve(slaveInterp); Tcl_AllowExceptions(slaveInterp); if (objc == 1) { - /* TIP #280 : Make invoker available to eval'd script */ - Interp* iPtr = (Interp*) interp; - result = TclEvalObjEx(slaveInterp, objv[0], 0, iPtr->cmdFramePtr,0); + /* + * TIP #280: Make invoker available to eval'd script. + */ + + Interp *iPtr = (Interp *) interp; + result = TclEvalObjEx(slaveInterp, objv[0], 0, iPtr->cmdFramePtr, 0); } else { objPtr = Tcl_ConcatObj(objc, objv); Tcl_IncrRefCount(objPtr); @@ -2497,7 +2485,7 @@ SlaveEval( } TclTransferResult(slaveInterp, result, interp); - Tcl_Release((ClientData) slaveInterp); + Tcl_Release(slaveInterp); return result; } @@ -2523,7 +2511,7 @@ SlaveExpose( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *slaveInterp, /* Interp in which command will be exposed. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument strings. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { char *name; @@ -2565,7 +2553,7 @@ SlaveRecursionLimit( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *slaveInterp, /* Interp in which limit is set/queried. */ int objc, /* Set or Query. */ - Tcl_Obj *CONST objv[]) /* Argument strings. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { Interp *iPtr; int limit; @@ -2573,8 +2561,7 @@ SlaveRecursionLimit( if (objc) { if (Tcl_IsSafe(interp)) { Tcl_AppendResult(interp, "permission denied: " - "safe interpreters cannot change recursion limit", - (char *) NULL); + "safe interpreters cannot change recursion limit", NULL); return TCL_ERROR; } if (TclGetIntFromObj(interp, objv[0], &limit) == TCL_ERROR) { @@ -2623,7 +2610,7 @@ SlaveHide( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *slaveInterp, /* Interp in which command will be exposed. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument strings. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { char *name; @@ -2670,9 +2657,9 @@ SlaveHidden( Tcl_HashSearch hSearch; /* For local searches. */ hTblPtr = ((Interp *) slaveInterp)->hiddenCmdTablePtr; - if (hTblPtr != (Tcl_HashTable *) NULL) { + if (hTblPtr != NULL) { for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); - hPtr != (Tcl_HashEntry *) NULL; + hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { Tcl_ListObjAppendElement(NULL, listObjPtr, Tcl_NewStringObj(Tcl_GetHashKey(hTblPtr, hPtr), -1)); @@ -2703,9 +2690,9 @@ SlaveInvokeHidden( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *slaveInterp, /* The slave interpreter in which command will * be invoked. */ - CONST char *namespaceName, /* The namespace to use, if any. */ + const char *namespaceName, /* The namespace to use, if any. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { int result; @@ -2716,19 +2703,18 @@ SlaveInvokeHidden( return TCL_ERROR; } - Tcl_Preserve((ClientData) slaveInterp); + Tcl_Preserve(slaveInterp); Tcl_AllowExceptions(slaveInterp); if (namespaceName == NULL) { result = TclObjInvoke(slaveInterp, objc, objv, TCL_INVOKE_HIDDEN); } else { Namespace *nsPtr, *dummy1, *dummy2; - CONST char *tail; + const char *tail; - result = TclGetNamespaceForQualName(slaveInterp, namespaceName, - (Namespace *) NULL, TCL_FIND_ONLY_NS | TCL_GLOBAL_ONLY - | TCL_LEAVE_ERR_MSG | TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, - &dummy1, &dummy2, &tail); + result = TclGetNamespaceForQualName(slaveInterp, namespaceName, NULL, + TCL_FIND_ONLY_NS | TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG + | TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); if (result == TCL_OK) { result = TclObjInvokeNamespace(slaveInterp, objc, objv, (Tcl_Namespace *)nsPtr, TCL_INVOKE_HIDDEN); @@ -2737,7 +2723,7 @@ SlaveInvokeHidden( TclTransferResult(slaveInterp, result, interp); - Tcl_Release((ClientData) slaveInterp); + Tcl_Release(slaveInterp); return result; } @@ -2794,14 +2780,12 @@ int Tcl_IsSafe( Tcl_Interp *interp) /* Is this interpreter "safe" ? */ { - Interp *iPtr; + Interp *iPtr = (Interp *) interp; - if (interp == (Tcl_Interp *) NULL) { + if (iPtr == NULL) { return 0; } - iPtr = (Interp *) interp; - - return ( (iPtr->flags) & SAFE_INTERP ) ? 1 : 0 ; + return (iPtr->flags & SAFE_INTERP) ? 1 : 0; } /* @@ -2874,15 +2858,15 @@ Tcl_MakeSafe( */ chan = Tcl_GetStdChannel(TCL_STDIN); - if (chan != (Tcl_Channel) NULL) { + if (chan != NULL) { Tcl_UnregisterChannel(interp, chan); } chan = Tcl_GetStdChannel(TCL_STDOUT); - if (chan != (Tcl_Channel) NULL) { + if (chan != NULL) { Tcl_UnregisterChannel(interp, chan); } chan = Tcl_GetStdChannel(TCL_STDERR); - if (chan != (Tcl_Channel) NULL) { + if (chan != NULL) { Tcl_UnregisterChannel(interp, chan); } @@ -3150,7 +3134,7 @@ Tcl_LimitAddHandler( deleteProc = (Tcl_LimitHandlerDeleteProc *) Tcl_Free; } if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_STATIC) { - deleteProc = (Tcl_LimitHandlerDeleteProc *) NULL; + deleteProc = NULL; } /* @@ -3588,7 +3572,7 @@ Tcl_LimitSetTime( nextMoment.usec -= 1000000; } iPtr->limit.timeEvent = TclCreateAbsoluteTimerHandler(&nextMoment, - TimeLimitCallback, (ClientData) interp); + TimeLimitCallback, interp); iPtr->limit.exceeded &= ~TCL_LIMIT_TIME; } @@ -3614,17 +3598,17 @@ static void TimeLimitCallback( ClientData clientData) { - Tcl_Interp *interp = (Tcl_Interp *) clientData; + Tcl_Interp *interp = clientData; int code; - Tcl_Preserve((ClientData) interp); + Tcl_Preserve(interp); ((Interp *)interp)->limit.timeEvent = NULL; code = Tcl_LimitCheck(interp); if (code != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (while waiting for event)"); TclBackgroundException(interp, code); } - Tcl_Release((ClientData) interp); + Tcl_Release(interp); } /* @@ -3748,7 +3732,7 @@ static void DeleteScriptLimitCallback( ClientData clientData) { - ScriptLimitCallback *limitCBPtr = (ScriptLimitCallback *) clientData; + ScriptLimitCallback *limitCBPtr = clientData; Tcl_DecrRefCount(limitCBPtr->scriptObj); if (limitCBPtr->entryPtr != NULL) { @@ -3780,7 +3764,7 @@ CallScriptLimitCallback( ClientData clientData, Tcl_Interp *interp) /* Interpreter which failed the limit */ { - ScriptLimitCallback *limitCBPtr = (ScriptLimitCallback *) clientData; + ScriptLimitCallback *limitCBPtr = clientData; int code; if (Tcl_InterpDeleted(limitCBPtr->interp)) { @@ -3848,7 +3832,7 @@ SetScriptLimitCallback( hashPtr = Tcl_CreateHashEntry(&iPtr->limit.callbacks, (char *) &key, &isNew); if (!isNew) { - limitCBPtr = (ScriptLimitCallback *) Tcl_GetHashValue(hashPtr); + limitCBPtr = Tcl_GetHashValue(hashPtr); limitCBPtr->entryPtr = NULL; Tcl_LimitRemoveHandler(targetInterp, type, CallScriptLimitCallback, limitCBPtr); @@ -3862,8 +3846,8 @@ SetScriptLimitCallback( Tcl_IncrRefCount(scriptObj); Tcl_LimitAddHandler(targetInterp, type, CallScriptLimitCallback, - (ClientData) limitCBPtr, DeleteScriptLimitCallback); - Tcl_SetHashValue(hashPtr, (ClientData) limitCBPtr); + limitCBPtr, DeleteScriptLimitCallback); + Tcl_SetHashValue(hashPtr, limitCBPtr); } /* @@ -4007,9 +3991,9 @@ SlaveCommandLimitCmd( Tcl_Interp *slaveInterp, /* Interpreter being adjusted. */ int consumedObjc, /* Number of args already parsed. */ int objc, /* Total number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - static CONST char *options[] = { + static const char *options[] = { "-command", "-granularity", "-value", NULL }; enum Options { @@ -4029,7 +4013,7 @@ SlaveCommandLimitCmd( key.type = TCL_LIMIT_COMMANDS; hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key); if (hPtr != NULL) { - limitCBPtr = (ScriptLimitCallback *) Tcl_GetHashValue(hPtr); + limitCBPtr = Tcl_GetHashValue(hPtr); if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) { Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1), limitCBPtr->scriptObj); @@ -4071,7 +4055,7 @@ SlaveCommandLimitCmd( key.type = TCL_LIMIT_COMMANDS; hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key); if (hPtr != NULL) { - limitCBPtr = (ScriptLimitCallback *) Tcl_GetHashValue(hPtr); + limitCBPtr = Tcl_GetHashValue(hPtr); if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) { Tcl_SetObjResult(interp, limitCBPtr->scriptObj); } @@ -4178,9 +4162,9 @@ SlaveTimeLimitCmd( Tcl_Interp *slaveInterp, /* Interpreter being adjusted. */ int consumedObjc, /* Number of args already parsed. */ int objc, /* Total number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - static CONST char *options[] = { + static const char *options[] = { "-command", "-granularity", "-milliseconds", "-seconds", NULL }; enum Options { @@ -4200,7 +4184,7 @@ SlaveTimeLimitCmd( key.type = TCL_LIMIT_TIME; hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key); if (hPtr != NULL) { - limitCBPtr = (ScriptLimitCallback *) Tcl_GetHashValue(hPtr); + limitCBPtr = Tcl_GetHashValue(hPtr); if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) { Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1), limitCBPtr->scriptObj); @@ -4248,7 +4232,7 @@ SlaveTimeLimitCmd( key.type = TCL_LIMIT_TIME; hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key); if (hPtr != NULL) { - limitCBPtr = (ScriptLimitCallback *) Tcl_GetHashValue(hPtr); + limitCBPtr = Tcl_GetHashValue(hPtr); if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) { Tcl_SetObjResult(interp, limitCBPtr->scriptObj); } diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index fe14f14..dd31c45 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -23,7 +23,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclNamesp.c,v 1.134.2.11 2007/11/16 07:20:54 dgp Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.134.2.12 2007/11/21 06:30:53 dgp Exp $ */ #include "tclInt.h" @@ -57,10 +57,10 @@ static Tcl_ThreadDataKey dataKey; typedef struct ResolvedNsName { Namespace *nsPtr; /* A cached pointer to the Namespace that the * name resolved to. */ - Namespace *refNsPtr; /* Points to the namespace context in which - * the name was resolved. NULL if the name - * is fully qualified and thus the resolution - * does not depend on the context. */ + Namespace *refNsPtr; /* Points to the namespace context in which the + * name was resolved. NULL if the name is fully + * qualified and thus the resolution does not + * depend on the context. */ int refCount; /* Reference count: 1 for each nsName object * that has a pointer to this ResolvedNsName * structure as its internal rep. This @@ -109,8 +109,8 @@ typedef struct EnsembleConfig { * all lists, and cannot be found by scanning * the list from the namespace's ensemble * field. */ - int flags; /* ORed combo of TCL_ENSEMBLE_PREFIX and - * ENS_DEAD. */ + int flags; /* ORed combo of TCL_ENSEMBLE_PREFIX, ENS_DEAD + * and ENSEMBLE_COMPILE. */ /* OBJECT FIELDS FOR ENSEMBLE CONFIGURATION */ @@ -380,15 +380,16 @@ Tcl_PushCallFrame( nsPtr = (Namespace *) TclGetCurrentNamespace(interp); } else { nsPtr = (Namespace *) namespacePtr; + /* - * TODO: Examine whether it would be better to guard based - * on NS_DYING or NS_KILLED. It appears that these are not - * tested because they can be set in a global interp that - * has been [namespace delete]d, but which never really - * completely goes away because of lingering global things - * like ::errorInfo and [::unknown] and hidden commands. + * TODO: Examine whether it would be better to guard based on NS_DYING + * or NS_KILLED. It appears that these are not tested because they can + * be set in a global interp that has been [namespace delete]d, but + * which never really completely goes away because of lingering global + * things like ::errorInfo and [::unknown] and hidden commands. * Review of those designs might permit stricter checking here. */ + if (nsPtr->flags & NS_DEAD) { Tcl_Panic("Trying to push call frame for dead namespace"); /*NOTREACHED*/ @@ -571,9 +572,9 @@ EstablishErrorCodeTraces( int flags) { Tcl_TraceVar(interp, "errorCode", TCL_GLOBAL_ONLY | TCL_TRACE_READS, - ErrorCodeRead, (ClientData) NULL); + ErrorCodeRead, NULL); Tcl_TraceVar(interp, "errorCode", TCL_GLOBAL_ONLY | TCL_TRACE_UNSETS, - EstablishErrorCodeTraces, (ClientData) NULL); + EstablishErrorCodeTraces, NULL); return NULL; } @@ -645,9 +646,9 @@ EstablishErrorInfoTraces( int flags) { Tcl_TraceVar(interp, "errorInfo", TCL_GLOBAL_ONLY | TCL_TRACE_READS, - ErrorInfoRead, (ClientData) NULL); + ErrorInfoRead, NULL); Tcl_TraceVar(interp, "errorInfo", TCL_GLOBAL_ONLY | TCL_TRACE_UNSETS, - EstablishErrorInfoTraces, (ClientData) NULL); + EstablishErrorInfoTraces, NULL); return NULL; } @@ -676,7 +677,7 @@ ErrorInfoRead( const char *name2, int flags) { - Interp *iPtr = (Interp *)interp; + Interp *iPtr = (Interp *) interp; if (Tcl_InterpDeleted(interp) || !(iPtr->flags & ERR_LEGACY_COPY)) { return NULL; @@ -793,7 +794,7 @@ Tcl_CreateNamespace( */ nsPtr = (Namespace *) ckalloc(sizeof(Namespace)); - nsPtr->name = (char *) ckalloc((unsigned) (strlen(simpleName)+1)); + nsPtr->name = ckalloc((unsigned) (strlen(simpleName)+1)); strcpy(nsPtr->name, simpleName); nsPtr->fullName = NULL; /* Set below. */ nsPtr->clientData = clientData; @@ -825,7 +826,7 @@ Tcl_CreateNamespace( if (parentPtr != NULL) { entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName, &newEntry); - Tcl_SetHashValue(entryPtr, (ClientData) nsPtr); + Tcl_SetHashValue(entryPtr, nsPtr); } else { /* * In the global namespace create traces to maintain the ::errorInfo @@ -876,7 +877,7 @@ Tcl_CreateNamespace( name = Tcl_DStringValue(namePtr); nameLen = Tcl_DStringLength(namePtr); - nsPtr->fullName = (char *) ckalloc((unsigned) (nameLen+1)); + nsPtr->fullName = ckalloc((unsigned) (nameLen+1)); memcpy(nsPtr->fullName, name, (unsigned) nameLen + 1); Tcl_DStringFree(&buffer1); @@ -914,8 +915,8 @@ Tcl_DeleteNamespace( { register Namespace *nsPtr = (Namespace *) namespacePtr; Interp *iPtr = (Interp *) nsPtr->interp; - Namespace *globalNsPtr = - (Namespace *) TclGetGlobalNamespace((Tcl_Interp *) iPtr); + Namespace *globalNsPtr = (Namespace *) + TclGetGlobalNamespace((Tcl_Interp *) iPtr); Tcl_HashEntry *entryPtr; /* @@ -1082,7 +1083,7 @@ TclTeardownNamespace( for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); entryPtr != NULL; entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search)) { - cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr); + cmd = Tcl_GetHashValue(entryPtr); Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, cmd); } Tcl_DeleteHashTable(&nsPtr->cmdTable); @@ -1134,7 +1135,7 @@ TclTeardownNamespace( for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search); entryPtr != NULL; entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) { - childNsPtr = (Tcl_Namespace *) Tcl_GetHashValue(entryPtr); + childNsPtr = Tcl_GetHashValue(entryPtr); Tcl_DeleteNamespace(childNsPtr); } @@ -1313,8 +1314,8 @@ Tcl_Export( if (neededElems > nsPtr->maxExportPatterns) { nsPtr->maxExportPatterns = nsPtr->maxExportPatterns ? 2 * nsPtr->maxExportPatterns : INIT_EXPORT_PATTERNS; - nsPtr->exportArrayPtr = (char **) ckrealloc( - (char *)nsPtr->exportArrayPtr, + nsPtr->exportArrayPtr = (char **) + ckrealloc((char *) nsPtr->exportArrayPtr, sizeof(char *) * nsPtr->maxExportPatterns); } @@ -1323,7 +1324,7 @@ Tcl_Export( */ len = strlen(pattern); - patternCpy = (char *) ckalloc((unsigned) (len + 1)); + patternCpy = ckalloc((unsigned) (len + 1)); memcpy(patternCpy, pattern, (unsigned) len + 1); nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy; @@ -1499,6 +1500,7 @@ Tcl_Import( if (importNsPtr == NULL) { Tcl_AppendResult(interp, "unknown namespace in import pattern \"", pattern, "\"", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, NULL); return TCL_ERROR; } if (importNsPtr == nsPtr) { @@ -1616,15 +1618,14 @@ DoImport( * namespace would create a cycle of imported command references. */ - cmdPtr = (Command *) Tcl_GetHashValue(hPtr); + cmdPtr = Tcl_GetHashValue(hPtr); if (found != NULL && cmdPtr->deleteProc == DeleteImportedCmd) { - Command *overwrite = (Command *) Tcl_GetHashValue(found); + Command *overwrite = Tcl_GetHashValue(found); Command *link = cmdPtr; while (link->deleteProc == DeleteImportedCmd) { - ImportedCmdData *dataPtr; + ImportedCmdData *dataPtr = link->objClientData; - dataPtr = (ImportedCmdData *) link->objClientData; link = dataPtr->realCmdPtr; if (overwrite == link) { Tcl_AppendResult(interp, "import pattern \"", pattern, @@ -1638,7 +1639,7 @@ DoImport( dataPtr = (ImportedCmdData *) ckalloc(sizeof(ImportedCmdData)); importedCmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds), - InvokeImportedCmd, (ClientData) dataPtr, DeleteImportedCmd); + InvokeImportedCmd, dataPtr, DeleteImportedCmd); dataPtr->realCmdPtr = cmdPtr; dataPtr->selfPtr = (Command *) importedCmd; dataPtr->selfPtr->compileProc = cmdPtr->compileProc; @@ -1654,12 +1655,12 @@ DoImport( refPtr->nextPtr = cmdPtr->importRefPtr; cmdPtr->importRefPtr = refPtr; } else { - Command *overwrite = (Command *) Tcl_GetHashValue(found); + Command *overwrite = Tcl_GetHashValue(found); if (overwrite->deleteProc == DeleteImportedCmd) { - ImportedCmdData *dataPtr = (ImportedCmdData *) - overwrite->objClientData; - if (dataPtr->realCmdPtr == (Command *) Tcl_GetHashValue(hPtr)) { + ImportedCmdData *dataPtr = overwrite->objClientData; + + if (dataPtr->realCmdPtr == Tcl_GetHashValue(hPtr)) { /* * Repeated import of same command is acceptable. */ @@ -1739,6 +1740,7 @@ Tcl_ForgetImport( Tcl_AppendResult(interp, "unknown namespace in namespace forget pattern \"", pattern, "\"", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, NULL); return TCL_ERROR; } @@ -1749,9 +1751,10 @@ Tcl_ForgetImport( if (TclMatchIsTrivial(simplePattern)) { Command *cmdPtr; + hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern); if ((hPtr != NULL) - && (cmdPtr = (Command *) Tcl_GetHashValue(hPtr)) + && (cmdPtr = Tcl_GetHashValue(hPtr)) && (cmdPtr->deleteProc == DeleteImportedCmd)) { Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); } @@ -1759,7 +1762,8 @@ Tcl_ForgetImport( } for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); (hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) { - Command *cmdPtr = (Command *) Tcl_GetHashValue(hPtr); + Command *cmdPtr = Tcl_GetHashValue(hPtr); + if (cmdPtr->deleteProc != DeleteImportedCmd) { continue; } @@ -1778,7 +1782,7 @@ Tcl_ForgetImport( for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); (hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) { Tcl_CmdInfo info; - Tcl_Command token = (Tcl_Command) Tcl_GetHashValue(hPtr); + Tcl_Command token = Tcl_GetHashValue(hPtr); Tcl_Command origin = TclGetOriginalCommand(token); if (Tcl_GetCommandInfoFromToken(origin, &info) == 0) { @@ -1791,9 +1795,9 @@ Tcl_ForgetImport( */ Command *cmdPtr = (Command *) token; - ImportedCmdData *dataPtr = - (ImportedCmdData *) cmdPtr->objClientData; + ImportedCmdData *dataPtr = cmdPtr->objClientData; Tcl_Command firstToken = (Tcl_Command) dataPtr->realCmdPtr; + if (firstToken == origin) { continue; } @@ -1842,11 +1846,11 @@ TclGetOriginalCommand( ImportedCmdData *dataPtr; if (cmdPtr->deleteProc != DeleteImportedCmd) { - return (Tcl_Command) NULL; + return NULL; } while (cmdPtr->deleteProc == DeleteImportedCmd) { - dataPtr = (ImportedCmdData *) cmdPtr->objClientData; + dataPtr = cmdPtr->objClientData; cmdPtr = dataPtr->realCmdPtr; } return (Tcl_Command) cmdPtr; @@ -1879,7 +1883,7 @@ InvokeImportedCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - register ImportedCmdData *dataPtr = (ImportedCmdData *) clientData; + register ImportedCmdData *dataPtr = clientData; register Command *realCmdPtr = dataPtr->realCmdPtr; return (*realCmdPtr->objProc)(realCmdPtr->objClientData, interp, @@ -1912,7 +1916,7 @@ DeleteImportedCmd( ClientData clientData) /* Points to the imported command's * ImportedCmdData structure. */ { - ImportedCmdData *dataPtr = (ImportedCmdData *) clientData; + ImportedCmdData *dataPtr = clientData; Command *realCmdPtr = dataPtr->realCmdPtr; Command *selfPtr = dataPtr->selfPtr; register ImportRef *refPtr, *prevPtr; @@ -2180,7 +2184,7 @@ TclGetNamespaceForQualName( if (nsPtr != NULL) { entryPtr = Tcl_FindHashEntry(&nsPtr->childTable, nsName); if (entryPtr != NULL) { - nsPtr = (Namespace *) Tcl_GetHashValue(entryPtr); + nsPtr = Tcl_GetHashValue(entryPtr); } else if (flags & TCL_CREATE_NS_IF_UNKNOWN) { Tcl_CallFrame *framePtr; @@ -2188,7 +2192,7 @@ TclGetNamespaceForQualName( (Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 0); nsPtr = (Namespace *) Tcl_CreateNamespace(interp, nsName, - (ClientData) NULL, NULL); + NULL, NULL); TclPopStackFrame(interp); if (nsPtr == NULL) { @@ -2207,7 +2211,7 @@ TclGetNamespaceForQualName( if (altNsPtr != NULL) { entryPtr = Tcl_FindHashEntry(&altNsPtr->childTable, nsName); if (entryPtr != NULL) { - altNsPtr = (Namespace *) Tcl_GetHashValue(entryPtr); + altNsPtr = Tcl_GetHashValue(entryPtr); } else { altNsPtr = NULL; } @@ -2311,6 +2315,7 @@ Tcl_FindNamespace( } else if (flags & TCL_LEAVE_ERR_MSG) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "unknown namespace \"", name, "\"", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", name, NULL); } return NULL; } @@ -2401,7 +2406,7 @@ Tcl_FindCommand( if (result == TCL_OK) { return cmd; } else if (result != TCL_CONTINUE) { - return (Tcl_Command) NULL; + return NULL; } } @@ -2422,7 +2427,7 @@ Tcl_FindCommand( || !(realNsPtr->flags & NS_DYING)) { entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName); if (entryPtr != NULL) { - cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); + cmdPtr = Tcl_GetHashValue(entryPtr); } } } @@ -2443,7 +2448,7 @@ Tcl_FindCommand( && !(realNsPtr->flags & NS_DYING)) { entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName); if (entryPtr != NULL) { - cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); + cmdPtr = Tcl_GetHashValue(entryPtr); } } } @@ -2461,7 +2466,7 @@ Tcl_FindCommand( && !(realNsPtr->flags & NS_DYING)) { entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName); if (entryPtr != NULL) { - cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); + cmdPtr = Tcl_GetHashValue(entryPtr); } } } @@ -2483,7 +2488,7 @@ Tcl_FindCommand( entryPtr = Tcl_FindHashEntry(&nsPtr[search]->cmdTable, simpleName); if (entryPtr != NULL) { - cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); + cmdPtr = Tcl_GetHashValue(entryPtr); } } } @@ -2496,8 +2501,9 @@ Tcl_FindCommand( if (flags & TCL_LEAVE_ERR_MSG) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "unknown command \"", name, "\"", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", name, NULL); } - return (Tcl_Command) NULL; + return NULL; } /* @@ -2585,7 +2591,7 @@ TclResetShadowedCmdRefs( hPtr = Tcl_FindHashEntry(&shadowNsPtr->childTable, trailNsPtr->name); if (hPtr != NULL) { - shadowNsPtr = (Namespace *) Tcl_GetHashValue(hPtr); + shadowNsPtr = Tcl_GetHashValue(hPtr); } else { found = 0; break; @@ -2637,7 +2643,7 @@ TclResetShadowedCmdRefs( /* *---------------------------------------------------------------------- * - * TclGetNamespaceFromObj -- + * TclGetNamespaceFromObj, GetNamespaceFromObj -- * * Gets the namespace specified by the name in a Tcl_Obj. * @@ -2665,20 +2671,26 @@ TclGetNamespaceFromObj( { if (GetNamespaceFromObj(interp, objPtr, nsPtrPtr) == TCL_ERROR) { const char *name = TclGetString(objPtr); + if ((name[0] == ':') && (name[1] == ':')) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "namespace \"%s\" not found", name)); } else { - /* Get the current namespace name */ + /* + * Get the current namespace name. + */ + NamespaceCurrentCmd(NULL, interp, 2, NULL); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "namespace \"%s\" not found in \"%s\"", name, Tcl_GetStringResult(interp))); } + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", name, NULL); return TCL_ERROR; } return TCL_OK; } + static int GetNamespaceFromObj( Tcl_Interp *interp, /* The current interpreter. */ @@ -2690,7 +2702,10 @@ GetNamespaceFromObj( Namespace *nsPtr; if (objPtr->typePtr == &nsNameType) { - /* Check that the ResolvedNsName is still valid. */ + /* + * Check that the ResolvedNsName is still valid. + */ + resNamePtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1; nsPtr = resNamePtr->nsPtr; if (!(nsPtr->flags & NS_DYING) @@ -2939,7 +2954,7 @@ NamespaceChildrenCmd( } entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search); while (entryPtr != NULL) { - childNsPtr = (Namespace *) Tcl_GetHashValue(entryPtr); + childNsPtr = Tcl_GetHashValue(entryPtr); if ((pattern == NULL) || Tcl_StringMatch(childNsPtr->fullName, pattern)) { elemPtr = Tcl_NewStringObj(childNsPtr->fullName, -1); @@ -3160,6 +3175,8 @@ NamespaceDeleteCmd( Tcl_AppendResult(interp, "unknown namespace \"", TclGetString(objv[i]), "\" in namespace delete command", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", + TclGetString(objv[i]), NULL); return TCL_ERROR; } } @@ -3235,8 +3252,8 @@ NamespaceEvalCmd( if (result == TCL_ERROR) { char *name = TclGetString(objv[2]); - namespacePtr = Tcl_CreateNamespace(interp, name, (ClientData) NULL, - NULL); + + namespacePtr = Tcl_CreateNamespace(interp, name, NULL, NULL); if (namespacePtr == NULL) { return TCL_ERROR; } @@ -3422,8 +3439,8 @@ NamespaceExportCmd( */ Tcl_Obj *listPtr = Tcl_NewListObj(0, NULL); - result = Tcl_AppendExportList(interp, - (Tcl_Namespace *) currNsPtr, listPtr); + result = Tcl_AppendExportList(interp, (Tcl_Namespace *) currNsPtr, + listPtr); if (result != TCL_OK) { return result; } @@ -3584,7 +3601,7 @@ NamespaceImportCmd( TclNewObj(listPtr); for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Command *cmdPtr = (Command *) Tcl_GetHashValue(hPtr); + Command *cmdPtr = Tcl_GetHashValue(hPtr); if (cmdPtr->deleteProc == DeleteImportedCmd) { Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj( @@ -3666,9 +3683,8 @@ NamespaceInscopeCmd( * Resolve the namespace reference. */ - result = TclGetNamespaceFromObj(interp, objv[2], &namespacePtr); - if (result != TCL_OK) { - return result; + if (TclGetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) { + return TCL_ERROR; } /* @@ -3677,7 +3693,7 @@ NamespaceInscopeCmd( framePtrPtr = &framePtr; /* This is needed to satisfy GCC's * strict aliasing rules. */ - result = TclPushStackFrame(interp, (Tcl_CallFrame **)framePtrPtr, + result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, namespacePtr, /*isProcCallFrame*/ 0); if (result != TCL_OK) { return result; @@ -3701,10 +3717,9 @@ NamespaceInscopeCmd( listPtr = Tcl_NewListObj(0, NULL); for (i = 4; i < objc; i++) { - result = Tcl_ListObjAppendElement(interp, listPtr, objv[i]); - if (result != TCL_OK) { + if (Tcl_ListObjAppendElement(interp, listPtr, objv[i]) != TCL_OK) { Tcl_DecrRefCount(listPtr); /* Free unneeded obj. */ - return result; + return TCL_ERROR; } } @@ -3779,14 +3794,16 @@ NamespaceOriginCmd( } command = Tcl_GetCommandFromObj(interp, objv[2]); - if (command == (Tcl_Command) NULL) { + if (command == NULL) { Tcl_AppendResult(interp, "invalid command name \"", TclGetString(objv[2]), "\"", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", + TclGetString(objv[2]), NULL); return TCL_ERROR; } origCommand = TclGetOriginalCommand(command); TclNewObj(resultPtr); - if (origCommand == (Tcl_Command) NULL) { + if (origCommand == NULL) { /* * The specified command isn't an imported command. Return the * command's name qualified by the full name of the namespace it was @@ -3830,14 +3847,12 @@ NamespaceParentCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Namespace *nsPtr; - int result; if (objc == 2) { nsPtr = TclGetCurrentNamespace(interp); } else if (objc == 3) { - result = TclGetNamespaceFromObj(interp, objv[2], &nsPtr); - if (result != TCL_OK) { - return result; + if (TclGetNamespaceFromObj(interp, objv[2], &nsPtr) != TCL_OK) { + return TCL_ERROR; } } else { Tcl_WrongNumArgs(interp, 2, objv, "?name?"); @@ -3925,7 +3940,6 @@ NamespacePathCmd( goto badNamespace; } if (nsObjc != 0) { - namespaceList = (Tcl_Namespace **) TclStackAlloc(interp, sizeof(Tcl_Namespace *) * nsObjc); @@ -3977,12 +3991,11 @@ TclSetNsPath( int pathLength, /* Length of pathAry. */ Tcl_Namespace *pathAry[]) /* Array of namespaces that are the path. */ { - NamespacePathEntry *tmpPathArray; - int i; - if (pathLength != 0) { - tmpPathArray = (NamespacePathEntry *) + NamespacePathEntry *tmpPathArray = (NamespacePathEntry *) ckalloc(sizeof(NamespacePathEntry) * pathLength); + int i; + for (i=0 ; i<pathLength ; i++) { tmpPathArray[i].nsPtr = (Namespace *) pathAry[i]; tmpPathArray[i].creatorNsPtr = nsPtr; @@ -4417,7 +4430,6 @@ NamespaceUpvarCmd( { Interp *iPtr = (Interp *) interp; Tcl_Namespace *nsPtr, *savedNsPtr; - int result; Var *otherPtr, *arrayPtr; char *myName; @@ -4427,8 +4439,7 @@ NamespaceUpvarCmd( return TCL_ERROR; } - result = TclGetNamespaceFromObj(interp, objv[2], &nsPtr); - if (result != TCL_OK) { + if (TclGetNamespaceFromObj(interp, objv[2], &nsPtr) != TCL_OK) { return TCL_ERROR; } @@ -4455,8 +4466,7 @@ NamespaceUpvarCmd( */ myName = TclGetString(objv[1]); - result = TclPtrMakeUpvar(interp, otherPtr, myName, 0, -1); - if (result != TCL_OK) { + if (TclPtrMakeUpvar(interp, otherPtr, myName, 0, -1) != TCL_OK) { return TCL_ERROR; } } @@ -4524,7 +4534,7 @@ NamespaceWhichCmd( case 0: { /* -command */ Tcl_Command cmd = Tcl_GetCommandFromObj(interp, objv[objc-1]); - if (cmd != (Tcl_Command) NULL) { + if (cmd != NULL) { Tcl_GetCommandFullName(interp, cmd, resultPtr); } break; @@ -4533,7 +4543,7 @@ NamespaceWhichCmd( Tcl_Var var = Tcl_FindNamespaceVar(interp, TclGetString(objv[objc-1]), NULL, /*flags*/ 0); - if (var != (Tcl_Var) NULL) { + if (var != NULL) { Tcl_GetVariableFullName(interp, var, resultPtr); } break; @@ -4621,7 +4631,7 @@ DupNsNameInternalRep( register ResolvedNsName *resNamePtr = (ResolvedNsName *) srcPtr->internalRep.twoPtrValue.ptr1; - copyPtr->internalRep.twoPtrValue.ptr1 = (void *) resNamePtr; + copyPtr->internalRep.twoPtrValue.ptr1 = resNamePtr; resNamePtr->refCount++; copyPtr->typePtr = &nsNameType; } @@ -4668,34 +4678,33 @@ SetNsNameFromAny( * that holds a reference to it. */ - if ((nsPtr != NULL) && !(nsPtr->flags & NS_DYING)) { - nsPtr->refCount++; - resNamePtr = (ResolvedNsName *) ckalloc(sizeof(ResolvedNsName)); - resNamePtr->nsPtr = nsPtr; - if ((name[0] == ':') && (name[1] == ':')) { - resNamePtr->refNsPtr = NULL; - } else { - resNamePtr->refNsPtr = - (Namespace *) Tcl_GetCurrentNamespace(interp); - } - resNamePtr->refCount = 1; - TclFreeIntRep(objPtr); - objPtr->internalRep.twoPtrValue.ptr1 = (void *) resNamePtr; - objPtr->typePtr = &nsNameType; - return TCL_OK; - } else { + if ((nsPtr == NULL) || (nsPtr->flags & NS_DYING)) { + /* + * Our failed lookup proves any previously cached nsName intrep is no + * longer valid. Get rid of it so we no longer waste memory storing + * it, nor time determining its invalidity again and again. + */ + if (objPtr->typePtr == &nsNameType) { - /* - * Our failed lookup proves any previously cached nsName - * intrep is no longer valid. Get rid of it so we no longer - * waste memory storing it, nor time determining its invalidity - * again and again. - */ TclFreeIntRep(objPtr); objPtr->typePtr = NULL; } return TCL_ERROR; } + + nsPtr->refCount++; + resNamePtr = (ResolvedNsName *) ckalloc(sizeof(ResolvedNsName)); + resNamePtr->nsPtr = nsPtr; + if ((name[0] == ':') && (name[1] == ':')) { + resNamePtr->refNsPtr = NULL; + } else { + resNamePtr->refNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + } + resNamePtr->refCount = 1; + TclFreeIntRep(objPtr); + objPtr->internalRep.twoPtrValue.ptr1 = resNamePtr; + objPtr->typePtr = &nsNameType; + return TCL_OK; } /* @@ -5237,8 +5246,8 @@ Tcl_CreateEnsemble( int flags) { Namespace *nsPtr = (Namespace *) namespacePtr; - EnsembleConfig *ensemblePtr = - (EnsembleConfig *) ckalloc(sizeof(EnsembleConfig)); + EnsembleConfig *ensemblePtr = (EnsembleConfig *) + ckalloc(sizeof(EnsembleConfig)); Tcl_Obj *nameObj = NULL; if (nsPtr == NULL) { @@ -5270,8 +5279,7 @@ Tcl_CreateEnsemble( ensemblePtr->flags = flags; ensemblePtr->unknownHandler = NULL; ensemblePtr->token = Tcl_CreateObjCommand(interp, name, - NsEnsembleImplementationCmd, (ClientData)ensemblePtr, - DeleteEnsembleConfig); + NsEnsembleImplementationCmd, ensemblePtr, DeleteEnsembleConfig); ensemblePtr->next = (EnsembleConfig *) nsPtr->ensembles; nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr; @@ -5284,6 +5292,10 @@ Tcl_CreateEnsemble( nsPtr->exportLookupEpoch++; + if (flags & ENSEMBLE_COMPILE) { + ((Command *) ensemblePtr->token)->compileProc = TclCompileEnsemble; + } + if (nameObj != NULL) { TclDecrRefCount(nameObj); } @@ -5332,7 +5344,7 @@ Tcl_SetEnsembleSubcommandList( } } - ensemblePtr = (EnsembleConfig *) cmdPtr->objClientData; + ensemblePtr = cmdPtr->objClientData; oldList = ensemblePtr->subcmdList; ensemblePtr->subcmdList = subcmdList; if (subcmdList != NULL) { @@ -5358,9 +5370,6 @@ Tcl_SetEnsembleSubcommandList( if (cmdPtr->compileProc != NULL) { ((Interp *)interp)->compileEpoch++; - if (subcmdList != NULL) { - cmdPtr->compileProc = NULL; - } } return TCL_OK; @@ -5408,7 +5417,7 @@ Tcl_SetEnsembleMappingDict( } } - ensemblePtr = (EnsembleConfig *) cmdPtr->objClientData; + ensemblePtr = cmdPtr->objClientData; oldDict = ensemblePtr->subcommandDict; ensemblePtr->subcommandDict = mapDict; if (mapDict != NULL) { @@ -5434,9 +5443,6 @@ Tcl_SetEnsembleMappingDict( if (cmdPtr->compileProc != NULL) { ((Interp *)interp)->compileEpoch++; - if (mapDict == NULL) { - cmdPtr->compileProc = NULL; - } } return TCL_OK; @@ -5484,7 +5490,7 @@ Tcl_SetEnsembleUnknownHandler( } } - ensemblePtr = (EnsembleConfig *) cmdPtr->objClientData; + ensemblePtr = cmdPtr->objClientData; oldList = ensemblePtr->unknownHandler; ensemblePtr->unknownHandler = unknownList; if (unknownList != NULL) { @@ -5531,13 +5537,15 @@ Tcl_SetEnsembleFlags( { Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; + int wasCompiled; if (cmdPtr->objProc != NsEnsembleImplementationCmd) { Tcl_AppendResult(interp, "command is not an ensemble", NULL); return TCL_ERROR; } - ensemblePtr = (EnsembleConfig *) cmdPtr->objClientData; + ensemblePtr = cmdPtr->objClientData; + wasCompiled = ensemblePtr->flags & ENSEMBLE_COMPILE; /* * This API refuses to set the ENS_DEAD flag... @@ -5555,6 +5563,24 @@ Tcl_SetEnsembleFlags( ensemblePtr->nsPtr->exportLookupEpoch++; + /* + * If the ENSEMBLE_COMPILE flag status was changed, install or remove the + * compiler function and bump the interpreter's compilation epoch so that + * bytecode gets regenerated. + */ + + if (flags & ENSEMBLE_COMPILE) { + if (!wasCompiled) { + ((Command*) ensemblePtr->token)->compileProc = TclCompileEnsemble; + ((Interp *) interp)->compileEpoch++; + } + } else { + if (wasCompiled) { + ((Command*) ensemblePtr->token)->compileProc = NULL; + ((Interp *) interp)->compileEpoch++; + } + } + return TCL_OK; } @@ -5594,7 +5620,7 @@ Tcl_GetEnsembleSubcommandList( return TCL_ERROR; } - ensemblePtr = (EnsembleConfig *) cmdPtr->objClientData; + ensemblePtr = cmdPtr->objClientData; *subcmdListPtr = ensemblePtr->subcmdList; return TCL_OK; } @@ -5634,7 +5660,7 @@ Tcl_GetEnsembleMappingDict( return TCL_ERROR; } - ensemblePtr = (EnsembleConfig *) cmdPtr->objClientData; + ensemblePtr = cmdPtr->objClientData; *mapDictPtr = ensemblePtr->subcommandDict; return TCL_OK; } @@ -5673,7 +5699,7 @@ Tcl_GetEnsembleUnknownHandler( return TCL_ERROR; } - ensemblePtr = (EnsembleConfig *) cmdPtr->objClientData; + ensemblePtr = cmdPtr->objClientData; *unknownListPtr = ensemblePtr->unknownHandler; return TCL_OK; } @@ -5712,7 +5738,7 @@ Tcl_GetEnsembleFlags( return TCL_ERROR; } - ensemblePtr = (EnsembleConfig *) cmdPtr->objClientData; + ensemblePtr = cmdPtr->objClientData; *flagsPtr = ensemblePtr->flags; return TCL_OK; } @@ -5751,7 +5777,7 @@ Tcl_GetEnsembleNamespace( return TCL_ERROR; } - ensemblePtr = (EnsembleConfig *) cmdPtr->objClientData; + ensemblePtr = cmdPtr->objClientData; *namespacePtrPtr = (Tcl_Namespace *) ensemblePtr->nsPtr; return TCL_OK; } @@ -5804,6 +5830,8 @@ Tcl_FindEnsemble( if (flags & TCL_LEAVE_ERR_MSG) { Tcl_AppendResult(interp, "\"", TclGetString(cmdNameObj), "\" is not an ensemble command", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE", + TclGetString(cmdNameObj), NULL); } return NULL; } @@ -5873,7 +5901,7 @@ NsEnsembleImplementationCmd( int objc, Tcl_Obj *const objv[]) { - EnsembleConfig *ensemblePtr = (EnsembleConfig *) clientData; + EnsembleConfig *ensemblePtr = clientData; /* The ensemble itself. */ Tcl_Obj **tempObjv; /* Space used to construct the list of * arguments to pass to the command that @@ -5896,89 +5924,7 @@ NsEnsembleImplementationCmd( } restartEnsembleParse: - if (!(ensemblePtr->nsPtr->flags & NS_DYING)) { - if (ensemblePtr->epoch == ensemblePtr->nsPtr->exportLookupEpoch) { - /* - * Table of subcommands is still valid; therefore there might be a - * valid cache of discovered information which we can reuse. Do - * the check here, and if we're still valid, we can jump straight - * to the part where we do the invocation of the subcommand. - */ - - if (objv[1]->typePtr == &tclEnsembleCmdType) { - EnsembleCmdRep *ensembleCmd = (EnsembleCmdRep *) - objv[1]->internalRep.otherValuePtr; - if (ensembleCmd->nsPtr == ensemblePtr->nsPtr && - ensembleCmd->epoch == ensemblePtr->epoch && - ensembleCmd->token == ensemblePtr->token) { - Interp *iPtr; - int isRootEnsemble; - Tcl_Obj *copyObj; - - prefixObj = ensembleCmd->realPrefixObj; - Tcl_IncrRefCount(prefixObj); - - runResultingSubcommand: - /* - * Do the real work of execution of the subcommand by - * building an array of objects (note that this is - * potentially not the same length as the number of - * arguments to this ensemble command), populating it and - * then feeding it back through the main command-lookup - * engine. In theory, we could look up the command in the - * namespace ourselves, as we already have the namespace - * in which it is guaranteed to exist, but we don't do - * that (the cacheing of the command object used should - * help with that.) - */ - - iPtr = (Interp *) interp; - isRootEnsemble = - (iPtr->ensembleRewrite.sourceObjs == NULL); - copyObj = TclListObjCopy(NULL, prefixObj); - - TclListObjGetElements(NULL, copyObj, &prefixObjc, - &prefixObjv); - if (isRootEnsemble) { - iPtr->ensembleRewrite.sourceObjs = objv; - iPtr->ensembleRewrite.numRemovedObjs = 2; - iPtr->ensembleRewrite.numInsertedObjs = prefixObjc; - } else { - int ni = iPtr->ensembleRewrite.numInsertedObjs; - - if (ni < 2) { - iPtr->ensembleRewrite.numRemovedObjs += 2 - ni; - iPtr->ensembleRewrite.numInsertedObjs += - prefixObjc - 1; - } else { - iPtr->ensembleRewrite.numInsertedObjs += - prefixObjc - 2; - } - } - tempObjv = (Tcl_Obj **) TclStackAlloc(interp, - (int) sizeof(Tcl_Obj*) * (objc - 2 + prefixObjc)); - memcpy(tempObjv, prefixObjv, - sizeof(Tcl_Obj *) * prefixObjc); - memcpy(tempObjv+prefixObjc, objv+2, - sizeof(Tcl_Obj *) * (objc-2)); - result = Tcl_EvalObjv(interp, objc-2+prefixObjc, tempObjv, - TCL_EVAL_INVOKE); - Tcl_DecrRefCount(copyObj); - Tcl_DecrRefCount(prefixObj); - TclStackFree(interp, tempObjv); - if (isRootEnsemble) { - iPtr->ensembleRewrite.sourceObjs = NULL; - iPtr->ensembleRewrite.numRemovedObjs = 0; - iPtr->ensembleRewrite.numInsertedObjs = 0; - } - return result; - } - } - } else { - BuildEnsembleConfig(ensemblePtr); - ensemblePtr->epoch = ensemblePtr->nsPtr->exportLookupEpoch; - } - } else { + if (ensemblePtr->nsPtr->flags & NS_DYING) { /* * Don't know how we got here, but make things give up quickly. */ @@ -5991,6 +5937,35 @@ NsEnsembleImplementationCmd( } /* + * Determine if the table of subcommands is right. If so, we can just look + * up in there and go straight to dispatch. + */ + + if (ensemblePtr->epoch == ensemblePtr->nsPtr->exportLookupEpoch) { + /* + * Table of subcommands is still valid; therefore there might be a + * valid cache of discovered information which we can reuse. Do the + * check here, and if we're still valid, we can jump straight to the + * part where we do the invocation of the subcommand. + */ + + if (objv[1]->typePtr == &tclEnsembleCmdType) { + EnsembleCmdRep *ensembleCmd = objv[1]->internalRep.otherValuePtr; + + if (ensembleCmd->nsPtr == ensemblePtr->nsPtr && + ensembleCmd->epoch == ensemblePtr->epoch && + ensembleCmd->token == ensemblePtr->token) { + prefixObj = ensembleCmd->realPrefixObj; + Tcl_IncrRefCount(prefixObj); + goto runResultingSubcommand; + } + } + } else { + BuildEnsembleConfig(ensemblePtr); + ensemblePtr->epoch = ensemblePtr->nsPtr->exportLookupEpoch; + } + + /* * Look in the hashtable for the subcommand name; this is the fastest way * of all. */ @@ -5999,16 +5974,21 @@ NsEnsembleImplementationCmd( TclGetString(objv[1])); if (hPtr != NULL) { char *fullName = Tcl_GetHashKey(&ensemblePtr->subcommandTable, hPtr); - prefixObj = (Tcl_Obj *) Tcl_GetHashValue(hPtr); + + prefixObj = Tcl_GetHashValue(hPtr); /* * Cache for later in the subcommand object. */ MakeCachedEnsembleCommand(objv[1], ensemblePtr, fullName, prefixObj); - Tcl_IncrRefCount(prefixObj); - goto runResultingSubcommand; - } else if (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX) { + } else if (!(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX)) { + /* + * Could not map, no prefixing, go to unknown/error handling. + */ + + goto unknownOrAmbiguousSubcommand; + } else { /* * If we've not already confirmed the command with the hash as part of * building our export table, we need to scan the sorted array for @@ -6028,6 +6008,7 @@ NsEnsembleImplementationCmd( register int cmp = strncmp(subcmdName, ensemblePtr->subcommandArrayPtr[i], (unsigned) stringLength); + if (cmp == 0) { if (fullName != NULL) { /* @@ -6062,17 +6043,95 @@ NsEnsembleImplementationCmd( Tcl_Panic("full name %s not found in supposedly synchronized hash", fullName); } - prefixObj = (Tcl_Obj *) Tcl_GetHashValue(hPtr); + prefixObj = Tcl_GetHashValue(hPtr); /* * Cache for later in the subcommand object. */ MakeCachedEnsembleCommand(objv[1], ensemblePtr, fullName, prefixObj); - Tcl_IncrRefCount(prefixObj); - goto runResultingSubcommand; } + Tcl_IncrRefCount(prefixObj); + runResultingSubcommand: + + /* + * Do the real work of execution of the subcommand by building an array of + * objects (note that this is potentially not the same length as the + * number of arguments to this ensemble command), populating it and then + * feeding it back through the main command-lookup engine. In theory, we + * could look up the command in the namespace ourselves, as we already + * have the namespace in which it is guaranteed to exist, but we don't do + * that (the cacheing of the command object used should help with that.) + */ + + { + Interp *iPtr = (Interp *) interp; + int isRootEnsemble; + Tcl_Obj *copyObj; + + /* + * Get the prefix that we're rewriting to. To do this we need to + * ensure that the internal representation of the list does not change + * so that we can safely keep the internal representations of the + * elements in the list. + */ + + copyObj = TclListObjCopy(NULL, prefixObj); + TclListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv); + + /* + * Record what arguments the script sent in so that things like + * Tcl_WrongNumArgs can give the correct error message. + */ + + isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL); + if (isRootEnsemble) { + iPtr->ensembleRewrite.sourceObjs = objv; + iPtr->ensembleRewrite.numRemovedObjs = 2; + iPtr->ensembleRewrite.numInsertedObjs = prefixObjc; + } else { + int ni = iPtr->ensembleRewrite.numInsertedObjs; + + if (ni < 2) { + iPtr->ensembleRewrite.numRemovedObjs += 2 - ni; + iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-1; + } else { + iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-2; + } + } + + /* + * Allocate a workspace and build the list of arguments to pass to the + * target command in it. + */ + + tempObjv = (Tcl_Obj **) TclStackAlloc(interp, + (int) sizeof(Tcl_Obj *) * (objc - 2 + prefixObjc)); + memcpy(tempObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc); + memcpy(tempObjv+prefixObjc, objv+2, sizeof(Tcl_Obj *) * (objc-2)); + + /* + * Hand off to the target command. + */ + + result = Tcl_EvalObjv(interp, objc-2+prefixObjc, tempObjv, + TCL_EVAL_INVOKE); + + /* + * Clean up. + */ + + TclStackFree(interp, tempObjv); + Tcl_DecrRefCount(copyObj); + if (isRootEnsemble) { + iPtr->ensembleRewrite.sourceObjs = NULL; + iPtr->ensembleRewrite.numRemovedObjs = 0; + iPtr->ensembleRewrite.numInsertedObjs = 0; + } + } + Tcl_DecrRefCount(prefixObj); + return result; unknownOrAmbiguousSubcommand: /* @@ -6136,6 +6195,8 @@ NsEnsembleImplementationCmd( } if (!Tcl_InterpDeleted(interp)) { if (result != TCL_ERROR) { + char buf[TCL_INTEGER_SPACE]; + Tcl_ResetResult(interp); Tcl_SetResult(interp, "unknown subcommand handler returned bad code: ", @@ -6150,19 +6211,16 @@ NsEnsembleImplementationCmd( case TCL_CONTINUE: Tcl_AppendResult(interp, "continue", NULL); break; - default: { - char buf[TCL_INTEGER_SPACE]; - + default: sprintf(buf, "%d", result); Tcl_AppendResult(interp, buf, NULL); } - } Tcl_AddErrorInfo(interp, "\n result of " "ensemble unknown subcommand handler: "); Tcl_AddErrorInfo(interp, TclGetString(unknownCmd)); } else { - Tcl_AddErrorInfo(interp, "\n (ensemble unknown " - "subcommand handler)"); + Tcl_AddErrorInfo(interp, + "\n (ensemble unknown subcommand handler)"); } } Tcl_DecrRefCount(unknownCmd); @@ -6171,17 +6229,21 @@ NsEnsembleImplementationCmd( } /* - * Cannot determine what subcommand to hand off to, so generate a + * We cannot determine what subcommand to hand off to, so generate a * (standard) failure message. Note the one odd case compared with * standard ensemble-like command, which is where a namespace has no * exported commands at all... */ Tcl_ResetResult(interp); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE", + TclGetString(objv[1]), NULL); if (ensemblePtr->subcommandTable.numEntries == 0) { Tcl_AppendResult(interp, "unknown subcommand \"",TclGetString(objv[1]), "\": namespace ", ensemblePtr->nsPtr->fullName, " does not export any commands", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND", + TclGetString(objv[1]), NULL); return TCL_ERROR; } Tcl_AppendResult(interp, "unknown ", @@ -6191,6 +6253,7 @@ NsEnsembleImplementationCmd( Tcl_AppendResult(interp, ensemblePtr->subcommandArrayPtr[0], NULL); } else { int i; + for (i=0 ; i<ensemblePtr->subcommandTable.numEntries-1 ; i++) { Tcl_AppendResult(interp, ensemblePtr->subcommandArrayPtr[i], ", ", NULL); @@ -6198,6 +6261,8 @@ NsEnsembleImplementationCmd( Tcl_AppendResult(interp, "or ", ensemblePtr->subcommandArrayPtr[i], NULL); } + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND", + TclGetString(objv[1]), NULL); return TCL_ERROR; } @@ -6231,7 +6296,7 @@ MakeCachedEnsembleCommand( int length; if (objPtr->typePtr == &tclEnsembleCmdType) { - ensembleCmd = (EnsembleCmdRep *) objPtr->internalRep.otherValuePtr; + ensembleCmd = objPtr->internalRep.otherValuePtr; Tcl_DecrRefCount(ensembleCmd->realPrefixObj); ensembleCmd->nsPtr->refCount--; if ((ensembleCmd->nsPtr->refCount == 0) @@ -6247,7 +6312,7 @@ MakeCachedEnsembleCommand( TclFreeIntRep(objPtr); ensembleCmd = (EnsembleCmdRep *) ckalloc(sizeof(EnsembleCmdRep)); - objPtr->internalRep.otherValuePtr = (void *) ensembleCmd; + objPtr->internalRep.otherValuePtr = ensembleCmd; objPtr->typePtr = &tclEnsembleCmdType; } @@ -6290,7 +6355,7 @@ static void DeleteEnsembleConfig( ClientData clientData) { - EnsembleConfig *ensemblePtr = (EnsembleConfig *)clientData; + EnsembleConfig *ensemblePtr = clientData; Namespace *nsPtr = ensemblePtr->nsPtr; Tcl_HashSearch search; Tcl_HashEntry *hEnt; @@ -6331,7 +6396,8 @@ DeleteEnsembleConfig( } hEnt = Tcl_FirstHashEntry(&ensemblePtr->subcommandTable, &search); while (hEnt != NULL) { - Tcl_Obj *prefixObj = (Tcl_Obj *) Tcl_GetHashValue(hEnt); + Tcl_Obj *prefixObj = Tcl_GetHashValue(hEnt); + Tcl_DecrRefCount(prefixObj); hEnt = Tcl_NextHashEntry(&search); } @@ -6353,7 +6419,7 @@ DeleteEnsembleConfig( * (especially the unknown callback.) */ - Tcl_EventuallyFree((ClientData) ensemblePtr, TCL_DYNAMIC); + Tcl_EventuallyFree(ensemblePtr, TCL_DYNAMIC); } /* @@ -6399,7 +6465,7 @@ BuildEnsembleConfig( ckfree((char *) ensemblePtr->subcommandArrayPtr); hPtr = Tcl_FirstHashEntry(hash, &search); while (hPtr != NULL) { - Tcl_Obj *prefixObj = (Tcl_Obj *) Tcl_GetHashValue(hPtr); + Tcl_Obj *prefixObj = Tcl_GetHashValue(hPtr); Tcl_DecrRefCount(prefixObj); hPtr = Tcl_NextHashEntry(&search); } @@ -6440,7 +6506,7 @@ BuildEnsembleConfig( Tcl_DictObjGet(NULL, ensemblePtr->subcommandDict, subcmdv[i], &target); if (target != NULL) { - Tcl_SetHashValue(hPtr, (ClientData) target); + Tcl_SetHashValue(hPtr, target); Tcl_IncrRefCount(target); continue; } @@ -6459,7 +6525,7 @@ BuildEnsembleConfig( Tcl_AppendStringsToObj(cmdObj, name, NULL); } cmdPrefixObj = Tcl_NewListObj(1, &cmdObj); - Tcl_SetHashValue(hPtr, (ClientData) cmdPrefixObj); + Tcl_SetHashValue(hPtr, cmdPrefixObj); Tcl_IncrRefCount(cmdPrefixObj); } } else if (ensemblePtr->subcommandDict != NULL) { @@ -6479,7 +6545,7 @@ BuildEnsembleConfig( char *name = TclGetString(keyObj); hPtr = Tcl_CreateHashEntry(hash, name, &isNew); - Tcl_SetHashValue(hPtr, (ClientData) valueObj); + Tcl_SetHashValue(hPtr, valueObj); Tcl_IncrRefCount(valueObj); Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done); } @@ -6524,7 +6590,7 @@ BuildEnsembleConfig( (ensemblePtr->nsPtr->parentPtr ? "::" : ""), nsCmdName, NULL); cmdPrefixObj = Tcl_NewListObj(1, &cmdObj); - Tcl_SetHashValue(hPtr, (ClientData) cmdPrefixObj); + Tcl_SetHashValue(hPtr, cmdPrefixObj); Tcl_IncrRefCount(cmdPrefixObj); } break; @@ -6638,8 +6704,7 @@ static void FreeEnsembleCmdRep( Tcl_Obj *objPtr) { - EnsembleCmdRep *ensembleCmd = (EnsembleCmdRep *) - objPtr->internalRep.otherValuePtr; + EnsembleCmdRep *ensembleCmd = objPtr->internalRep.otherValuePtr; Tcl_DecrRefCount(ensembleCmd->realPrefixObj); ckfree(ensembleCmd->fullSubcmdName); @@ -6674,14 +6739,13 @@ DupEnsembleCmdRep( Tcl_Obj *objPtr, Tcl_Obj *copyPtr) { - EnsembleCmdRep *ensembleCmd = (EnsembleCmdRep *) - objPtr->internalRep.otherValuePtr; + EnsembleCmdRep *ensembleCmd = objPtr->internalRep.otherValuePtr; EnsembleCmdRep *ensembleCopy = (EnsembleCmdRep *) ckalloc(sizeof(EnsembleCmdRep)); int length = strlen(ensembleCmd->fullSubcmdName); copyPtr->typePtr = &tclEnsembleCmdType; - copyPtr->internalRep.otherValuePtr = (void *) ensembleCopy; + copyPtr->internalRep.otherValuePtr = ensembleCopy; ensembleCopy->nsPtr = ensembleCmd->nsPtr; ensembleCopy->epoch = ensembleCmd->epoch; ensembleCopy->token = ensembleCmd->token; @@ -6714,8 +6778,7 @@ static void StringOfEnsembleCmdRep( Tcl_Obj *objPtr) { - EnsembleCmdRep *ensembleCmd = (EnsembleCmdRep *) - objPtr->internalRep.otherValuePtr; + EnsembleCmdRep *ensembleCmd = objPtr->internalRep.otherValuePtr; int length = strlen(ensembleCmd->fullSubcmdName); objPtr->length = length; @@ -6794,7 +6857,7 @@ Tcl_LogCommandInfo( } else { Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); - VarTrace *tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr); + VarTrace *tracePtr = Tcl_GetHashValue(hPtr); if (tracePtr->traceProc != EstablishErrorInfoTraces) { /* @@ -6806,8 +6869,8 @@ Tcl_LogCommandInfo( * write the current -errorinfo value to the ::errorInfo variable. */ - Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL, - iPtr->errorInfo, TCL_GLOBAL_ONLY); + Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL, iPtr->errorInfo, + TCL_GLOBAL_ONLY); } } } diff --git a/generic/tclParse.c b/generic/tclParse.c index 4eade27..8c1e248 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclParse.c,v 1.52.2.6 2007/11/12 19:18:20 dgp Exp $ + * RCS: @(#) $Id: tclParse.c,v 1.52.2.7 2007/11/21 06:30:54 dgp Exp $ */ #include "tclInt.h" @@ -54,7 +54,7 @@ #define CHAR_TYPE(c) (charTypeTable+128)[(int)(c)] -static CONST char charTypeTable[] = { +static const char charTypeTable[] = { /* * Negative character values, from -128 to -1: */ @@ -171,12 +171,12 @@ static CONST char charTypeTable[] = { * Prototypes for local functions defined in this file: */ -static int CommandComplete(CONST char *script, int numBytes); -static int ParseComment(CONST char *src, int numBytes, +static inline int CommandComplete(const char *script, int numBytes); +static int ParseComment(const char *src, int numBytes, Tcl_Parse *parsePtr); -static int ParseTokens(CONST char *src, int numBytes, int mask, +static int ParseTokens(const char *src, int numBytes, int mask, int flags, Tcl_Parse *parsePtr); -static int ParseWhiteSpace(CONST char *src, int numBytes, +static int ParseWhiteSpace(const char *src, int numBytes, int *incompletePtr, char *typePtr); /* @@ -198,7 +198,7 @@ static int ParseWhiteSpace(CONST char *src, int numBytes, void TclParseInit( Tcl_Interp *interp, /* Interpreter to use for error reporting */ - CONST char *string, /* String to be parsed. */ + const char *string, /* String to be parsed. */ int numBytes, /* Total number of bytes in string. If < 0, * the script consists of all bytes up to the * first null character. */ @@ -243,7 +243,7 @@ int Tcl_ParseCommand( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ - CONST char *start, /* First character of string containing one or + const char *start, /* First character of string containing one or * more Tcl commands. */ register int numBytes, /* Total number of bytes in string. If < 0, * the script consists of all bytes up to the @@ -257,14 +257,14 @@ Tcl_ParseCommand( * the parsed command; any previous * information in the structure is ignored. */ { - register CONST char *src; /* Points to current character in the + register const char *src; /* Points to current character in the * command. */ char type; /* Result returned by CHAR_TYPE(*src). */ Tcl_Token *tokenPtr; /* Pointer to token being filled in. */ int wordIndex; /* Index of word token for current word. */ int terminators; /* CHAR_TYPE bits that indicate the end of a * command. */ - CONST char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to + const char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to * point to char after terminating one. */ int scanned; @@ -327,7 +327,7 @@ Tcl_ParseCommand( * sequence: it should be treated just like white space. */ - scanned = ParseWhiteSpace(src, numBytes, &(parsePtr->incomplete), &type); + scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type); src += scanned; numBytes -= scanned; if (numBytes == 0) { @@ -351,8 +351,8 @@ Tcl_ParseCommand( parseWord: if (*src == '"') { - if (Tcl_ParseQuotedString(interp, src, numBytes, - parsePtr, 1, &termPtr) != TCL_OK) { + if (Tcl_ParseQuotedString(interp, src, numBytes, parsePtr, 1, + &termPtr) != TCL_OK) { goto error; } src = termPtr; @@ -361,33 +361,31 @@ Tcl_ParseCommand( int expIdx = wordIndex + 1; Tcl_Token *expPtr; - if (Tcl_ParseBraces(interp, src, numBytes, - parsePtr, 1, &termPtr) != TCL_OK) { + if (Tcl_ParseBraces(interp, src, numBytes, parsePtr, 1, + &termPtr) != TCL_OK) { goto error; } src = termPtr; numBytes = parsePtr->end - src; /* - * Check whether the braces contained the word expansion prefix {*} + * Check whether the braces contained the word expansion prefix + * {*} */ expPtr = &parsePtr->tokenPtr[expIdx]; - if ( - (0 == expandWord) - /* Haven't seen prefix already */ - && (1 == parsePtr->numTokens - expIdx) - /* Only one token */ - && (((1 == (size_t) expPtr->size) + if ((0 == expandWord) + /* Haven't seen prefix already */ + && (1 == parsePtr->numTokens - expIdx) + /* Only one token */ + && (((1 == (size_t) expPtr->size) /* Same length as prefix */ - && (expPtr->start[0] == '*')) - ) - /* Is the prefix */ - && (numBytes > 0) && (0 == - ParseWhiteSpace(termPtr, numBytes, &(parsePtr->incomplete), &type)) - && (type != TYPE_COMMAND_END) - /* Non-whitespace follows */ - ) { + && (expPtr->start[0] == '*'))) + /* Is the prefix */ + && (numBytes > 0) && (0 == ParseWhiteSpace(termPtr, + numBytes, &parsePtr->incomplete, &type)) + && (type != TYPE_COMMAND_END) + /* Non-whitespace follows */) { expandWord = 1; parsePtr->numTokens--; goto parseWord; @@ -417,12 +415,12 @@ Tcl_ParseCommand( if (expandWord) { int i, isLiteral = 1; - /* - * When a command includes a word that is an expanded literal; - * for example, {*}{1 2 3}, the parser performs that expansion + /* + * When a command includes a word that is an expanded literal; for + * example, {*}{1 2 3}, the parser performs that expansion * immediately, generating several TCL_TOKEN_SIMPLE_WORDs instead * of a single TCL_TOKEN_EXPAND_WORD that the Tcl_ParseCommand() - * caller might have to expand. This notably makes it simpler for + * caller might have to expand. This notably makes it simpler for * those callers that wish to track line endings, such as those * that implement key parts of TIP 280. * @@ -442,12 +440,12 @@ Tcl_ParseCommand( int elemCount = 0, code = TCL_OK; const char *nextElem, *listEnd, *elemStart; - /* + /* * The word to be expanded is a literal, so determine the * boundaries of the literal string to be treated as a list - * and expanded. That literal string starts at - * tokenPtr[1].start, and includes all bytes up to, but - * not including (tokenPtr[tokenPtr->numComponents].start + + * and expanded. That literal string starts at + * tokenPtr[1].start, and includes all bytes up to, but not + * including (tokenPtr[tokenPtr->numComponents].start + * tokenPtr[tokenPtr->numComponents].size) */ @@ -455,11 +453,11 @@ Tcl_ParseCommand( tokenPtr[tokenPtr->numComponents].size); nextElem = tokenPtr[1].start; - /* - * Step through the literal string, parsing and counting - * list elements. + /* + * Step through the literal string, parsing and counting list + * elements. */ - + while (nextElem < listEnd) { code = TclFindElement(NULL, nextElem, listEnd - nextElem, &elemStart, &nextElem, NULL, NULL); @@ -470,29 +468,26 @@ Tcl_ParseCommand( } if (code != TCL_OK) { - /* - * Some list element could not be parsed. This means - * the literal string was not in fact a valid list. - * Defer the handling of this to compile/eval time, where - * code is already in place to report the "attempt to - * expand a non-list" error. + * Some list element could not be parsed. This means the + * literal string was not in fact a valid list. Defer the + * handling of this to compile/eval time, where code is + * already in place to report the "attempt to expand a + * non-list" error. */ tokenPtr->type = TCL_TOKEN_EXPAND_WORD; } else if (elemCount == 0) { - /* - * We are expanding a literal empty list. This means - * that the expanding word completely disappears, leaving - * no word generated this pass through the loop. Adjust + * We are expanding a literal empty list. This means that + * the expanding word completely disappears, leaving no + * word generated this pass through the loop. Adjust * accounting appropriately. */ parsePtr->numWords--; parsePtr->numTokens = wordIndex; } else { - /* * Recalculate the number of Tcl_Tokens needed to store * tokens representing the expanded list. @@ -508,9 +503,9 @@ Tcl_ParseCommand( /* * Generate a TCL_TOKEN_SIMPLE_WORD token sequence for * each element of the literal list we are expanding in - * place. Take care with the start and size fields of - * each token so they point to the right literal characters - * in the original script to represent the right expanded + * place. Take care with the start and size fields of each + * token so they point to the right literal characters in + * the original script to represent the right expanded * word value. */ @@ -542,8 +537,7 @@ Tcl_ParseCommand( } } } else { - - /* + /* * The word to be expanded is not a literal, so defer * expansion to compile/eval time by marking with a * TCL_TOKEN_EXPAND_WORD token. @@ -562,7 +556,7 @@ Tcl_ParseCommand( * word), and (b) check for the end of the command. */ - scanned = ParseWhiteSpace(src, numBytes, &(parsePtr->incomplete), &type); + scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type); if (scanned) { src += scanned; numBytes -= scanned; @@ -626,7 +620,7 @@ Tcl_ParseCommand( static int ParseWhiteSpace( - CONST char *src, /* First character to parse. */ + const char *src, /* First character to parse. */ register int numBytes, /* Max number of bytes to scan. */ int *incompletePtr, /* Set this boolean memory to true if parsing * indicates an incomplete command. */ @@ -634,7 +628,7 @@ ParseWhiteSpace( * of character that ends run of whitespace */ { register char type = TYPE_NORMAL; - register CONST char *p = src; + register const char *p = src; while (1) { while (numBytes && ((type = CHAR_TYPE(*p)) & TYPE_SPACE)) { @@ -680,12 +674,12 @@ ParseWhiteSpace( int TclParseAllWhiteSpace( - CONST char *src, /* First character to parse. */ + const char *src, /* First character to parse. */ int numBytes) /* Max number of byes to scan */ { int dummy; char type; - CONST char *p = src; + const char *p = src; do { int scanned = ParseWhiteSpace(p, numBytes, &dummy, &type); @@ -720,14 +714,14 @@ TclParseAllWhiteSpace( int TclParseHex( - CONST char *src, /* First character to parse. */ + const char *src, /* First character to parse. */ int numBytes, /* Max number of byes to scan */ Tcl_UniChar *resultPtr) /* Points to storage provided by caller where * the Tcl_UniChar resulting from the * conversion is to be written. */ { Tcl_UniChar result = 0; - register CONST char *p = src; + register const char *p = src; while (numBytes--) { unsigned char digit = UCHAR(*p); @@ -775,7 +769,7 @@ TclParseHex( int TclParseBackslash( - CONST char *src, /* Points to the backslash character of a a + const char *src, /* Points to the backslash character of a a * backslash sequence. */ int numBytes, /* Max number of bytes to scan. */ int *readPtr, /* NULL, or points to storage where the number @@ -785,7 +779,7 @@ TclParseBackslash( * written. At most TCL_UTF_MAX bytes will be * written there. */ { - register CONST char *p = src+1; + register const char *p = src+1; Tcl_UniChar result; int count; char buf[TCL_UTF_MAX]; @@ -948,13 +942,14 @@ TclParseBackslash( static int ParseComment( - CONST char *src, /* First character to parse. */ + const char *src, /* First character to parse. */ register int numBytes, /* Max number of bytes to scan. */ Tcl_Parse *parsePtr) /* Information about parse in progress. * Updated if parsing indicates an incomplete * command. */ { - register CONST char *p = src; + register const char *p = src; + while (numBytes) { char type; int scanned; @@ -972,7 +967,8 @@ ParseComment( while (numBytes) { if (*p == '\\') { - scanned = ParseWhiteSpace(p, numBytes, &(parsePtr->incomplete), &type); + scanned = ParseWhiteSpace(p, numBytes, &parsePtr->incomplete, + &type); if (scanned) { p += scanned; numBytes -= scanned; @@ -1028,7 +1024,7 @@ ParseComment( static int ParseTokens( - register CONST char *src, /* First character to parse. */ + register const char *src, /* First character to parse. */ register int numBytes, /* Max number of bytes to scan. */ int mask, /* Specifies when to stop parsing. The parse * stops at the first unquoted character whose @@ -1094,8 +1090,8 @@ ParseTokens( */ varToken = parsePtr->numTokens; - if (Tcl_ParseVarName(parsePtr->interp, src, numBytes, - parsePtr, 1) != TCL_OK) { + if (Tcl_ParseVarName(parsePtr->interp, src, numBytes, parsePtr, + 1) != TCL_OK) { return TCL_ERROR; } src += parsePtr->tokenPtr[varToken].size; @@ -1123,8 +1119,8 @@ ParseTokens( nestedPtr = (Tcl_Parse *) TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse)); while (1) { - if (Tcl_ParseCommand(parsePtr->interp, src, - numBytes, 1, nestedPtr) != TCL_OK) { + if (Tcl_ParseCommand(parsePtr->interp, src, numBytes, 1, + nestedPtr) != TCL_OK) { parsePtr->errorType = nestedPtr->errorType; parsePtr->term = nestedPtr->term; parsePtr->incomplete = nestedPtr->incomplete; @@ -1141,7 +1137,8 @@ ParseTokens( * parsed command. */ - if ((nestedPtr->term < parsePtr->end) && (*(nestedPtr->term) == ']') + if ((nestedPtr->term < parsePtr->end) + && (*(nestedPtr->term) == ']') && !(nestedPtr->incomplete)) { break; } @@ -1300,13 +1297,14 @@ TclExpandTokenArray( int newCount = parsePtr->tokensAvailable*2; if (parsePtr->tokenPtr != parsePtr->staticTokens) { - parsePtr->tokenPtr = (Tcl_Token *) ckrealloc ((char *) - (parsePtr->tokenPtr), newCount * sizeof(Tcl_Token)); + parsePtr->tokenPtr = (Tcl_Token *) ckrealloc((char *) + parsePtr->tokenPtr, newCount * sizeof(Tcl_Token)); } else { - Tcl_Token *newPtr = (Tcl_Token *) ckalloc( - newCount * sizeof(Tcl_Token)); + Tcl_Token *newPtr = (Tcl_Token *) + ckalloc(newCount * sizeof(Tcl_Token)); + memcpy(newPtr, parsePtr->tokenPtr, - (size_t) (parsePtr->tokensAvailable * sizeof(Tcl_Token))); + (size_t) parsePtr->tokensAvailable * sizeof(Tcl_Token)); parsePtr->tokenPtr = newPtr; } parsePtr->tokensAvailable = newCount; @@ -1343,7 +1341,7 @@ int Tcl_ParseVarName( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ - CONST char *start, /* Start of variable substitution string. + const char *start, /* Start of variable substitution string. * First character must be "$". */ register int numBytes, /* Total number of bytes in string. If < 0, * the string consists of all bytes up to the @@ -1356,7 +1354,7 @@ Tcl_ParseVarName( * reinitialize it. */ { Tcl_Token *tokenPtr; - register CONST char *src; + register const char *src; unsigned char c; int varIndex, offset; Tcl_UniChar ch; @@ -1379,7 +1377,7 @@ Tcl_ParseVarName( */ src = start; - if ((parsePtr->numTokens + 2) > parsePtr->tokensAvailable) { + if (parsePtr->numTokens+2 > parsePtr->tokensAvailable) { TclExpandTokenArray(parsePtr); } tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; @@ -1454,7 +1452,7 @@ Tcl_ParseVarName( offset = Tcl_UtfToUniChar(utfBytes, &ch); } c = UCHAR(ch); - if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */ + if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */ src += offset; numBytes -= offset; continue; @@ -1492,7 +1490,7 @@ Tcl_ParseVarName( TCL_SUBST_ALL, parsePtr)) { goto error; } - if ((parsePtr->term == src+numBytes) || (*parsePtr->term != ')')) { + if ((parsePtr->term == src+numBytes) || (*parsePtr->term != ')')){ if (parsePtr->interp != NULL) { Tcl_SetResult(parsePtr->interp, "missing )", TCL_STATIC); @@ -1549,18 +1547,19 @@ Tcl_ParseVarName( *---------------------------------------------------------------------- */ -CONST char * +const char * Tcl_ParseVar( - Tcl_Interp *interp, /* Context for looking up variable. */ - register CONST char *start, /* Start of variable substitution. - * First character must be "$". */ - CONST char **termPtr) /* If non-NULL, points to word to fill - * in with character just after last - * one in the variable specifier. */ + Tcl_Interp *interp, /* Context for looking up variable. */ + register const char *start, /* Start of variable substitution. First + * character must be "$". */ + const char **termPtr) /* If non-NULL, points to word to fill in with + * character just after last one in the + * variable specifier. */ { register Tcl_Obj *objPtr; int code; - Tcl_Parse *parsePtr = (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse)); + Tcl_Parse *parsePtr = (Tcl_Parse *) + TclStackAlloc(interp, sizeof(Tcl_Parse)); if (Tcl_ParseVarName(interp, start, -1, parsePtr, 0) != TCL_OK) { TclStackFree(interp, parsePtr); @@ -1579,7 +1578,8 @@ Tcl_ParseVar( return "$"; } - code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens, NULL, 1); + code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens, + NULL, 1); TclStackFree(interp, parsePtr); if (code != TCL_OK) { return NULL; @@ -1636,7 +1636,7 @@ int Tcl_ParseBraces( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ - CONST char *start, /* Start of string enclosed in braces. The + const char *start, /* Start of string enclosed in braces. The * first character must be {'. */ register int numBytes, /* Total number of bytes in string. If < 0, * the string consists of all bytes up to the @@ -1648,13 +1648,13 @@ Tcl_ParseBraces( * information in parsePtr; zero means ignore * existing tokens in parsePtr and * reinitialize it. */ - CONST char **termPtr) /* If non-NULL, points to word in which to + const char **termPtr) /* If non-NULL, points to word in which to * store a pointer to the character just after * the terminating '}' if the parse was * successful. */ { Tcl_Token *tokenPtr; - register CONST char *src; + register const char *src; int startIndex, level, length; if ((numBytes == 0) || (start == NULL)) { @@ -1794,10 +1794,9 @@ Tcl_ParseBraces( openBrace = 0; break; case '#' : - if (openBrace && (isspace(UCHAR(src[-1])))) { + if (openBrace && isspace(UCHAR(src[-1]))) { Tcl_AppendResult(parsePtr->interp, - ": possible unbalanced brace in comment", - (char *) NULL); + ": possible unbalanced brace in comment", NULL); goto error; } break; @@ -1842,7 +1841,7 @@ int Tcl_ParseQuotedString( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ - CONST char *start, /* Start of the quoted string. The first + const char *start, /* Start of the quoted string. The first * character must be '"'. */ register int numBytes, /* Total number of bytes in string. If < 0, * the string consists of all bytes up to the @@ -1854,7 +1853,7 @@ Tcl_ParseQuotedString( * information in parsePtr; zero means ignore * existing tokens in parsePtr and * reinitialize it. */ - CONST char **termPtr) /* If non-NULL, points to word in which to + const char **termPtr) /* If non-NULL, points to word in which to * store a pointer to the character just after * the quoted string's terminating close-quote * if the parse succeeds. */ @@ -1870,8 +1869,8 @@ Tcl_ParseQuotedString( TclParseInit(interp, start, numBytes, parsePtr); } - if (TCL_OK != ParseTokens(start+1, numBytes-1, TYPE_QUOTE, - TCL_SUBST_ALL, parsePtr)) { + if (TCL_OK != ParseTokens(start+1, numBytes-1, TYPE_QUOTE, TCL_SUBST_ALL, + parsePtr)) { goto error; } if (*parsePtr->term != '"') { @@ -1919,10 +1918,10 @@ Tcl_SubstObj( { int length, tokensLeft, code; Tcl_Token *endTokenPtr; - Tcl_Obj *result; - Tcl_Obj *errMsg = NULL; + Tcl_Obj *result, *errMsg = NULL; CONST char *p = TclGetStringFromObj(objPtr, &length); - Tcl_Parse *parsePtr = (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse)); + Tcl_Parse *parsePtr = (Tcl_Parse *) + TclStackAlloc(interp, sizeof(Tcl_Parse)); TclParseInit(interp, p, length, parsePtr); @@ -2036,9 +2035,9 @@ Tcl_SubstObj( */ Tcl_Token *tokenPtr; - CONST char *lastTerm = parsePtr->term; - Tcl_Parse *nestedPtr = - (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse)); + const char *lastTerm = parsePtr->term; + Tcl_Parse *nestedPtr = (Tcl_Parse *) + TclStackAlloc(interp, sizeof(Tcl_Parse)); while (TCL_OK == Tcl_ParseCommand(NULL, p, length, 0, nestedPtr)) { @@ -2178,7 +2177,7 @@ TclSubstTokens( int *tokensLeftPtr, /* If not NULL, points to memory where an * integer representing the number of tokens * left to be substituted will be written */ - int line) /* The line the script starts on. */ + int line) /* The line the script starts on. */ { Tcl_Obj *result; int code = TCL_OK; @@ -2196,7 +2195,7 @@ TclSubstTokens( result = NULL; for (; count>0 && code==TCL_OK ; count--, tokenPtr++) { Tcl_Obj *appendObj = NULL; - CONST char *append = NULL; + const char *append = NULL; int appendByteLength = 0; char utfCharBytes[TCL_UTF_MAX]; @@ -2207,7 +2206,7 @@ TclSubstTokens( break; case TCL_TOKEN_BS: - appendByteLength = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL, + appendByteLength = Tcl_UtfBackslash(tokenPtr->start, NULL, utfCharBytes); append = utfCharBytes; break; @@ -2354,19 +2353,18 @@ TclSubstTokens( *---------------------------------------------------------------------- */ -static int +static inline int CommandComplete( - CONST char *script, /* Script to check. */ + const char *script, /* Script to check. */ int numBytes) /* Number of bytes in script. */ { Tcl_Parse parse; - CONST char *p, *end; + const char *p, *end; int result; p = script; end = p + numBytes; - while (Tcl_ParseCommand((Tcl_Interp *) NULL, p, end - p, 0, &parse) - == TCL_OK) { + while (Tcl_ParseCommand(NULL, p, end - p, 0, &parse) == TCL_OK) { p = parse.commandStart + parse.commandSize; if (p >= end) { break; @@ -2404,7 +2402,7 @@ CommandComplete( int Tcl_CommandComplete( - CONST char *script) /* Script to check. */ + const char *script) /* Script to check. */ { return CommandComplete(script, (int) strlen(script)); } @@ -2432,10 +2430,9 @@ TclObjCommandComplete( Tcl_Obj *objPtr) /* Points to object holding script to * check. */ { - CONST char *script; int length; + const char *script = Tcl_GetStringFromObj(objPtr, &length); - script = TclGetStringFromObj(objPtr, &length); return CommandComplete(script, length); } @@ -2458,11 +2455,11 @@ TclObjCommandComplete( int TclIsLocalScalar( - CONST char *src, + const char *src, int len) { - CONST char *p; - CONST char *lastChar = src + (len - 1); + const char *p; + const char *lastChar = src + (len - 1); for (p=src ; p<=lastChar ; p++) { if ((CHAR_TYPE(*p) != TYPE_NORMAL) && @@ -2476,11 +2473,11 @@ TclIsLocalScalar( return 0; } if (*p == '(') { - if (*lastChar == ')') { /* we have an array element */ + if (*lastChar == ')') { /* We have an array element */ return 0; } } else if (*p == ':') { - if ((p != lastChar) && *(p+1) == ':') { /* qualified name */ + if ((p != lastChar) && *(p+1) == ':') { /* qualified name */ return 0; } } diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index b86c728..73f4b0d 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclPathObj.c,v 1.63 2007/05/02 21:30:36 kennykb Exp $ + * RCS: @(#) $Id: tclPathObj.c,v 1.63.2.1 2007/11/21 06:30:54 dgp Exp $ */ #include "tclInt.h" @@ -20,13 +20,14 @@ * Prototypes for functions defined later in this file. */ -static void DupFsPathInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); -static void FreeFsPathInternalRep(Tcl_Obj *pathPtr); -static void UpdateStringOfFsPath(Tcl_Obj *pathPtr); -static int SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr); -static int FindSplitPos(const char *path, int separator); -static int IsSeparatorOrNull(int ch); -static Tcl_Obj* GetExtension(Tcl_Obj *pathPtr); +static void DupFsPathInternalRep(Tcl_Obj *srcPtr, + Tcl_Obj *copyPtr); +static void FreeFsPathInternalRep(Tcl_Obj *pathPtr); +static void UpdateStringOfFsPath(Tcl_Obj *pathPtr); +static int SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr); +static int FindSplitPos(const char *path, int separator); +static int IsSeparatorOrNull(int ch); +static Tcl_Obj * GetExtension(Tcl_Obj *pathPtr); /* * Define the 'path' object type, which Tcl uses to represent file paths @@ -108,9 +109,10 @@ typedef struct FsPath { * fields. */ -#define PATHOBJ(pathPtr) (pathPtr->internalRep.otherValuePtr) -#define PATHFLAGS(pathPtr) \ - (((FsPath*)(pathPtr->internalRep.otherValuePtr))->flags) +#define PATHOBJ(pathPtr) ((FsPath *) (pathPtr)->internalRep.otherValuePtr) +#define SETPATHOBJ(pathPtr,fsPathPtr) \ + ((pathPtr)->internalRep.otherValuePtr = (VOID *) (fsPathPtr)) +#define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags) /* *--------------------------------------------------------------------------- @@ -172,7 +174,7 @@ TclFSNormalizeAbsolutePath( && (dirSep[3] == '/' || dirSep[3] == '\\')) { /* NT extended path */ dirSep += 4; - + if ( (dirSep[0] == 'U' || dirSep[0] == 'u') && (dirSep[1] == 'N' || dirSep[1] == 'n') && (dirSep[2] == 'C' || dirSep[2] == 'c') @@ -351,7 +353,7 @@ TclFSNormalizeAbsolutePath( if ((curLen == 0) && (dirSep[0] != 0)) { Tcl_SetObjLength(retVal, 0); } - + if (dirSep[0] != 0 && dirSep[1] == '.') { goto again; } @@ -493,23 +495,24 @@ TclFSGetPathType( Tcl_Filesystem **filesystemPtrPtr, int *driveNameLengthPtr) { + FsPath *fsPathPtr; + if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) { - return TclGetPathType(pathPtr, filesystemPtrPtr, - driveNameLengthPtr, NULL); - } else { - FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathPtr); + return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, + NULL); + } - if (fsPathPtr->cwdPtr != NULL) { - if (PATHFLAGS(pathPtr) == 0) { - return TCL_PATH_RELATIVE; - } - return TclFSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr, - driveNameLengthPtr); - } else { - return TclGetPathType(pathPtr, filesystemPtrPtr, - driveNameLengthPtr, NULL); - } + fsPathPtr = PATHOBJ(pathPtr); + if (fsPathPtr->cwdPtr == NULL) { + return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, + NULL); } + + if (PATHFLAGS(pathPtr) == 0) { + return TCL_PATH_RELATIVE; + } + return TclFSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr, + driveNameLengthPtr); } /* @@ -550,7 +553,8 @@ TclPathPart( Tcl_PathPart portion) /* Requested portion of name */ { if (pathPtr->typePtr == &tclFsPathType) { - FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathPtr); + FsPath *fsPathPtr = PATHOBJ(pathPtr); + if (TclFSEpochOk(fsPathPtr->filesystemEpoch) && (PATHFLAGS(pathPtr) != 0)) { switch (portion) { @@ -627,7 +631,7 @@ TclPathPart( Tcl_Obj *root = Tcl_DuplicateObj(pathPtr); Tcl_IncrRefCount(root); - fsDupPtr = (FsPath*) PATHOBJ(root); + fsDupPtr = PATHOBJ(root); if (Tcl_IsShared(fsDupPtr->normPathPtr)) { TclDecrRefCount(fsDupPtr->normPathPtr); fsDupPtr->normPathPtr = Tcl_NewStringObj(fileName, @@ -664,8 +668,7 @@ TclPathPart( } } else { int splitElements; - Tcl_Obj *splitPtr; - Tcl_Obj *resultPtr; + Tcl_Obj *splitPtr, *resultPtr; standardPath: resultPtr = NULL; @@ -836,16 +839,10 @@ Tcl_FSJoinPath( res = NULL; for (i = 0; i < elements; i++) { - Tcl_Obj *elt; - int driveNameLength; + Tcl_Obj *elt, *driveName = NULL; + int driveNameLength, strEltLen, length; Tcl_PathType type; - char *strElt; - int strEltLen; - int length; - char *ptr; - Tcl_Obj *driveName; - - driveName = NULL; + char *strElt, *ptr; Tcl_ListObjIndex(NULL, listObj, i, &elt); @@ -919,10 +916,8 @@ Tcl_FSJoinPath( } return tail; } else { - const char *str; - int len; + const char *str = Tcl_GetString(tail); - str = Tcl_GetStringFromObj(tail, &len); if (tclPlatform == TCL_PLATFORM_WINDOWS) { if (strchr(str, '\\') == NULL) { if (res != NULL) { @@ -1018,7 +1013,6 @@ Tcl_FSJoinPath( */ noQuickReturn: - if (res == NULL) { res = Tcl_NewObj(); ptr = Tcl_GetStringFromObj(res, &length); @@ -1054,6 +1048,7 @@ Tcl_FSJoinPath( if (fsPtr->filesystemSeparatorProc != NULL) { Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(res); + if (sep != NULL) { separator = TclGetString(sep)[0]; } @@ -1130,40 +1125,40 @@ Tcl_FSConvertToPathType( */ if (pathPtr->typePtr == &tclFsPathType) { - FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathPtr); - if (!TclFSEpochOk(fsPathPtr->filesystemEpoch)) { - if (pathPtr->bytes == NULL) { - UpdateStringOfFsPath(pathPtr); - } - FreeFsPathInternalRep(pathPtr); - pathPtr->typePtr = NULL; - return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); + if (TclFSEpochOk(PATHOBJ(pathPtr)->filesystemEpoch)) { + return TCL_OK; } - return TCL_OK; - /* - * We used to have more complex code here: - * - * if (fsPathPtr->cwdPtr == NULL || PATHFLAGS(pathPtr) != 0) { - * return TCL_OK; - * } else { - * if (TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) { - * return TCL_OK; - * } else { - * if (pathPtr->bytes == NULL) { - * UpdateStringOfFsPath(pathPtr); - * } - * FreeFsPathInternalRep(pathPtr); - * pathPtr->typePtr = NULL; - * return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); - * } - * } - * - * But we no longer believe this is necessary. - */ - } else { - return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); + if (pathPtr->bytes == NULL) { + UpdateStringOfFsPath(pathPtr); + } + FreeFsPathInternalRep(pathPtr); + pathPtr->typePtr = NULL; } + + return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); + + /* + * We used to have more complex code here: + * + * FsPath *fsPathPtr = PATHOBJ(pathPtr); + * if (fsPathPtr->cwdPtr == NULL || PATHFLAGS(pathPtr) != 0) { + * return TCL_OK; + * } else { + * if (TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) { + * return TCL_OK; + * } else { + * if (pathPtr->bytes == NULL) { + * UpdateStringOfFsPath(pathPtr); + * } + * FreeFsPathInternalRep(pathPtr); + * pathPtr->typePtr = NULL; + * return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); + * } + * } + * + * But we no longer believe this is necessary. + */ } /* @@ -1255,7 +1250,7 @@ TclNewFSPathObj( tsdPtr = TCL_TSD_INIT(&tclFsDataKey); pathPtr = Tcl_NewObj(); - fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); + fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath)); /* * Set up the path. @@ -1270,7 +1265,7 @@ TclNewFSPathObj( fsPathPtr->fsRecPtr = NULL; fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; - PATHOBJ(pathPtr) = (VOID *) fsPathPtr; + SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = TCLPATH_APPENDED; pathPtr->typePtr = &tclFsPathType; pathPtr->bytes = NULL; @@ -1317,7 +1312,8 @@ TclFSMakePathRelative( ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); if (pathPtr->typePtr == &tclFsPathType) { - FsPath* fsPathPtr = (FsPath*) PATHOBJ(pathPtr); + FsPath *fsPathPtr = PATHOBJ(pathPtr); + if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) { pathPtr = fsPathPtr->normPathPtr; @@ -1332,7 +1328,7 @@ TclFSMakePathRelative( if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "can't find object" - "string representation", (char *) NULL); + "string representation", NULL); } return NULL; } @@ -1355,7 +1351,7 @@ TclFSMakePathRelative( return pathPtr; } - fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); + fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath)); /* * Circular reference, by design. @@ -1369,7 +1365,7 @@ TclFSMakePathRelative( fsPathPtr->fsRecPtr = NULL; fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; - PATHOBJ(pathPtr) = (VOID *) fsPathPtr; + SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; pathPtr->typePtr = &tclFsPathType; @@ -1454,7 +1450,7 @@ TclFSMakePathFromNormalized( if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "can't find object" - "string representation", (char *) NULL); + "string representation", NULL); } return TCL_ERROR; } @@ -1463,7 +1459,7 @@ TclFSMakePathFromNormalized( TclFreeIntRep(pathPtr); } - fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); + fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath)); /* * It's a pure normalized absolute path. @@ -1481,7 +1477,7 @@ TclFSMakePathFromNormalized( fsPathPtr->fsRecPtr = NULL; fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; - PATHOBJ(pathPtr) = (VOID *) fsPathPtr; + SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; pathPtr->typePtr = &tclFsPathType; @@ -1560,7 +1556,7 @@ Tcl_FSNewNativePath( fsPathPtr->fsRecPtr->fileRefCount++; fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; - PATHOBJ(pathPtr) = (VOID *) fsPathPtr; + SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; pathPtr->typePtr = &tclFsPathType; @@ -1597,7 +1593,7 @@ Tcl_FSGetTranslatedPath( if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { return NULL; } - srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); + srcFsPathPtr = PATHOBJ(pathPtr); if (srcFsPathPtr->translatedPathPtr == NULL) { if (PATHFLAGS(pathPtr) != 0) { retObj = Tcl_FSGetNormalizedPath(interp, pathPtr); @@ -1652,12 +1648,10 @@ Tcl_FSGetTranslatedStringPath( if (transPtr != NULL) { int len; - const char* orig; - char *result; + const char *orig = Tcl_GetStringFromObj(transPtr, &len); + char *result = (char *) ckalloc((unsigned) len+1); - orig = Tcl_GetStringFromObj(transPtr, &len); - result = (char *) ckalloc((unsigned)(len+1)); - memcpy(result, orig, (size_t) (len+1)); + memcpy(result, orig, (size_t) len+1); TclDecrRefCount(transPtr); return result; } @@ -1694,7 +1688,7 @@ Tcl_FSGetNormalizedPath( if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { return NULL; } - fsPathPtr = (FsPath*) PATHOBJ(pathPtr); + fsPathPtr = PATHOBJ(pathPtr); if (PATHFLAGS(pathPtr) != 0) { /* @@ -1764,9 +1758,8 @@ Tcl_FSGetNormalizedPath( */ if (pathType == TCL_PATH_RELATIVE) { - FsPath* origDirFsPathPtr; Tcl_Obj *origDir = fsPathPtr->cwdPtr; - origDirFsPathPtr = (FsPath*) PATHOBJ(origDir); + FsPath *origDirFsPathPtr = PATHOBJ(origDir); fsPathPtr->cwdPtr = origDirFsPathPtr->cwdPtr; Tcl_IncrRefCount(fsPathPtr->cwdPtr); @@ -1812,7 +1805,7 @@ Tcl_FSGetNormalizedPath( if (Tcl_ConvertToType(interp, pathPtr, &tclFsPathType) != TCL_OK) { return NULL; } - fsPathPtr = (FsPath*) PATHOBJ(pathPtr); + fsPathPtr = PATHOBJ(pathPtr); } else if (fsPathPtr->normPathPtr == NULL) { int cwdLen; Tcl_Obj *copy; @@ -1995,12 +1988,12 @@ Tcl_FSGetInternalRep( Tcl_Obj *pathPtr, Tcl_Filesystem *fsPtr) { - FsPath* srcFsPathPtr; + FsPath *srcFsPathPtr; if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) { return NULL; } - srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); + srcFsPathPtr = PATHOBJ(pathPtr); /* * We will only return the native representation for the caller's @@ -2035,7 +2028,7 @@ Tcl_FSGetInternalRep( * (e.g. from the Tcl testsuite). */ - srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); + srcFsPathPtr = PATHOBJ(pathPtr); if (srcFsPathPtr->fsRecPtr == NULL) { return NULL; } @@ -2067,7 +2060,7 @@ Tcl_FSGetInternalRep( } nativePathPtr = (*proc)(pathPtr); - srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); + srcFsPathPtr = PATHOBJ(pathPtr); srcFsPathPtr->nativePathPtr = nativePathPtr; } @@ -2097,13 +2090,13 @@ TclFSEnsureEpochOk( Tcl_Obj *pathPtr, Tcl_Filesystem **fsPtrPtr) { - FsPath* srcFsPathPtr; + FsPath *srcFsPathPtr; if (pathPtr->typePtr != &tclFsPathType) { return TCL_OK; } - srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); + srcFsPathPtr = PATHOBJ(pathPtr); /* * Check if the filesystem has changed in some way since this object's @@ -2123,7 +2116,7 @@ TclFSEnsureEpochOk( if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) { return TCL_ERROR; } - srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); + srcFsPathPtr = PATHOBJ(pathPtr); } /* @@ -2159,7 +2152,7 @@ TclFSSetPathDetails( ClientData clientData) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); - FsPath* srcFsPathPtr; + FsPath *srcFsPathPtr; /* * Make sure pathPtr is of the correct type. @@ -2171,7 +2164,7 @@ TclFSSetPathDetails( } } - srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); + srcFsPathPtr = PATHOBJ(pathPtr); srcFsPathPtr->fsRecPtr = fsRecPtr; srcFsPathPtr->nativePathPtr = clientData; srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; @@ -2326,7 +2319,7 @@ SetFsPathFromAny( if (interp) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't find HOME environment " - "variable to expand path", (char *) NULL); + "variable to expand path", NULL); } return TCL_ERROR; } @@ -2342,8 +2335,8 @@ SetFsPathFromAny( if (TclpGetUserHome(name+1, &temp) == NULL) { if (interp != NULL) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "user \"", (name+1), - "\" doesn't exist", (char *) NULL); + Tcl_AppendResult(interp, "user \"", name+1, + "\" doesn't exist", NULL); } Tcl_DStringFree(&temp); if (split != len) { @@ -2432,7 +2425,7 @@ SetFsPathFromAny( * slashes on Windows, and will not contain any ~user sequences. */ - fsPathPtr = (FsPath *) ckalloc((unsigned)sizeof(FsPath)); + fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath)); fsPathPtr->translatedPathPtr = transPtr; if (transPtr != pathPtr) { @@ -2449,7 +2442,7 @@ SetFsPathFromAny( */ TclFreeIntRep(pathPtr); - PATHOBJ(pathPtr) = (VOID *) fsPathPtr; + SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; pathPtr->typePtr = &tclFsPathType; @@ -2460,7 +2453,7 @@ static void FreeFsPathInternalRep( Tcl_Obj *pathPtr) /* Path object with internal rep to free. */ { - FsPath* fsPathPtr = (FsPath*) PATHOBJ(pathPtr); + FsPath *fsPathPtr = PATHOBJ(pathPtr); if (fsPathPtr->translatedPathPtr != NULL) { if (fsPathPtr->translatedPathPtr != pathPtr) { @@ -2503,10 +2496,10 @@ DupFsPathInternalRep( Tcl_Obj *srcPtr, /* Path obj with internal rep to copy. */ Tcl_Obj *copyPtr) /* Path obj with internal rep to set. */ { - FsPath* srcFsPathPtr = (FsPath*) PATHOBJ(srcPtr); - FsPath* copyFsPathPtr = (FsPath*) ckalloc((unsigned)sizeof(FsPath)); + FsPath *srcFsPathPtr = PATHOBJ(srcPtr); + FsPath *copyFsPathPtr = (FsPath *) ckalloc(sizeof(FsPath)); - PATHOBJ(copyPtr) = (VOID *) copyFsPathPtr; + SETPATHOBJ(copyPtr, copyFsPathPtr); if (srcFsPathPtr->translatedPathPtr != NULL) { copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr; @@ -2577,7 +2570,7 @@ static void UpdateStringOfFsPath( register Tcl_Obj *pathPtr) /* path obj with string rep to update. */ { - FsPath* fsPathPtr = (FsPath*) PATHOBJ(pathPtr); + FsPath *fsPathPtr = PATHOBJ(pathPtr); const char *cwdStr; int cwdLen; Tcl_Obj *copy; diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 5830174..147b117 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclPkg.c,v 1.27.2.3 2007/09/19 17:28:37 dgp Exp $ + * RCS: @(#) $Id: tclPkg.c,v 1.27.2.4 2007/11/21 06:30:54 dgp Exp $ * * TIP #268. * Heavily rewritten to handle the extend version numbers, and extended @@ -44,8 +44,8 @@ typedef struct PkgAvail { typedef struct Package { char *version; /* Version that has been supplied in this * interpreter via "package provide" - * (malloc'ed). NULL means the package - * doesn't exist in this interpreter yet. */ + * (malloc'ed). NULL means the package doesn't + * exist in this interpreter yet. */ PkgAvail *availPtr; /* First in list of all available versions of * this package. */ ClientData clientData; /* Client data. */ @@ -56,23 +56,23 @@ typedef struct Package { */ static int CheckVersionAndConvert(Tcl_Interp *interp, - CONST char *string, char **internal, int *stable); + const char *string, char **internal, int *stable); static int CompareVersions(char *v1i, char *v2i, int *isMajorPtr); static int CheckRequirement(Tcl_Interp *interp, - CONST char *string); + const char *string); static int CheckAllRequirements(Tcl_Interp *interp, int reqc, - Tcl_Obj *CONST reqv[]); -static int RequirementSatisfied(char *havei, CONST char *req); + Tcl_Obj *const reqv[]); +static int RequirementSatisfied(char *havei, const char *req); static int SomeRequirementSatisfied(char *havei, int reqc, - Tcl_Obj *CONST reqv[]); + Tcl_Obj *const reqv[]); static void AddRequirementsToResult(Tcl_Interp *interp, int reqc, - Tcl_Obj *CONST reqv[]); + Tcl_Obj *const reqv[]); static void AddRequirementsToDString(Tcl_DString *dstring, - int reqc, Tcl_Obj *CONST reqv[]); -static Package * FindPackage(Tcl_Interp *interp, CONST char *name); -static const char * PkgRequireCore(Tcl_Interp *interp, CONST char *name, - int reqc, Tcl_Obj *CONST reqv[], + int reqc, Tcl_Obj *const reqv[]); +static Package * FindPackage(Tcl_Interp *interp, const char *name); +static const char * PkgRequireCore(Tcl_Interp *interp, const char *name, + int reqc, Tcl_Obj *const reqv[], ClientData *clientDataPtr); /* @@ -112,8 +112,8 @@ int Tcl_PkgProvide( Tcl_Interp *interp, /* Interpreter in which package is now * available. */ - CONST char *name, /* Name of package. */ - CONST char *version) /* Version string for package. */ + const char *name, /* Name of package. */ + const char *version) /* Version string for package. */ { return Tcl_PkgProvideEx(interp, name, version, NULL); } @@ -122,8 +122,8 @@ int Tcl_PkgProvideEx( Tcl_Interp *interp, /* Interpreter in which package is now * available. */ - CONST char *name, /* Name of package. */ - CONST char *version, /* Version string for package. */ + const char *name, /* Name of package. */ + const char *version, /* Version string for package. */ ClientData clientData) /* clientdata for this package (normally used * for C callback function table) */ { @@ -188,12 +188,12 @@ Tcl_PkgProvideEx( *---------------------------------------------------------------------- */ -CONST char * +const char * Tcl_PkgRequire( Tcl_Interp *interp, /* Interpreter in which package is now * available. */ - CONST char *name, /* Name of desired package. */ - CONST char *version, /* Version string for desired version; NULL + const char *name, /* Name of desired package. */ + const char *version, /* Version string for desired version; NULL * means use the latest version available. */ int exact) /* Non-zero means that only the particular * version given is acceptable. Zero means use @@ -202,12 +202,12 @@ Tcl_PkgRequire( return Tcl_PkgRequireEx(interp, name, version, exact, NULL); } -CONST char * +const char * Tcl_PkgRequireEx( Tcl_Interp *interp, /* Interpreter in which package is now * available. */ - CONST char *name, /* Name of desired package. */ - CONST char *version, /* Version string for desired version; NULL + const char *name, /* Name of desired package. */ + const char *version, /* Version string for desired version; NULL * means use the latest version available. */ int exact, /* Non-zero means that only the particular * version given is acceptable. Zero means use @@ -291,12 +291,14 @@ Tcl_PkgRequireEx( return NULL; } - /* Translate between old and new API, and defer to the new function. */ + /* + * Translate between old and new API, and defer to the new function. + */ if (version == NULL) { result = PkgRequireCore(interp, name, 0, NULL, clientDataPtr); } else { - if (exact && TCL_OK + if (exact && TCL_OK != CheckVersionAndConvert(interp, version, NULL, NULL)) { return NULL; } @@ -316,10 +318,10 @@ int Tcl_PkgRequireProc( Tcl_Interp *interp, /* Interpreter in which package is now * available. */ - CONST char *name, /* Name of desired package. */ + const char *name, /* Name of desired package. */ int reqc, /* Requirements constraining the desired * version. */ - Tcl_Obj *CONST reqv[], /* 0 means to use the latest version + Tcl_Obj *const reqv[], /* 0 means to use the latest version * available. */ ClientData *clientDataPtr) { @@ -337,10 +339,10 @@ static const char * PkgRequireCore( Tcl_Interp *interp, /* Interpreter in which package is now * available. */ - CONST char *name, /* Name of desired package. */ + const char *name, /* Name of desired package. */ int reqc, /* Requirements constraining the desired * version. */ - Tcl_Obj *CONST reqv[], /* 0 means to use the latest version + Tcl_Obj *const reqv[], /* 0 means to use the latest version * available. */ ClientData *clientDataPtr) { @@ -349,11 +351,9 @@ PkgRequireCore( PkgAvail *availPtr, *bestPtr, *bestStablePtr; char *availVersion, *bestVersion; /* Internal rep. of versions */ - int availStable; - char *script; - int code, satisfies, pass; + int availStable, code, satisfies, pass; + char *script, *pkgVersionI; Tcl_DString command; - char *pkgVersionI; /* * It can take up to three passes to find the package: one pass to run the @@ -368,9 +368,9 @@ PkgRequireCore( break; } - /* - * Check whether we're already attempting to load some version - * of this package (circular dependency detection). + /* + * Check whether we're already attempting to load some version of this + * package (circular dependency detection). */ if (pkgPtr->clientData != NULL) { @@ -408,7 +408,10 @@ PkgRequireCore( if (bestPtr != NULL) { int res = CompareVersions(availVersion, bestVersion, NULL); - /* Note: Use internal reps! */ + /* + * Note: Use internal reps! + */ + if (res <= 0) { /* * The version of the package sought is not as good as the @@ -474,7 +477,7 @@ PkgRequireCore( * will still exist when the script completes. */ - CONST char *versionToProvide = bestPtr->version; + const char *versionToProvide = bestPtr->version; script = bestPtr->script; pkgPtr->clientData = (ClientData) versionToProvide; @@ -494,7 +497,6 @@ PkgRequireCore( " provided", NULL); } else { char *pvi, *vi; - int res; if (CheckVersionAndConvert(interp, pkgPtr->version, &pvi, NULL) != TCL_OK) { @@ -504,10 +506,10 @@ PkgRequireCore( ckfree(pvi); code = TCL_ERROR; } else { - res = CompareVersions(pvi, vi, NULL); + int res = CompareVersions(pvi, vi, NULL); + ckfree(pvi); ckfree(vi); - if (res != 0) { code = TCL_ERROR; Tcl_AppendResult(interp, @@ -520,10 +522,11 @@ PkgRequireCore( } } else if (code != TCL_ERROR) { Tcl_Obj *codePtr = Tcl_NewIntObj(code); + Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "attempt to provide package ", - name, " ", versionToProvide, " failed: " - "bad return code: ", TclGetString(codePtr), NULL); + Tcl_AppendResult(interp, "attempt to provide package ", name, + " ", versionToProvide, " failed: bad return code: ", + TclGetString(codePtr), NULL); TclDecrRefCount(codePtr); code = TCL_ERROR; } @@ -650,12 +653,12 @@ PkgRequireCore( *---------------------------------------------------------------------- */ -CONST char * +const char * Tcl_PkgPresent( Tcl_Interp *interp, /* Interpreter in which package is now * available. */ - CONST char *name, /* Name of desired package. */ - CONST char *version, /* Version string for desired version; NULL + const char *name, /* Name of desired package. */ + const char *version, /* Version string for desired version; NULL * means use the latest version available. */ int exact) /* Non-zero means that only the particular * version given is acceptable. Zero means use @@ -664,12 +667,12 @@ Tcl_PkgPresent( return Tcl_PkgPresentEx(interp, name, version, exact, NULL); } -CONST char * +const char * Tcl_PkgPresentEx( Tcl_Interp *interp, /* Interpreter in which package is now * available. */ - CONST char *name, /* Name of desired package. */ - CONST char *version, /* Version string for desired version; NULL + const char *name, /* Name of desired package. */ + const char *version, /* Version string for desired version; NULL * means use the latest version available. */ int exact, /* Non-zero means that only the particular * version given is acceptable. Zero means use @@ -731,9 +734,9 @@ Tcl_PackageObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - static CONST char *pkgOptions[] = { + static const char *pkgOptions[] = { "forget", "ifneeded", "names", "prefer", "present", "provide", "require", "unknown", "vcompare", "versions", "vsatisfies", NULL @@ -750,7 +753,7 @@ Tcl_PackageObjCmd( Tcl_HashEntry *hPtr; Tcl_HashSearch search; Tcl_HashTable *tablePtr; - CONST char *version; + const char *version; char *argv2, *argv3, *argv4, *iva = NULL, *ivb = NULL; if (objc < 2) { @@ -815,7 +818,6 @@ Tcl_PackageObjCmd( for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL; prevPtr = availPtr, availPtr = availPtr->nextPtr) { - if (CheckVersionAndConvert(interp, availPtr->version, &avi, NULL) != TCL_OK) { ckfree(argv3i); @@ -1007,7 +1009,7 @@ Tcl_PackageObjCmd( break; } case PKG_PREFER: { - static CONST char *pkgPreferOptions[] = { + static const char *pkgPreferOptions[] = { "latest", "stable", NULL }; @@ -1137,7 +1139,7 @@ Tcl_PackageObjCmd( static Package * FindPackage( Tcl_Interp *interp, /* Interpreter to use for package lookup. */ - CONST char *name) /* Name of package to fine. */ + const char *name) /* Name of package to fine. */ { Interp *iPtr = (Interp *) interp; Tcl_HashEntry *hPtr; @@ -1227,13 +1229,13 @@ TclFreePackageInfo( static int CheckVersionAndConvert( Tcl_Interp *interp, /* Used for error reporting. */ - CONST char *string, /* Supposedly a version number, which is + const char *string, /* Supposedly a version number, which is * groups of decimal digits separated by * dots. */ char **internal, /* Internal normalized representation */ int *stable) /* Flag: Version is (un)stable. */ { - CONST char *p = string; + const char *p = string; char prevChar; int hasunstable = 0; /* @@ -1481,7 +1483,10 @@ CompareVersions( if (*s1 != 0) { s1++; } else if (*s2 == 0) { - /* s1, s2 both at the end => identical */ + /* + * s1, s2 both at the end => identical + */ + res = 0; break; } @@ -1520,7 +1525,7 @@ static int CheckAllRequirements( Tcl_Interp *interp, int reqc, /* Requirements to check. */ - Tcl_Obj *CONST reqv[]) + Tcl_Obj *const reqv[]) { int i; @@ -1553,7 +1558,7 @@ CheckAllRequirements( static int CheckRequirement( Tcl_Interp *interp, /* Used for error reporting. */ - CONST char *string) /* Supposedly a requirement. */ + const char *string) /* Supposedly a requirement. */ { /* * Syntax of requirement = version @@ -1566,7 +1571,7 @@ CheckRequirement( dash = strchr(string, '-'); if (dash == NULL) { /* - * no dash found, has to be a simple version. + * No dash found, has to be a simple version. */ return CheckVersionAndConvert(interp, string, NULL, NULL); @@ -1585,7 +1590,8 @@ CheckRequirement( /* * Exactly one dash is present. Copy the string, split at the location of * dash and check that both parts are versions. Note that the max part can - * be empty. + * be empty. Also note that the string allocated with strdup() must be + * freed with free() and not ckfree(). */ DupString(buf, string); @@ -1625,7 +1631,7 @@ AddRequirementsToResult( Tcl_Interp *interp, int reqc, /* Requirements constraining the desired * version. */ - Tcl_Obj *CONST reqv[]) /* 0 means to use the latest version + Tcl_Obj *const reqv[]) /* 0 means to use the latest version * available. */ { if (reqc > 0) { @@ -1666,7 +1672,7 @@ AddRequirementsToDString( Tcl_DString *dsPtr, int reqc, /* Requirements constraining the desired * version. */ - Tcl_Obj *CONST reqv[]) /* 0 means to use the latest version + Tcl_Obj *const reqv[]) /* 0 means to use the latest version * available. */ { if (reqc > 0) { @@ -1706,7 +1712,7 @@ SomeRequirementSatisfied( * requirements. */ int reqc, /* Requirements constraining the desired * version. */ - Tcl_Obj *CONST reqv[]) /* 0 means to use the latest version + Tcl_Obj *const reqv[]) /* 0 means to use the latest version * available. */ { int i; @@ -1741,7 +1747,7 @@ static int RequirementSatisfied( char *havei, /* Version string, of candidate package we * have. */ - CONST char *req) /* Requirement string the candidate has to + const char *req) /* Requirement string the candidate has to * satisfy. */ { /* @@ -1839,16 +1845,16 @@ RequirementSatisfied( *---------------------------------------------------------------------- */ -CONST char * +const char * Tcl_PkgInitStubsCheck( Tcl_Interp *interp, - CONST char * version, + const char * version, int exact) { - CONST char *actualVersion = Tcl_PkgPresent(interp, "Tcl", version, 0); + const char *actualVersion = Tcl_PkgPresent(interp, "Tcl", version, 0); if (exact && actualVersion) { - CONST char *p = version; + const char *p = version; int count = 0; while (*p) { diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index dc19855..2b03227 100755 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -9,12 +9,12 @@ * into strings of digits, and procedures for interconversion among * 'double' and 'mp_int' types. * - * Copyright (c) 2005 by Kevin B. Kenny. All rights reserved. + * Copyright (c) 2005 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStrToD.c,v 1.30 2007/04/23 17:34:07 kennykb Exp $ + * RCS: @(#) $Id: tclStrToD.c,v 1.30.2.1 2007/11/21 06:30:54 dgp Exp $ * *---------------------------------------------------------------------- */ @@ -146,22 +146,21 @@ static double SafeLdExp(double fraction, int exponent); * * TclParseNumber -- * - * Scans bytes, interpreted as characters in Tcl's internal encoding, - * and parses the longest prefix that is the string representation of - * a number in a format recognized by Tcl. + * Scans bytes, interpreted as characters in Tcl's internal encoding, and + * parses the longest prefix that is the string representation of a + * number in a format recognized by Tcl. * * The arguments bytes, numBytes, and objPtr are the inputs which - * determine the string to be parsed. If bytes is non-NULL, it - * points to the first byte to be scanned. If bytes is NULL, then objPtr - * must be non-NULL, and the string representation of objPtr will be - * scanned (generated first, if necessary). The numBytes argument - * determines the number of bytes to be scanned. If numBytes is - * negative, the first NUL byte encountered will terminate the scan. - * If numBytes is non-negative, then no more than numBytes bytes will - * be scanned. + * determine the string to be parsed. If bytes is non-NULL, it points to + * the first byte to be scanned. If bytes is NULL, then objPtr must be + * non-NULL, and the string representation of objPtr will be scanned + * (generated first, if necessary). The numBytes argument determines the + * number of bytes to be scanned. If numBytes is negative, the first NUL + * byte encountered will terminate the scan. If numBytes is non-negative, + * then no more than numBytes bytes will be scanned. * * The argument flags is an input that controls the numeric formats - * recognized by the parser. The flag bits are: + * recognized by the parser. The flag bits are: * * - TCL_PARSE_INTEGER_ONLY: accept only integer values; reject * strings that denote floating point values (or accept only the @@ -170,70 +169,72 @@ static double SafeLdExp(double fraction, int exponent); * not part of the [scan] command's vocabulary. Use only in * combination with TCL_PARSE_INTEGER_ONLY. * - TCL_PARSE_OCTAL_ONLY: parse only in the octal format, whether - * or not a prefix is present that would lead to octal parsing. Use - * only in combination with TCL_PARSE_INTEGER_ONLY. + * or not a prefix is present that would lead to octal parsing. + * Use only in combination with TCL_PARSE_INTEGER_ONLY. * - TCL_PARSE_HEXADECIMAL_ONLY: parse only in the hexadecimal format, * whether or not a prefix is present that would lead to * hexadecimal parsing. Use only in combination with * TCL_PARSE_INTEGER_ONLY. * - TCL_PARSE_DECIMAL_ONLY: parse only in the decimal format, no - * matter whether a 0 prefix would normally force a different base. + * matter whether a 0 prefix would normally force a different + * base. * - TCL_PARSE_NO_WHITESPACE: reject any leading/trailing whitespace * - * The arguments interp and expected are inputs that control error message - * generation. If interp is NULL, no error message will be generated. - * If interp is non-NULL, then expected must also be non-NULL. When - * TCL_ERROR is returned, an error message will be left in the result - * of interp, and the expected argument will appear in the error message - * as the thing TclParseNumber expected, but failed to find in the string. + * The arguments interp and expected are inputs that control error + * message generation. If interp is NULL, no error message will be + * generated. If interp is non-NULL, then expected must also be non-NULL. + * When TCL_ERROR is returned, an error message will be left in the + * result of interp, and the expected argument will appear in the error + * message as the thing TclParseNumber expected, but failed to find in + * the string. * * The arguments objPtr and endPtrPtr as well as the return code are the * outputs. * * When the parser cannot find any prefix of the string that matches a * format it is looking for, TCL_ERROR is returned and an error message - * may be generated and returned as described above. The contents of - * objPtr will not be changed. If endPtrPtr is non-NULL, a pointer to - * the character in the string that terminated the scan will be written - * to *endPtrPtr. - * - * When the parser determines that the entire string matches a format - * it is looking for, TCL_OK is returned, and if objPtr is non-NULL, - * then the internal rep and Tcl_ObjType of objPtr are set to the - * "canonical" numeric value that matches the scanned string. If - * endPtrPtr is non-NULL, a pointer to the end of the string will be - * written to *endPtrPtr (that is, either bytes+numBytes or a pointer - * to a terminating NUL byte). - * - * When the parser determines that a partial string matches a format - * it is looking for, the value of endPtrPtr determines what happens: + * may be generated and returned as described above. The contents of + * objPtr will not be changed. If endPtrPtr is non-NULL, a pointer to the + * character in the string that terminated the scan will be written to + * *endPtrPtr. + * + * When the parser determines that the entire string matches a format it + * is looking for, TCL_OK is returned, and if objPtr is non-NULL, then + * the internal rep and Tcl_ObjType of objPtr are set to the "canonical" + * numeric value that matches the scanned string. If endPtrPtr is not + * NULL, a pointer to the end of the string will be written to *endPtrPtr + * (that is, either bytes+numBytes or a pointer to a terminating NUL + * byte). + * + * When the parser determines that a partial string matches a format it + * is looking for, the value of endPtrPtr determines what happens: * * - If endPtrPtr is NULL, then TCL_ERROR is returned, with error message * generation as above. * * - If endPtrPtr is non-NULL, then TCL_OK is returned and objPtr - * internals are set as above. Also, a pointer to the first - * character following the parsed numeric string is written - * to *endPtrPtr. + * internals are set as above. Also, a pointer to the first + * character following the parsed numeric string is written to + * *endPtrPtr. * * In some cases where the string being scanned is the string rep of - * objPtr, this routine can leave objPtr in an inconsistent state - * where its string rep and its internal rep do not agree. In these - * cases the internal rep will be in agreement with only some substring - * of the string rep. This might happen if the caller passes in a - * non-NULL bytes value that points somewhere into the string rep. It - * might happen if the caller passes in a numBytes value that limits the - * scan to only a prefix of the string rep. Or it might happen if a - * non-NULL value of endPtrPtr permits a TCL_OK return from only a partial - * string match. It is the responsibility of the caller to detect and - * correct such inconsistencies when they can and do arise. + * objPtr, this routine can leave objPtr in an inconsistent state where + * its string rep and its internal rep do not agree. In these cases the + * internal rep will be in agreement with only some substring of the + * string rep. This might happen if the caller passes in a non-NULL bytes + * value that points somewhere into the string rep. It might happen if + * the caller passes in a numBytes value that limits the scan to only a + * prefix of the string rep. Or it might happen if a non-NULL value of + * endPtrPtr permits a TCL_OK return from only a partial string match. It + * is the responsibility of the caller to detect and correct such + * inconsistencies when they can and do arise. * * Results: * Returns a standard Tcl result. * * Side effects: * The string representaton of objPtr may be generated. - * + * * The internal representation and Tcl_ObjType of objPtr may be changed. * This may involve allocation and/or freeing of memory. * @@ -242,21 +243,23 @@ static double SafeLdExp(double fraction, int exponent); int TclParseNumber( - Tcl_Interp *interp, /* Used for error reporting. May be NULL */ - Tcl_Obj *objPtr, /* Object to receive the internal rep */ - const char *expected, /* Description of the type of number the caller - * expects to be able to parse ("integer", - * "boolean value", etc.). */ - const char *bytes, /* Pointer to the start of the string to scan */ - int numBytes, /* Maximum number of bytes to scan, see above */ + Tcl_Interp *interp, /* Used for error reporting. May be NULL. */ + Tcl_Obj *objPtr, /* Object to receive the internal rep. */ + const char *expected, /* Description of the type of number the + * caller expects to be able to parse + * ("integer", "boolean value", etc.). */ + const char *bytes, /* Pointer to the start of the string to + * scan. */ + int numBytes, /* Maximum number of bytes to scan, see + * above. */ const char **endPtrPtr, /* Place to store pointer to the character - * that terminated the scan */ - int flags) /* Flags governing the parse */ + * that terminated the scan. */ + int flags) /* Flags governing the parse. */ { enum State { - INITIAL, SIGNUM, ZERO, ZERO_X, + INITIAL, SIGNUM, ZERO, ZERO_X, ZERO_O, ZERO_B, BINARY, - HEXADECIMAL, OCTAL, BAD_OCTAL, DECIMAL, + HEXADECIMAL, OCTAL, BAD_OCTAL, DECIMAL, LEADING_RADIX_POINT, FRACTION, EXPONENT_START, EXPONENT_SIGNUM, EXPONENT, sI, sIN, sINF, sINFI, sINFIN, sINFINI, sINFINIT, sINFINITY @@ -306,7 +309,7 @@ TclParseNumber( #define ALL_BITS (~(Tcl_WideUInt)0) #define MOST_BITS (ALL_BITS >> 1) - /* + /* * Initialize bytes to start of the object's string rep if the caller * didn't pass anything else. */ @@ -341,9 +344,9 @@ TclParseNumber( signum = 1; state = SIGNUM; break; - } + } /* FALLTHROUGH */ - + case SIGNUM: /* * Scanned a leading + or -. Acceptable characters are digits, @@ -449,10 +452,11 @@ TclParseNumber( * too large shifts first. */ - if ((octalSignificandWide != 0) - && (((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt)) - || (octalSignificandWide - > (~(Tcl_WideUInt)0 >> shift)))) { + if ((octalSignificandWide != 0) + && (((size_t)shift >= + CHAR_BIT*sizeof(Tcl_WideUInt)) + || (octalSignificandWide > + (~(Tcl_WideUInt)0 >> shift)))) { octalSignificandOverflow = 1; TclBNInitBignumFromWideUInt(&octalSignificandBig, octalSignificandWide); @@ -482,8 +486,7 @@ TclParseNumber( case BAD_OCTAL: if (explicitOctal) { /* - * No forgiveness for bad digits in explicitly octal - * numbers. + * No forgiveness for bad digits in explicitly octal numbers. */ goto endgame; @@ -528,7 +531,7 @@ TclParseNumber( } else if (c == 'E' || c == 'e') { state = EXPONENT_START; break; - } + } #endif goto endgame; @@ -646,8 +649,8 @@ TclParseNumber( } else if (isdigit(UCHAR(c))) { if (objPtr != NULL) { significandOverflow = AccumulateDecimalDigit( - (unsigned)(c - '0'), numTrailZeros, - &significandWide, &significandBig, + (unsigned)(c - '0'), numTrailZeros, + &significandWide, &significandBig, significandOverflow); } numSigDigs += numTrailZeros+1; @@ -665,7 +668,7 @@ TclParseNumber( } goto endgame; - /* + /* * Found a decimal point. If no digits have yet been scanned, E is * not allowed; otherwise, it introduces the exponent. If at least * one digit has been found, we have a possible complete number. @@ -691,8 +694,8 @@ TclParseNumber( ++numDigitsAfterDp; if (objPtr != NULL) { significandOverflow = AccumulateDecimalDigit( - (unsigned)(c-'0'), numTrailZeros, - &significandWide, &significandBig, + (unsigned)(c-'0'), numTrailZeros, + &significandWide, &significandBig, significandOverflow); } if (numSigDigs != 0) { @@ -707,7 +710,7 @@ TclParseNumber( goto endgame; case EXPONENT_START: - /* + /* * Scanned the E at the start of an exponent. Make sure a legal * character follows before using the C library strtol routine, * which allows whitespace. @@ -737,7 +740,7 @@ TclParseNumber( goto endgame; case EXPONENT: - /* + /* * Found an exponent with at least one digit. Accumulate it, * making sure to hard-pin it to LONG_MAX on overflow. */ @@ -765,13 +768,13 @@ TclParseNumber( if (c == 'n' || c == 'N') { state = sIN; break; - } + } goto endgame; case sIN: if (c == 'f' || c == 'F') { state = sINF; break; - } + } goto endgame; case sINF: acceptState = state; @@ -868,23 +871,32 @@ TclParseNumber( acceptLen = len; goto endgame; } - ++p; + ++p; --len; } endgame: if (acceptState == INITIAL) { - /* No numeric string at all found */ + /* + * No numeric string at all found. + */ + status = TCL_ERROR; if (endPtrPtr != NULL) { *endPtrPtr = p; } } else { - /* Back up to the last accepting state in the lexer. */ + /* + * Back up to the last accepting state in the lexer. + */ + p = acceptPoint; len = acceptLen; if (!(flags & TCL_PARSE_NO_WHITESPACE)) { - /* Accept trailing whitespace */ + /* + * Accept trailing whitespace. + */ + while (len != 0 && isspace(UCHAR(*p))) { ++p; --len; @@ -987,7 +999,7 @@ TclParseNumber( } } if (!octalSignificandOverflow) { - if (octalSignificandWide > + if (octalSignificandWide > (Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) { #ifndef NO_WIDE_TYPE if (octalSignificandWide <= (MOST_BITS + signum)) { @@ -1021,7 +1033,7 @@ TclParseNumber( mp_neg(&octalSignificandBig, &octalSignificandBig); } TclSetBignumIntRep(objPtr, &octalSignificandBig); - } + } break; case ZERO: @@ -1034,7 +1046,7 @@ TclParseNumber( } returnInteger: if (!significandOverflow) { - if (significandWide > + if (significandWide > (Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) { #ifndef NO_WIDE_TYPE if (significandWide <= MOST_BITS+signum) { @@ -1194,6 +1206,7 @@ AccumulateDecimalDigit( /* * There's no need to multiply if the multiplicand is zero. */ + *wideRepPtr = digit; return 0; } else if (numZeros >= maxpow10_wide @@ -1202,7 +1215,7 @@ AccumulateDecimalDigit( * Wide multiplication will overflow. Expand the * number to a bignum and fall through into the bignum case. */ - + TclBNInitBignumFromWideUInt (bignumRepPtr, w); } else { /* @@ -1226,7 +1239,7 @@ AccumulateDecimalDigit( bignumRepPtr); mp_add_d(bignumRepPtr, (mp_digit) digit, bignumRepPtr); } else { - /* + /* * More than single digit multiplication. Multiply by the appropriate * small powers of 5, and then shift. Large strings of zeroes are * eaten 256 at a time; this is less efficient than it could be, but @@ -1304,7 +1317,7 @@ MakeLowPrecisionDouble( if (numSigDigs <= DBL_DIG) { if (exponent >= 0) { if (exponent <= mmaxpow) { - /* + /* * The significand is an exact integer, and so is * 10**exponent. The product will be correct to within 1/2 ulp * without special handling. @@ -1315,7 +1328,7 @@ MakeLowPrecisionDouble( } else { int diff = DBL_DIG - numSigDigs; if (exponent-diff <= mmaxpow) { - /* + /* * 10**exponent is not an exact integer, but * 10**(exponent-diff) is exact, and so is * significand*10**diff, so we can still compute the value @@ -1330,7 +1343,7 @@ MakeLowPrecisionDouble( } } else { if (exponent >= -mmaxpow) { - /* + /* * 10**-exponent is an exact integer, and so is the * significand. Compute the result by one division, again with * only one rounding. @@ -1351,7 +1364,7 @@ MakeLowPrecisionDouble( retval = MakeHighPrecisionDouble(0, &significandBig, numSigDigs, exponent); mp_clear(&significandBig); - + /* * Come here to return the computed value. */ @@ -1428,7 +1441,7 @@ MakeHighPrecisionDouble( goto returnValue; } - /* + /* * Develop a first approximation to the significand. It is tempting simply * to force bignum to double, but that will overflow on input numbers like * 1.[string repeat 0 1000]1; while this is a not terribly likely @@ -1448,7 +1461,7 @@ MakeHighPrecisionDouble( retval = tiny; } - /* + /* * Refine the result twice. (The second refinement should be necessary * only if the best approximation is a power of 2 minus 1/2 ulp). */ @@ -1585,7 +1598,7 @@ RefineApproximation( } } - /* + /* * The floating point number is significand*2**binExponent. Compute the * large integer significand*2**(binExponent+M2+1). The 2**-1 bit of the * significand (the most significant) corresponds to the @@ -1610,8 +1623,8 @@ RefineApproximation( mp_mul(&twoMv, pow5+i, &twoMv); } } - - /* + + /* * Collect the decimal significand as a high precision integer. The least * significant bit corresponds to bit M2+exponent+1 so it will need to be * shifted left by that many bits after being multiplied by @@ -1659,7 +1672,7 @@ RefineApproximation( return approxResult; } - /* + /* * Convert the numerator and denominator of the corrector term accurately * to floating point numbers. */ @@ -1752,8 +1765,8 @@ TclDoubleDigits( return 1; } - /* - * Find a large integer r, and integer e, such that + /* + * Find a large integer r, and integer e, such that * v = r * FLT_RADIX**e * and r is as small as possible. Also determine whether the significand * is the smallest possible. @@ -2153,7 +2166,7 @@ TclInitDoubleConversion(void) mantBits = DBL_MANT_DIG * log2FLT_RADIX; d = 1.0; - /* + /* * Initialize a table of powers of ten that can be exactly represented * in a double. */ @@ -2181,10 +2194,10 @@ TclInitDoubleConversion(void) mp_sqr(pow5+i, pow5+i+1); } - /* + /* * Determine the number of decimal digits to the left and right of the * decimal point in the largest and smallest double, the smallest double - * that differs from zero, and the number of mp_digits needed to represent + * that differs from zero, and the number of mp_digits needed to represent * the significand of a double. */ @@ -2197,8 +2210,8 @@ TclInitDoubleConversion(void) log10_DIGIT_MAX = (int) floor(DIGIT_BIT * log(2.) / log(10.)); /* - * Nokia 770's software-emulated floating point is "middle endian": - * the bytes within a 32-bit word are little-endian (like the native + * Nokia 770's software-emulated floating point is "middle endian": the + * bytes within a 32-bit word are little-endian (like the native * integers), but the two words of a 'double' are presented most * significant word first. */ @@ -2255,8 +2268,8 @@ TclFinalizeDoubleConversion(void) * None. * * Side effects: - * Initializes the bignum supplied, and stores the converted number - * in it. + * Initializes the bignum supplied, and stores the converted number in + * it. * *---------------------------------------------------------------------- */ @@ -2557,7 +2570,7 @@ Pow10TimesFrExp( /* * Multiply by 10**exponent */ - + retval = frexp(retval * pow10[exponent&0xf], &j); expt += j; for (i=4; i<9; ++i) { diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index eb83c22..c085e36 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -33,7 +33,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStringObj.c,v 1.65.2.1 2007/11/12 19:18:20 dgp Exp $ */ + * RCS: @(#) $Id: tclStringObj.c,v 1.65.2.2 2007/11/21 06:30:54 dgp Exp $ */ #include "tclInt.h" #include "tommath.h" @@ -43,16 +43,16 @@ */ static void AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr, - CONST Tcl_UniChar *unicode, int appendNumChars); + const Tcl_UniChar *unicode, int appendNumChars); static void AppendUnicodeToUtfRep(Tcl_Obj *objPtr, - CONST Tcl_UniChar *unicode, int numChars); + const Tcl_UniChar *unicode, int numChars); static void AppendUtfToUnicodeRep(Tcl_Obj *objPtr, - CONST char *bytes, int numBytes); + const char *bytes, int numBytes); static void AppendUtfToUtfRep(Tcl_Obj *objPtr, - CONST char *bytes, int numBytes); + const char *bytes, int numBytes); static void FillUnicodeRep(Tcl_Obj *objPtr); static void AppendPrintfToObjVA(Tcl_Obj *objPtr, - CONST char *format, va_list argList); + const char *format, va_list argList); static void FreeStringInternalRep(Tcl_Obj *objPtr); static void DupStringInternalRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); @@ -183,7 +183,7 @@ typedef struct String { #undef Tcl_NewStringObj Tcl_Obj * Tcl_NewStringObj( - CONST char *bytes, /* Points to the first of the length bytes + const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ int length) /* The number of bytes to copy from "bytes" * when initializing the new object. If @@ -195,7 +195,7 @@ Tcl_NewStringObj( #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewStringObj( - CONST char *bytes, /* Points to the first of the length bytes + const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ int length) /* The number of bytes to copy from "bytes" * when initializing the new object. If @@ -244,13 +244,13 @@ Tcl_NewStringObj( #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewStringObj( - CONST char *bytes, /* Points to the first of the length bytes + const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ int length, /* The number of bytes to copy from "bytes" * when initializing the new object. If * negative, use bytes up to the first NUL * byte. */ - CONST char *file, /* The name of the source file calling this + 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. */ @@ -267,13 +267,13 @@ Tcl_DbNewStringObj( #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewStringObj( - CONST char *bytes, /* Points to the first of the length bytes + const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ register int length, /* The number of bytes to copy from "bytes" * when initializing the new object. If * negative, use bytes up to the first NUL * byte. */ - CONST char *file, /* The name of the source file calling this + 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. */ @@ -303,7 +303,7 @@ Tcl_DbNewStringObj( Tcl_Obj * Tcl_NewUnicodeObj( - CONST Tcl_UniChar *unicode, /* The unicode string used to initialize the + const Tcl_UniChar *unicode, /* The unicode string used to initialize the * new object. */ int numChars) /* Number of characters in the unicode * string. */ @@ -335,7 +335,7 @@ Tcl_NewUnicodeObj( stringPtr->uallocated = uallocated; stringPtr->hasUnicode = (numChars > 0); stringPtr->allocated = 0; - memcpy((void *) stringPtr->unicode, (void *) unicode, uallocated); + memcpy(stringPtr->unicode, unicode, uallocated); stringPtr->unicode[numChars] = 0; SET_STRING(objPtr, stringPtr); return objPtr; @@ -686,7 +686,7 @@ Tcl_GetRange( void Tcl_SetStringObj( register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ - CONST char *bytes, /* Points to the first of the length bytes + const char *bytes, /* Points to the first of the length bytes * used to initialize the object. */ register int length) /* The number of bytes to copy from "bytes" * when initializing the object. If negative, @@ -761,23 +761,22 @@ Tcl_SetObjLength( if (length > (int) stringPtr->allocated && (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) { - /* * Not enough space in current string. Reallocate the string space and * free the old string. */ if (objPtr->bytes != tclEmptyStringRep) { - objPtr->bytes = ckrealloc((char *)objPtr->bytes, - (unsigned)(length+1)); + objPtr->bytes = ckrealloc((char *) objPtr->bytes, + (unsigned) (length + 1)); } else { - char *new = ckalloc((unsigned) (length+1)); + char *newBytes = ckalloc((unsigned) (length+1)); + if (objPtr->bytes != NULL && objPtr->length != 0) { - memcpy((void *) new, (void *) objPtr->bytes, - (size_t) objPtr->length); + memcpy(newBytes, objPtr->bytes, (size_t) objPtr->length); Tcl_InvalidateStringRep(objPtr); } - objPtr->bytes = new; + objPtr->bytes = newBytes; } stringPtr->allocated = length; @@ -876,7 +875,7 @@ Tcl_AttemptSetObjLength( if (length > (int) stringPtr->allocated && (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) { - char *new; + char *newBytes; /* * Not enough space in current string. Reallocate the string space and @@ -884,22 +883,22 @@ Tcl_AttemptSetObjLength( */ if (objPtr->bytes != tclEmptyStringRep) { - new = attemptckrealloc(objPtr->bytes, (unsigned)(length+1)); - if (new == NULL) { + newBytes = attemptckrealloc(objPtr->bytes, + (unsigned)(length + 1)); + if (newBytes == NULL) { return 0; } } else { - new = attemptckalloc((unsigned) (length+1)); - if (new == NULL) { + newBytes = attemptckalloc((unsigned) (length + 1)); + if (newBytes == NULL) { return 0; } if (objPtr->bytes != NULL && objPtr->length != 0) { - memcpy((void *) new, (void *) objPtr->bytes, - (size_t) objPtr->length); + memcpy(newBytes, objPtr->bytes, (size_t) objPtr->length); Tcl_InvalidateStringRep(objPtr); } } - objPtr->bytes = new; + objPtr->bytes = newBytes; stringPtr->allocated = length; /* @@ -974,7 +973,7 @@ Tcl_AttemptSetObjLength( void Tcl_SetUnicodeObj( Tcl_Obj *objPtr, /* The object to set the string of. */ - CONST Tcl_UniChar *unicode, /* The unicode string used to initialize the + const Tcl_UniChar *unicode, /* The unicode string used to initialize the * object. */ int numChars) /* Number of characters in the unicode * string. */ @@ -1008,7 +1007,7 @@ Tcl_SetUnicodeObj( stringPtr->uallocated = uallocated; stringPtr->hasUnicode = (numChars > 0); stringPtr->allocated = 0; - memcpy((void *) stringPtr->unicode, (void *) unicode, uallocated); + memcpy(stringPtr->unicode, unicode, uallocated); stringPtr->unicode[numChars] = 0; SET_STRING(objPtr, stringPtr); @@ -1037,14 +1036,14 @@ Tcl_SetUnicodeObj( void Tcl_AppendLimitedToObj( register Tcl_Obj *objPtr, /* Points to the object to append to. */ - CONST char *bytes, /* Points to the bytes to append to the + const char *bytes, /* Points to the bytes to append to the * object. */ register int length, /* The number of bytes available to be * appended from "bytes". If < 0, then all * bytes up to a NUL byte are available. */ register int limit, /* The maximum number of bytes to append to * the object. */ - CONST char *ellipsis) /* Ellipsis marker string, appended to the + const char *ellipsis) /* Ellipsis marker string, appended to the * object to indicate not all available bytes * at "bytes" were appended. */ { @@ -1118,7 +1117,7 @@ Tcl_AppendLimitedToObj( void Tcl_AppendToObj( register Tcl_Obj *objPtr, /* Points to the object to append to. */ - CONST char *bytes, /* Points to the bytes to append to the + const char *bytes, /* Points to the bytes to append to the * object. */ register int length) /* The number of bytes to append from "bytes". * If < 0, then append all bytes up to NUL @@ -1147,7 +1146,7 @@ Tcl_AppendToObj( void Tcl_AppendUnicodeToObj( register Tcl_Obj *objPtr, /* Points to the object to append to. */ - CONST Tcl_UniChar *unicode, /* The unicode string to append to the + const Tcl_UniChar *unicode, /* The unicode string to append to the * object. */ int length) /* Number of chars in "unicode". */ { @@ -1283,7 +1282,7 @@ Tcl_AppendObjToObj( static void AppendUnicodeToUnicodeRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ - CONST Tcl_UniChar *unicode, /* String to append. */ + const Tcl_UniChar *unicode, /* String to append. */ int appendNumChars) /* Number of chars of "unicode" to append. */ { String *stringPtr, *tmpString; @@ -1334,7 +1333,7 @@ AppendUnicodeToUnicodeRep( * trailing null. */ - memcpy((void*) (stringPtr->unicode + stringPtr->numChars), unicode, + memcpy(stringPtr->unicode + stringPtr->numChars, unicode, appendNumChars * sizeof(Tcl_UniChar)); stringPtr->unicode[numChars] = 0; stringPtr->numChars = numChars; @@ -1362,11 +1361,11 @@ AppendUnicodeToUnicodeRep( static void AppendUnicodeToUtfRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ - CONST Tcl_UniChar *unicode, /* String to convert to UTF. */ + const Tcl_UniChar *unicode, /* String to convert to UTF. */ int numChars) /* Number of chars of "unicode" to convert. */ { Tcl_DString dsPtr; - CONST char *bytes; + const char *bytes; if (numChars < 0) { numChars = 0; @@ -1407,7 +1406,7 @@ AppendUnicodeToUtfRep( static void AppendUtfToUnicodeRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ - CONST char *bytes, /* String to convert to Unicode. */ + const char *bytes, /* String to convert to Unicode. */ int numBytes) /* Number of bytes of "bytes" to convert. */ { Tcl_DString dsPtr; @@ -1448,7 +1447,7 @@ AppendUtfToUnicodeRep( static void AppendUtfToUtfRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ - CONST char *bytes, /* String to append. */ + const char *bytes, /* String to append. */ int numBytes) /* Number of bytes of "bytes" to append. */ { String *stringPtr; @@ -1492,8 +1491,7 @@ AppendUtfToUtfRep( stringPtr->numChars = -1; stringPtr->hasUnicode = 0; - memcpy((void *) (objPtr->bytes + oldLength), (void *) bytes, - (size_t) numBytes); + memcpy(objPtr->bytes + oldLength, bytes, (size_t) numBytes); objPtr->bytes[newLength] = 0; objPtr->length = newLength; } @@ -1636,7 +1634,7 @@ Tcl_AppendStringsToObjVA( */ if (args != static_list) { - ckfree((void *)args); + ckfree((void *) args); } #undef STATIC_LIST_SIZE } @@ -1695,19 +1693,16 @@ int Tcl_AppendFormatToObj( Tcl_Interp *interp, Tcl_Obj *appendObj, - CONST char *format, + const char *format, int objc, - Tcl_Obj *CONST objv[]) + Tcl_Obj *const objv[]) { - CONST char *span = format; - int numBytes = 0; - int objIndex = 0; - int gotXpg = 0, gotSequential = 0; + const char *span = format, *msg; + int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0; int originalLength; - CONST char *msg; - CONST char *mixedXPG = + static const char *mixedXPG = "cannot mix \"%\" and \"%n$\" conversion specifiers"; - CONST char *badIndex[2] = { + static const char *badIndex[2] = { "not enough arguments for all format specifiers", "\"%n$\" argument index out of range" }; @@ -1930,6 +1925,7 @@ Tcl_AppendFormatToObj( case 'c': { char buf[TCL_UTF_MAX]; int code, length; + if (TclGetIntFromObj(interp, segment, &code) != TCL_OK) { goto error; } @@ -2028,7 +2024,7 @@ Tcl_AppendFormatToObj( case 'd': { int length; Tcl_Obj *pure; - CONST char *bytes; + const char *bytes; if (useShort) { pure = Tcl_NewIntObj((int)(s)); @@ -2143,8 +2139,9 @@ Tcl_AppendFormatToObj( int digitOffset; if (useBig) { - if ((size_t)shift<CHAR_BIT*sizeof(Tcl_WideUInt)-DIGIT_BIT) { - bits |= (((Tcl_WideUInt)big.dp[index++]) << shift); + if ((size_t) shift < + CHAR_BIT*sizeof(Tcl_WideUInt) - DIGIT_BIT) { + bits |= (((Tcl_WideUInt)big.dp[index++]) <<shift); shift += DIGIT_BIT; } shift -= numBits; @@ -2303,9 +2300,9 @@ Tcl_AppendFormatToObj( Tcl_Obj * Tcl_Format( Tcl_Interp *interp, - CONST char *format, + const char *format, int objc, - Tcl_Obj *CONST objv[]) + Tcl_Obj *const objv[]) { int result; Tcl_Obj *objPtr = Tcl_NewObj(); @@ -2332,12 +2329,12 @@ Tcl_Format( static void AppendPrintfToObjVA( Tcl_Obj *objPtr, - CONST char *format, + const char *format, va_list argList) { int code, objc; Tcl_Obj **objv, *list = Tcl_NewObj(); - CONST char *p; + const char *p; char *end; p = format; @@ -2360,13 +2357,13 @@ AppendPrintfToObjVA( seekingConversion = 0; break; case 's': { - CONST char *q, *end, *bytes = va_arg(argList, char *); + const char *q, *end, *bytes = va_arg(argList, char *); seekingConversion = 0; /* - * The buffer to copy characters from starts at bytes - * and ends at either the first NUL byte, or after - * lastNum bytes, when caller has indicated a limit. + * The buffer to copy characters from starts at bytes and ends + * at either the first NUL byte, or after lastNum bytes, when + * caller has indicated a limit. */ end = bytes; @@ -2375,9 +2372,9 @@ AppendPrintfToObjVA( } /* - * Within that buffer, we trim both ends if needed so that - * we copy only whole characters, and avoid copying any - * partial multi-byte characters. + * Within that buffer, we trim both ends if needed so that we + * copy only whole characters, and avoid copying any partial + * multi-byte characters. */ q = Tcl_UtfPrev(end, bytes); @@ -2478,7 +2475,7 @@ AppendPrintfToObjVA( void Tcl_AppendPrintfToObj( Tcl_Obj *objPtr, - CONST char *format, + const char *format, ...) { va_list argList; @@ -2504,7 +2501,7 @@ Tcl_AppendPrintfToObj( Tcl_Obj * Tcl_ObjPrintf( - CONST char *format, + const char *format, ...) { va_list argList; @@ -2622,9 +2619,8 @@ FillUnicodeRep( { String *stringPtr; size_t uallocated; - char *src, *srcEnd; + char *srcEnd, *src = objPtr->bytes; Tcl_UniChar *dst; - src = objPtr->bytes; stringPtr = GET_STRING(objPtr); if (stringPtr->numChars == -1) { @@ -2709,8 +2705,7 @@ DupStringInternalRep( STRING_SIZE(srcStringPtr->uallocated)); copyStringPtr->uallocated = srcStringPtr->uallocated; - memcpy((void *) copyStringPtr->unicode, - (void *) srcStringPtr->unicode, + memcpy(copyStringPtr->unicode, srcStringPtr->unicode, (size_t) srcStringPtr->numChars * sizeof(Tcl_UniChar)); copyStringPtr->unicode[srcStringPtr->numChars] = 0; } diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c index 387e96d..2a77ea6 100755 --- a/generic/tclThreadAlloc.c +++ b/generic/tclThreadAlloc.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclThreadAlloc.c,v 1.21.6.1 2007/07/01 17:31:25 dgp Exp $ + * RCS: @(#) $Id: tclThreadAlloc.c,v 1.21.6.2 2007/11/21 06:30:54 dgp Exp $ */ #include "tclInt.h" @@ -426,7 +426,7 @@ TclpRealloc( { Cache *cachePtr = TclpGetAllocCache(); Block *blockPtr; - void *new; + void *newPtr; size_t size, min; int bucket; @@ -475,15 +475,15 @@ TclpRealloc( * Finally, perform an expensive malloc/copy/free. */ - new = TclpAlloc(reqSize); - if (new != NULL) { + newPtr = TclpAlloc(reqSize); + if (newPtr != NULL) { if (reqSize > blockPtr->blockReqSize) { reqSize = blockPtr->blockReqSize; } - memcpy(new, ptr, reqSize); + memcpy(newPtr, ptr, reqSize); TclpFree(ptr); } - return new; + return newPtr; } /* diff --git a/generic/tclThreadStorage.c b/generic/tclThreadStorage.c index 6c50139..f791ded 100644 --- a/generic/tclThreadStorage.c +++ b/generic/tclThreadStorage.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclThreadStorage.c,v 1.12.2.1 2007/09/04 17:43:53 dgp Exp $ + * RCS: @(#) $Id: tclThreadStorage.c,v 1.12.2.2 2007/11/21 06:30:55 dgp Exp $ */ #include "tclInt.h" @@ -192,7 +192,7 @@ ThreadStorageGetHashTable( { int index = PTR2UINT(id) % STORAGE_CACHE_SLOTS; Tcl_HashEntry *hPtr; - int new; + int isNew; /* * It's important that we pick up the hash table pointer BEFORE comparing @@ -241,7 +241,7 @@ ThreadStorageGetHashTable( */ hPtr = Tcl_CreateHashEntry(&threadStorageHashTable, (char *) id, - &new); + &isNew); if (hPtr == NULL) { Tcl_Panic("Tcl_CreateHashEntry failed from " diff --git a/generic/tclTomMathInterface.c b/generic/tclTomMathInterface.c index 70dccab..de37436 100644 --- a/generic/tclTomMathInterface.c +++ b/generic/tclTomMathInterface.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclTomMathInterface.c,v 1.8 2007/04/16 13:36:35 dkf Exp $ + * RCS: @(#) $Id: tclTomMathInterface.c,v 1.8.2.1 2007/11/21 06:30:55 dgp Exp $ */ #include "tclInt.h" @@ -65,7 +65,7 @@ TclTommath_Init( *---------------------------------------------------------------------- */ -int +int TclBN_epoch(void) { return TCLTOMMATH_EPOCH; @@ -87,7 +87,7 @@ TclBN_epoch(void) *---------------------------------------------------------------------- */ -int +int TclBN_revision(void) { return TCLTOMMATH_REVISION; diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 4591dbc..9fc9a58 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUtil.c,v 1.82.2.4 2007/11/13 13:07:42 dgp Exp $ + * RCS: @(#) $Id: tclUtil.c,v 1.82.2.5 2007/11/21 06:30:55 dgp Exp $ */ #include "tclInt.h" @@ -19,8 +19,8 @@ #include <math.h> /* - * The absolute pathname of the executable in which this Tcl library - * is running. + * The absolute pathname of the executable in which this Tcl library is + * running. */ static ProcessGlobalValue executableName = { @@ -470,7 +470,7 @@ Tcl_SplitList( } argv[i] = p; if (brace) { - memcpy((void *) p, (void *) element, (size_t) elSize); + memcpy(p, element, (size_t) elSize); p += elSize; *p = 0; p++; @@ -1105,7 +1105,7 @@ Tcl_Concat( if (length == 0) { continue; } - memcpy((void *) p, (void *) element, (size_t) length); + memcpy(p, element, (size_t) length); p += length; *p = ' '; p++; @@ -1153,7 +1153,7 @@ Tcl_ConcatObj( * is only valid when the lists have no current string representation, * since we don't know what the original type was. An original string rep * may have lost some whitespace info when converted which could be - * important. + * important. */ for (i = 0; i < objc; i++) { @@ -1187,7 +1187,7 @@ Tcl_ConcatObj( * Note that all objs at this point are either lists or have an * empty string rep. */ - + objPtr = objv[i]; if (objPtr->bytes && !objPtr->length) { continue; @@ -1234,7 +1234,7 @@ Tcl_ConcatObj( * the terminating NULL byte. */ - concatStr = (char *) ckalloc((unsigned) allocSize); + concatStr = ckalloc((unsigned) allocSize); /* * Now concatenate the elements. Clip white space off the front and back @@ -1271,7 +1271,7 @@ Tcl_ConcatObj( if (elemLength == 0) { continue; /* nothing left of this element */ } - memcpy((void *) p, (void *) element, (size_t) elemLength); + memcpy(p, element, (size_t) elemLength); p += elemLength; *p = ' '; p++; @@ -1798,11 +1798,11 @@ Tcl_DStringAppend( dsPtr->spaceAvl = newSize * 2; if (dsPtr->string == dsPtr->staticSpace) { char *newString = ckalloc((unsigned) dsPtr->spaceAvl); - memcpy((void *) newString, (void *) dsPtr->string, - (size_t) dsPtr->length); + + memcpy(newString, dsPtr->string, (size_t) dsPtr->length); dsPtr->string = newString; } else { - dsPtr->string = (char *) ckrealloc((void *) dsPtr->string, + dsPtr->string = ckrealloc((void *) dsPtr->string, (size_t) dsPtr->spaceAvl); } } @@ -1863,8 +1863,8 @@ Tcl_DStringAppendElement( dsPtr->spaceAvl = newSize * 2; if (dsPtr->string == dsPtr->staticSpace) { char *newString = ckalloc((unsigned) dsPtr->spaceAvl); - memcpy((void *) newString, (void *) dsPtr->string, - (size_t) dsPtr->length); + + memcpy(newString, dsPtr->string, (size_t) dsPtr->length); dsPtr->string = newString; } else { dsPtr->string = (char *) ckrealloc((void *) dsPtr->string, @@ -1945,8 +1945,8 @@ Tcl_DStringSetLength( } if (dsPtr->string == dsPtr->staticSpace) { char *newString = ckalloc((unsigned) dsPtr->spaceAvl); - memcpy((void *) newString, (void *) dsPtr->string, - (size_t) dsPtr->length); + + memcpy(newString, dsPtr->string, (size_t) dsPtr->length); dsPtr->string = newString; } else { dsPtr->string = (char *) ckrealloc((void *) dsPtr->string, @@ -2077,7 +2077,7 @@ Tcl_DStringGetResult( dsPtr->spaceAvl = dsPtr->length+1; } else { dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length+1)); - strcpy(dsPtr->string, iPtr->result); + memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1); (*iPtr->freeProc)(iPtr->result); } dsPtr->spaceAvl = dsPtr->length+1; @@ -2090,7 +2090,7 @@ Tcl_DStringGetResult( dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length + 1)); dsPtr->spaceAvl = dsPtr->length + 1; } - strcpy(dsPtr->string, iPtr->result); + memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1); } iPtr->result = iPtr->resultSpace; @@ -2504,6 +2504,9 @@ TclGetIntForIndex( int *indexPtr) /* Location filled in with an integer * representing an index. */ { + int length; + char *opPtr, *bytes; + if (TclGetIntFromObj(NULL, objPtr, indexPtr) == TCL_OK) { return TCL_OK; } @@ -2515,72 +2518,72 @@ TclGetIntForIndex( */ *indexPtr = endValue + objPtr->internalRep.longValue; + return TCL_OK; + } - } else { - int length; - char *opPtr, *bytes = TclGetStringFromObj(objPtr, &length); + bytes = TclGetStringFromObj(objPtr, &length); - /* Leading whitespace is acceptable in an index */ - while (length && isspace(UCHAR(*bytes))) { /* INTL: ISO space. */ - bytes++; length--; - } + /* + * Leading whitespace is acceptable in an index. + */ - if (TCL_OK == TclParseNumber(NULL, NULL, NULL, - bytes, length, (CONST char **)&opPtr, - TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_WHITESPACE)) { - int code, first, second; - char savedOp = *opPtr; - if ((savedOp != '+') && (savedOp != '-')) { - goto parseError; - } - if (isspace(UCHAR(opPtr[1]))) { - goto parseError; - } - *opPtr = '\0'; - code = Tcl_GetInt(interp, bytes, &first); - *opPtr = savedOp; - if (code == TCL_ERROR) { - goto parseError; - } - if (TCL_ERROR == Tcl_GetInt(interp, opPtr+1, &second)) { - goto parseError; - } - if (savedOp == '+') { - *indexPtr = first + second; - } else { - *indexPtr = first - second; - } - return TCL_OK; + while (length && isspace(UCHAR(*bytes))) { /* INTL: ISO space. */ + bytes++; + length--; + } + + if (TclParseNumber(NULL, NULL, NULL, bytes, length, (const char **)&opPtr, + TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_WHITESPACE) == TCL_OK) { + int code, first, second; + char savedOp = *opPtr; + + if ((savedOp != '+') && (savedOp != '-')) { + goto parseError; + } + if (isspace(UCHAR(opPtr[1]))) { + goto parseError; + } + *opPtr = '\0'; + code = Tcl_GetInt(interp, bytes, &first); + *opPtr = savedOp; + if (code == TCL_ERROR) { + goto parseError; } + if (TCL_ERROR == Tcl_GetInt(interp, opPtr+1, &second)) { + goto parseError; + } + if (savedOp == '+') { + *indexPtr = first + second; + } else { + *indexPtr = first - second; + } + return TCL_OK; + } - /* - * Report a parse error. - */ + /* + * Report a parse error. + */ - parseError: - if (interp != NULL) { - char *bytes = Tcl_GetString(objPtr); + parseError: + if (interp != NULL) { + char *bytes = Tcl_GetString(objPtr); - /* - * The result might not be empty; this resets it which should be - * both a cheap operation, and of little problem because this is - * an error-generation path anyway. - */ + /* + * The result might not be empty; this resets it which should be both + * a cheap operation, and of little problem because this is an + * error-generation path anyway. + */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad index \"", bytes, - "\": must be integer?[+-]integer? or end?[+-]integer?", - (char *) NULL); - if (!strncmp(bytes, "end-", 4)) { - bytes += 4; - } - TclCheckBadOctal(interp, bytes); + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "bad index \"", bytes, + "\": must be integer?[+-]integer? or end?[+-]integer?", NULL); + if (!strncmp(bytes, "end-", 4)) { + bytes += 4; } - - return TCL_ERROR; + TclCheckBadOctal(interp, bytes); } - return TCL_OK; + return TCL_ERROR; } /* @@ -2616,8 +2619,8 @@ UpdateStringOfEndOffset( buffer[len++] = '-'; len += TclFormatInt(buffer+len, -(objPtr->internalRep.longValue)); } - objPtr->bytes = ckalloc((unsigned) (len+1)); - strcpy(objPtr->bytes, buffer); + objPtr->bytes = ckalloc((unsigned) len+1); + memcpy(objPtr->bytes, buffer, (unsigned) len+1); objPtr->length = len; } @@ -2666,7 +2669,7 @@ SetEndOffsetFromAny( if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "bad index \"", bytes, - "\": must be end?[+-]integer?", (char*) NULL); + "\": must be end?[+-]integer?", NULL); } return TCL_ERROR; } @@ -2700,7 +2703,7 @@ SetEndOffsetFromAny( if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "bad index \"", bytes, - "\": must be end?[+-]integer?", (char *) NULL); + "\": must be end?[+-]integer?", NULL); } return TCL_ERROR; } @@ -2774,8 +2777,9 @@ TclCheckBadOctal( * Don't reset the result here because we want this result to * be added to an existing error message as extra info. */ + Tcl_AppendResult(interp, " (looks like invalid octal number)", - (char *) NULL); + NULL); } return 1; } @@ -2928,9 +2932,9 @@ TclSetProcessGlobalValue( } else { Tcl_CreateExitHandler(FreeProcessGlobalValue, (ClientData) pgvPtr); } - bytes = TclGetStringFromObj(newValue, &pgvPtr->numBytes); - pgvPtr->value = ckalloc((unsigned int) pgvPtr->numBytes + 1); - strcpy(pgvPtr->value, bytes); + bytes = Tcl_GetStringFromObj(newValue, &pgvPtr->numBytes); + pgvPtr->value = ckalloc((unsigned) pgvPtr->numBytes + 1); + memcpy(pgvPtr->value, bytes, (unsigned) pgvPtr->numBytes + 1); if (pgvPtr->encoding) { Tcl_FreeEncoding(pgvPtr->encoding); } @@ -2997,7 +3001,7 @@ TclGetProcessGlobalValue( ckfree(pgvPtr->value); pgvPtr->value = ckalloc((unsigned int) Tcl_DStringLength(&newValue) + 1); - memcpy((void*) pgvPtr->value, (void*) Tcl_DStringValue(&newValue), + memcpy(pgvPtr->value, Tcl_DStringValue(&newValue), (size_t) Tcl_DStringLength(&newValue) + 1); Tcl_DStringFree(&newValue); Tcl_FreeEncoding(pgvPtr->encoding); @@ -3126,8 +3130,9 @@ CONST char * Tcl_GetNameOfExecutable(void) { int numBytes; - CONST char * bytes = + const char *bytes = Tcl_GetStringFromObj(TclGetObjNameOfExecutable(), &numBytes); + if (numBytes == 0) { return NULL; } @@ -3190,11 +3195,11 @@ TclGetPlatform(void) * Attempt to convert a regular expression to an equivalent glob pattern. * * Results: - * Returns TCL_OK on success, TCL_ERROR on failure. - * If interp is not NULL, an error message is placed in the result. - * On success, the DString will contain an exact equivalent glob pattern. - * The caller is responsible for calling Tcl_DStringFree on success. - * If exactPtr is not NULL, it will be 1 if an exact match qualifies. + * Returns TCL_OK on success, TCL_ERROR on failure. If interp is not + * NULL, an error message is placed in the result. On success, the + * DString will contain an exact equivalent glob pattern. The caller is + * responsible for calling Tcl_DStringFree on success. If exactPtr is not + * NULL, it will be 1 if an exact match qualifies. * * Side effects: * None. @@ -3203,11 +3208,12 @@ TclGetPlatform(void) */ int -TclReToGlob(Tcl_Interp *interp, - const char *reStr, - int reStrLen, - Tcl_DString *dsPtr, - int *exactPtr) +TclReToGlob( + Tcl_Interp *interp, + const char *reStr, + int reStrLen, + Tcl_DString *dsPtr, + int *exactPtr) { int anchorLeft, anchorRight; char *dsStr, *dsStrStart, *msg; @@ -3255,80 +3261,80 @@ TclReToGlob(Tcl_Interp *interp, for ( ; p < strEnd; p++) { switch (*p) { - case '\\': - p++; - switch (*p) { - case 'a': - *dsStr++ = '\a'; - break; - case 'b': - *dsStr++ = '\b'; - break; - case 'f': - *dsStr++ = '\f'; - break; - case 'n': - *dsStr++ = '\n'; - break; - case 'r': - *dsStr++ = '\r'; - break; - case 't': - *dsStr++ = '\t'; - break; - case 'v': - *dsStr++ = '\v'; - break; - case 'B': - *dsStr++ = '\\'; - *dsStr++ = '\\'; - anchorLeft = 0; /* prevent exact match */ - break; - case '\\': case '*': case '+': case '?': - case '{': case '}': case '(': case ')': case '[': case ']': - case '.': case '|': case '^': case '$': - *dsStr++ = '\\'; - *dsStr++ = *p; - anchorLeft = 0; /* prevent exact match */ - break; - default: - msg = "invalid escape sequence"; - goto invalidGlob; - } + case '\\': + p++; + switch (*p) { + case 'a': + *dsStr++ = '\a'; break; - case '.': - anchorLeft = 0; /* prevent exact match */ - if (p+1 < strEnd) { - if (p[1] == '*') { - p++; - if ((dsStr == dsStrStart) || (dsStr[-1] != '*')) { - *dsStr++ = '*'; - } - continue; - } else if (p[1] == '+') { - p++; - *dsStr++ = '?'; - *dsStr++ = '*'; - continue; - } - } - *dsStr++ = '?'; + case 'b': + *dsStr++ = '\b'; break; - case '$': - if (p+1 != strEnd) { - msg = "$ not anchor"; - goto invalidGlob; - } - anchorRight = 1; + case 'f': + *dsStr++ = '\f'; break; - case '*': case '+': case '?': case '|': case '^': - case '{': case '}': case '(': case ')': case '[': case ']': - msg = "unhandled RE special char"; - goto invalidGlob; + case 'n': + *dsStr++ = '\n'; break; - default: + case 'r': + *dsStr++ = '\r'; + break; + case 't': + *dsStr++ = '\t'; + break; + case 'v': + *dsStr++ = '\v'; + break; + case 'B': + *dsStr++ = '\\'; + *dsStr++ = '\\'; + anchorLeft = 0; /* prevent exact match */ + break; + case '\\': case '*': case '+': case '?': + case '{': case '}': case '(': case ')': case '[': case ']': + case '.': case '|': case '^': case '$': + *dsStr++ = '\\'; *dsStr++ = *p; + anchorLeft = 0; /* prevent exact match */ break; + default: + msg = "invalid escape sequence"; + goto invalidGlob; + } + break; + case '.': + anchorLeft = 0; /* prevent exact match */ + if (p+1 < strEnd) { + if (p[1] == '*') { + p++; + if ((dsStr == dsStrStart) || (dsStr[-1] != '*')) { + *dsStr++ = '*'; + } + continue; + } else if (p[1] == '+') { + p++; + *dsStr++ = '?'; + *dsStr++ = '*'; + continue; + } + } + *dsStr++ = '?'; + break; + case '$': + if (p+1 != strEnd) { + msg = "$ not anchor"; + goto invalidGlob; + } + anchorRight = 1; + break; + case '*': case '+': case '?': case '|': case '^': + case '{': case '}': case '(': case ')': case '[': case ']': + msg = "unhandled RE special char"; + goto invalidGlob; + break; + default: + *dsStr++ = *p; + break; } } if (!anchorRight && ((dsStr == dsStrStart) || (dsStr[-1] != '*'))) { @@ -3348,7 +3354,7 @@ TclReToGlob(Tcl_Interp *interp, #endif return TCL_OK; - invalidGlob: + invalidGlob: #if 0 fprintf(stderr, "INPUT RE '%.*s' NO OUTPUT GLOB %s (%c)\n", reStrLen, reStr, msg, *p); diff --git a/generic/tclVar.c b/generic/tclVar.c index 565d04a..35254b6 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.135.2.11 2007/11/16 07:20:54 dgp Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.135.2.12 2007/11/21 06:30:55 dgp Exp $ */ #include "tclInt.h" @@ -25,8 +25,7 @@ * Prototypes for the variable hash key methods. */ -static Tcl_HashEntry * AllocVarEntry(Tcl_HashTable *tablePtr, - void *keyPtr); +static Tcl_HashEntry * AllocVarEntry(Tcl_HashTable *tablePtr, void *keyPtr); static void FreeVarEntry(Tcl_HashEntry *hPtr); static int CompareVarKeys(void *keyPtr, Tcl_HashEntry *hPtr); static unsigned int HashVarKey(Tcl_HashTable *tablePtr, void *keyPtr); @@ -160,7 +159,8 @@ static ArraySearch * ParseSearchId(Tcl_Interp *interp, const Var *varPtr, static void UnsetVarStruct(Var *varPtr, Var *arrayPtr, Interp *iPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); -static int SetArraySearchObj(Tcl_Interp *interp, Tcl_Obj *objPtr); +static int SetArraySearchObj(Tcl_Interp *interp, + Tcl_Obj *objPtr); /* * Functions defined in this file that may be exported in the future for use @@ -234,8 +234,8 @@ static Tcl_ObjType tclParsedVarNameType = { * Type of Tcl_Objs used to speed up array searches. * * INTERNALREP DEFINITION: - * twoPtrValue.ptr1: searchIdNumber as offset from (char*)NULL - * twoPtrValue.ptr2: variableNameStartInString as offset from (char*)NULL + * twoPtrValue.ptr1: searchIdNumber (cast to pointer) + * twoPtrValue.ptr2: variableNameStartInString (cast to pointer) * * Note that the value stored in ptr2 is the offset into the string of the * start of the variable name and not the address of the variable name itself, @@ -788,9 +788,10 @@ TclObjLookupVarEx( } /* - * This flag bit should not interfere with TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, - * or TCL_LEAVE_ERR_MSG; it signals that the variable lookup is performed for - * upvar (or similar) purposes, with slightly different rules: + * This flag bit should not interfere with TCL_GLOBAL_ONLY, + * TCL_NAMESPACE_ONLY, or TCL_LEAVE_ERR_MSG; it signals that the variable + * lookup is performed for upvar (or similar) purposes, with slightly + * different rules: * - 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 @@ -870,7 +871,7 @@ TclLookupSimpleVar( * the variable. */ Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr; ResolverScheme *resPtr; - int new, i, result; + int isNew, i, result; const char *varName = TclGetString(varNamePtr); varPtr = NULL; @@ -977,7 +978,8 @@ TclLookupSimpleVar( } else { tailPtr = varNamePtr; } - varPtr = VarHashCreateVar(&varNsPtr->varTable, tailPtr, &new); + varPtr = VarHashCreateVar(&varNsPtr->varTable, tailPtr, + &isNew); if (lookGlobal) { /* * The variable was created starting from the global @@ -1020,7 +1022,7 @@ TclLookupSimpleVar( TclInitVarHashTable(tablePtr, NULL); varFramePtr->varTablePtr = tablePtr; } - varPtr = VarHashCreateVar(tablePtr, varNamePtr, &new); + varPtr = VarHashCreateVar(tablePtr, varNamePtr, &isNew); } else { varPtr = NULL; if (tablePtr != NULL) { @@ -1091,7 +1093,7 @@ TclLookupArrayElement( Var *arrayPtr, /* Pointer to the array's Var structure. */ int index) /* If >=0, the index of the local array. */ { - int new; + int isNew; Var *varPtr; TclVarHashTable *tablePtr; Namespace *nsPtr; @@ -1142,8 +1144,9 @@ TclLookupArrayElement( } if (createElem) { - varPtr = VarHashCreateVar(arrayPtr->value.tablePtr, elNamePtr, &new); - if (new) { + varPtr = VarHashCreateVar(arrayPtr->value.tablePtr, elNamePtr, + &isNew); + if (isNew) { if (arrayPtr->flags & VAR_SEARCH_ACTIVE) { DeleteSearches((Interp *) interp, arrayPtr); } @@ -1465,7 +1468,7 @@ Tcl_SetObjCmd( Tcl_Obj *varValueObj; if (objc == 2) { - varValueObj = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG); + varValueObj = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG); if (varValueObj == NULL) { return TCL_ERROR; } @@ -1494,12 +1497,12 @@ Tcl_SetObjCmd( * * Results: * Returns a pointer to the malloc'ed string which is the character - * representation of the variable's new value. The caller must not - * modify this string. If the write operation was disallowed then NULL - * is returned; if the TCL_LEAVE_ERR_MSG flag is set, then an - * explanatory message will be left in the interp's result. Note that the - * returned string may not be the same as newValue; this is because - * variable traces may modify the variable's value. + * representation of the variable's new value. The caller must not modify + * this string. If the write operation was disallowed then NULL is + * returned; if the TCL_LEAVE_ERR_MSG flag is set, then an explanatory + * message will be left in the interp's result. Note that the returned + * string may not be the same as newValue; this is because variable + * traces may modify the variable's value. * * Side effects: * If varName is defined as a local or global variable in interp, its @@ -1751,7 +1754,8 @@ TclPtrSetVar( * variable, or NULL if the variable is a * scalar. */ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or - * the name of a variable. NULL if index >= 0*/ + * the name of a variable. NULL if the 'index' + * parameter is >= 0 */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ Tcl_Obj *newValuePtr, /* New value for variable. */ @@ -1792,7 +1796,7 @@ TclPtrSetVar( if (TclIsVarArray(varPtr)) { if (flags & TCL_LEAVE_ERR_MSG) { - TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", isArray, index); + TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", isArray,index); } goto earlyError; } @@ -1864,7 +1868,7 @@ TclPtrSetVar( varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr); TclDecrRefCount(oldValuePtr); oldValuePtr = varPtr->value.objPtr; - Tcl_IncrRefCount(oldValuePtr); /* Since var is ref. */ + Tcl_IncrRefCount(oldValuePtr); /* Since var is ref */ } Tcl_AppendObjToObj(oldValuePtr, newValuePtr); } @@ -1888,10 +1892,9 @@ TclPtrSetVar( if ((varPtr->flags & VAR_TRACED_WRITE) || (arrayPtr && (arrayPtr->flags & VAR_TRACED_WRITE))) { - if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr, - part1Ptr, part2Ptr, - (flags&(TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))|TCL_TRACE_WRITES, - (flags & TCL_LEAVE_ERR_MSG), index)) { + if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr, + part2Ptr, (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) + | TCL_TRACE_WRITES, (flags & TCL_LEAVE_ERR_MSG), index)) { goto cleanup; } } @@ -2286,7 +2289,6 @@ UnsetVarStruct( DeleteSearches(iPtr, varPtr); } - /* * The code below is tricky, because of the possibility that a trace * function might try to access a variable being deleted. To handle this @@ -2325,7 +2327,7 @@ UnsetVarStruct( int isNew; Tcl_HashEntry *tPtr = - Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); + Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); tracePtr = Tcl_GetHashValue(tPtr); varPtr->flags &= ~VAR_ALL_TRACES; @@ -2362,7 +2364,7 @@ UnsetVarStruct( Tcl_EventuallyFree((ClientData) prevPtr, TCL_DYNAMIC); } for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; - activePtr = activePtr->nextPtr) { + activePtr = activePtr->nextPtr) { if (activePtr->varPtr == varPtr) { activePtr->nextTracePtr = NULL; } @@ -2517,7 +2519,7 @@ Tcl_AppendObjCmd( } if (objc == 2) { - varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG); + varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG); if (varValuePtr == NULL) { return TCL_ERROR; } @@ -2535,8 +2537,8 @@ Tcl_AppendObjCmd( * variable again. */ - varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, objv[1], NULL, - objv[i], (TCL_APPEND_VALUE | TCL_LEAVE_ERR_MSG), -1); + varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, objv[1], + NULL, objv[i], TCL_APPEND_VALUE|TCL_LEAVE_ERR_MSG, -1); if (varValuePtr == NULL) { return TCL_ERROR; } @@ -2759,9 +2761,9 @@ Tcl_ArrayObjCmd( if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY) && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) { - if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNamePtr, - NULL, (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY| - TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1)) { + if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNamePtr, NULL, + (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY| + TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) { return TCL_ERROR; } } @@ -2880,7 +2882,7 @@ Tcl_ArrayObjCmd( } case ARRAY_STARTSEARCH: { ArraySearch *searchPtr; - int new; + int isNew; char *varName = TclGetString(varNamePtr); if (objc != 3) { @@ -2892,8 +2894,8 @@ Tcl_ArrayObjCmd( } searchPtr = (ArraySearch *) ckalloc(sizeof(ArraySearch)); hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, - (char *) varPtr, &new); - if (new) { + (char *) varPtr, &isNew); + if (isNew) { searchPtr->id = 1; Tcl_AppendResult(interp, "s-1-", varName, NULL); varPtr->flags |= VAR_SEARCH_ACTIVE; @@ -2994,7 +2996,8 @@ Tcl_ArrayObjCmd( */ TclNewObj(tmpResPtr); - result = TclListObjGetElements(interp, nameLstPtr, &count, &namePtrPtr); + result = Tcl_ListObjGetElements(interp, nameLstPtr, &count, + &namePtrPtr); if (result != TCL_OK) { goto errorInArrayGet; } @@ -3218,7 +3221,7 @@ Tcl_ArrayObjCmd( Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1)); ckfree((void *)stats); } else { - Tcl_SetResult(interp, "error reading array statistics",TCL_STATIC); + Tcl_SetResult(interp,"error reading array statistics",TCL_STATIC); return TCL_ERROR; } break; @@ -3470,9 +3473,9 @@ ObjMakeUpvar( */ if (index < 0) { - if ((0 == (arrayPtr + if (!(arrayPtr != NULL ? (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr)) - : (TclIsVarInHash(otherPtr) && TclGetVarNsPtr(otherPtr)))) + : (TclIsVarInHash(otherPtr) && TclGetVarNsPtr(otherPtr))) && ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) || (varFramePtr == NULL) || !HasLocalVars(varFramePtr) @@ -3550,10 +3553,8 @@ TclPtrObjMakeUpvar( { Interp *iPtr = (Interp *) interp; CallFrame *varFramePtr = iPtr->varFramePtr; + const char *errMsg, *p, *myName; Var *varPtr; - const char *errMsg; - const char *p; - const char *myName; if (index >= 0) { if (!HasLocalVars(varFramePtr)) { @@ -3596,7 +3597,7 @@ TclPtrObjMakeUpvar( */ varPtr = TclLookupSimpleVar(interp, myNamePtr, - (myFlags|AVOID_RESOLVERS), /* create */ 1, &errMsg, &index); + myFlags|AVOID_RESOLVERS, /* create */ 1, &errMsg, &index); if (varPtr == NULL) { TclObjVarErrMsg(interp, myNamePtr, NULL, "create", errMsg, -1); return TCL_ERROR; @@ -4167,13 +4168,12 @@ SetArraySearchObj( TclFreeIntRep(objPtr); objPtr->typePtr = &tclArraySearchType; - /* Do NOT optimize this address arithmetic! */ - objPtr->internalRep.twoPtrValue.ptr1 = (void *)(((char *)NULL) + id); - objPtr->internalRep.twoPtrValue.ptr2 = (void *)(((char *)NULL) + offset); + objPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(id); + objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(offset); return TCL_OK; syntax: - Tcl_AppendResult(interp, "illegal search identifier \"",string,"\"", NULL); + Tcl_AppendResult(interp, "illegal search identifier \"",string,"\"",NULL); return TCL_ERROR; } @@ -4224,15 +4224,20 @@ ParseSearchId( } /* - * Cast is safe, since always came from an int in the first place. Do NOT - * optimize this address arithmetic! + * Extract the information out of the Tcl_Obj. */ +#if 1 + id = PTR2INT(handleObj->internalRep.twoPtrValue.ptr1); + string = TclGetString(handleObj); + offset = PTR2INT(handleObj->internalRep.twoPtrValue.ptr2); +#else id = (int)(((char *) handleObj->internalRep.twoPtrValue.ptr1) - ((char *) NULL)); string = TclGetString(handleObj); offset = (((char *) handleObj->internalRep.twoPtrValue.ptr2) - ((char *) NULL)); +#endif /* * This test cannot be placed inside the Tcl_Obj machinery, since it is @@ -5111,7 +5116,7 @@ TclInfoVarsCmd( if (specificNsInPattern) { elemObjPtr = Tcl_NewObj(); Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, - elemObjPtr); + elemObjPtr); } else { elemObjPtr = VarHashGetKey(varPtr); } diff --git a/library/init.tcl b/library/init.tcl index 4c2d646..e19af00 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -3,7 +3,7 @@ # Default system startup file for Tcl-based applications. Defines # "unknown" procedure and auto-load facilities. # -# RCS: @(#) $Id: init.tcl,v 1.91.2.5 2007/10/27 04:11:47 dgp Exp $ +# RCS: @(#) $Id: init.tcl,v 1.91.2.6 2007/11/21 06:30:55 dgp Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. diff --git a/library/tzdata/Africa/Cairo b/library/tzdata/Africa/Cairo index 0ae874f..d812a44 100644 --- a/library/tzdata/Africa/Cairo +++ b/library/tzdata/Africa/Cairo @@ -118,187 +118,187 @@ set TZData(:Africa/Cairo) { {1177624800 10800 1 EEST} {1189112400 7200 0 EET} {1209074400 10800 1 EEST} - {1220562000 7200 0 EET} + {1219957200 7200 0 EET} {1240524000 10800 1 EEST} - {1252011600 7200 0 EET} + {1251406800 7200 0 EET} {1272578400 10800 1 EEST} - {1283461200 7200 0 EET} + {1282856400 7200 0 EET} {1304028000 10800 1 EEST} - {1314910800 7200 0 EET} + {1314306000 7200 0 EET} {1335477600 10800 1 EEST} - {1346965200 7200 0 EET} + {1346360400 7200 0 EET} {1366927200 10800 1 EEST} - {1378414800 7200 0 EET} + {1377810000 7200 0 EET} {1398376800 10800 1 EEST} - {1409864400 7200 0 EET} + {1409259600 7200 0 EET} {1429826400 10800 1 EEST} - {1441314000 7200 0 EET} + {1440709200 7200 0 EET} {1461880800 10800 1 EEST} - {1472763600 7200 0 EET} + {1472158800 7200 0 EET} {1493330400 10800 1 EEST} - {1504818000 7200 0 EET} + {1504213200 7200 0 EET} {1524780000 10800 1 EEST} - {1536267600 7200 0 EET} + {1535662800 7200 0 EET} {1556229600 10800 1 EEST} - {1567717200 7200 0 EET} + {1567112400 7200 0 EET} {1587679200 10800 1 EEST} - {1599166800 7200 0 EET} + {1598562000 7200 0 EET} {1619733600 10800 1 EEST} - {1630616400 7200 0 EET} + {1630011600 7200 0 EET} {1651183200 10800 1 EEST} - {1662066000 7200 0 EET} + {1661461200 7200 0 EET} {1682632800 10800 1 EEST} - {1694120400 7200 0 EET} + {1693515600 7200 0 EET} {1714082400 10800 1 EEST} - {1725570000 7200 0 EET} + {1724965200 7200 0 EET} {1745532000 10800 1 EEST} - {1757019600 7200 0 EET} + {1756414800 7200 0 EET} {1776981600 10800 1 EEST} - {1788469200 7200 0 EET} + {1787864400 7200 0 EET} {1809036000 10800 1 EEST} - {1819918800 7200 0 EET} + {1819314000 7200 0 EET} {1840485600 10800 1 EEST} - {1851973200 7200 0 EET} + {1851368400 7200 0 EET} {1871935200 10800 1 EEST} - {1883422800 7200 0 EET} + {1882818000 7200 0 EET} {1903384800 10800 1 EEST} - {1914872400 7200 0 EET} + {1914267600 7200 0 EET} {1934834400 10800 1 EEST} - {1946322000 7200 0 EET} + {1945717200 7200 0 EET} {1966888800 10800 1 EEST} - {1977771600 7200 0 EET} + {1977166800 7200 0 EET} {1998338400 10800 1 EEST} - {2009221200 7200 0 EET} + {2008616400 7200 0 EET} {2029788000 10800 1 EEST} - {2041275600 7200 0 EET} + {2040670800 7200 0 EET} {2061237600 10800 1 EEST} - {2072725200 7200 0 EET} + {2072120400 7200 0 EET} {2092687200 10800 1 EEST} - {2104174800 7200 0 EET} + {2103570000 7200 0 EET} {2124136800 10800 1 EEST} - {2135624400 7200 0 EET} + {2135019600 7200 0 EET} {2156191200 10800 1 EEST} - {2167074000 7200 0 EET} + {2166469200 7200 0 EET} {2187640800 10800 1 EEST} - {2198523600 7200 0 EET} + {2197918800 7200 0 EET} {2219090400 10800 1 EEST} - {2230578000 7200 0 EET} + {2229973200 7200 0 EET} {2250540000 10800 1 EEST} - {2262027600 7200 0 EET} + {2261422800 7200 0 EET} {2281989600 10800 1 EEST} - {2293477200 7200 0 EET} + {2292872400 7200 0 EET} {2313439200 10800 1 EEST} - {2324926800 7200 0 EET} + {2324322000 7200 0 EET} {2345493600 10800 1 EEST} - {2356376400 7200 0 EET} + {2355771600 7200 0 EET} {2376943200 10800 1 EEST} - {2388430800 7200 0 EET} + {2387826000 7200 0 EET} {2408392800 10800 1 EEST} - {2419880400 7200 0 EET} + {2419275600 7200 0 EET} {2439842400 10800 1 EEST} - {2451330000 7200 0 EET} + {2450725200 7200 0 EET} {2471292000 10800 1 EEST} - {2482779600 7200 0 EET} + {2482174800 7200 0 EET} {2503346400 10800 1 EEST} - {2514229200 7200 0 EET} + {2513624400 7200 0 EET} {2534796000 10800 1 EEST} - {2545678800 7200 0 EET} + {2545074000 7200 0 EET} {2566245600 10800 1 EEST} - {2577733200 7200 0 EET} + {2577128400 7200 0 EET} {2597695200 10800 1 EEST} - {2609182800 7200 0 EET} + {2608578000 7200 0 EET} {2629144800 10800 1 EEST} - {2640632400 7200 0 EET} + {2640027600 7200 0 EET} {2660594400 10800 1 EEST} - {2672082000 7200 0 EET} + {2671477200 7200 0 EET} {2692648800 10800 1 EEST} - {2703531600 7200 0 EET} + {2702926800 7200 0 EET} {2724098400 10800 1 EEST} - {2735586000 7200 0 EET} + {2734981200 7200 0 EET} {2755548000 10800 1 EEST} - {2767035600 7200 0 EET} + {2766430800 7200 0 EET} {2786997600 10800 1 EEST} - {2798485200 7200 0 EET} + {2797880400 7200 0 EET} {2818447200 10800 1 EEST} - {2829934800 7200 0 EET} + {2829330000 7200 0 EET} {2850501600 10800 1 EEST} - {2861384400 7200 0 EET} + {2860779600 7200 0 EET} {2881951200 10800 1 EEST} - {2892834000 7200 0 EET} + {2892229200 7200 0 EET} {2913400800 10800 1 EEST} - {2924888400 7200 0 EET} + {2924283600 7200 0 EET} {2944850400 10800 1 EEST} - {2956338000 7200 0 EET} + {2955733200 7200 0 EET} {2976300000 10800 1 EEST} - {2987787600 7200 0 EET} + {2987182800 7200 0 EET} {3007749600 10800 1 EEST} - {3019237200 7200 0 EET} + {3018632400 7200 0 EET} {3039804000 10800 1 EEST} - {3050686800 7200 0 EET} + {3050082000 7200 0 EET} {3071253600 10800 1 EEST} - {3082136400 7200 0 EET} + {3081531600 7200 0 EET} {3102703200 10800 1 EEST} - {3114190800 7200 0 EET} + {3113586000 7200 0 EET} {3134152800 10800 1 EEST} - {3145640400 7200 0 EET} + {3145035600 7200 0 EET} {3165602400 10800 1 EEST} - {3177090000 7200 0 EET} + {3176485200 7200 0 EET} {3197052000 10800 1 EEST} - {3208539600 7200 0 EET} + {3207934800 7200 0 EET} {3229106400 10800 1 EEST} - {3239989200 7200 0 EET} + {3239384400 7200 0 EET} {3260556000 10800 1 EEST} - {3272043600 7200 0 EET} + {3271438800 7200 0 EET} {3292005600 10800 1 EEST} - {3303493200 7200 0 EET} + {3302888400 7200 0 EET} {3323455200 10800 1 EEST} - {3334942800 7200 0 EET} + {3334338000 7200 0 EET} {3354904800 10800 1 EEST} - {3366392400 7200 0 EET} + {3365787600 7200 0 EET} {3386959200 10800 1 EEST} - {3397842000 7200 0 EET} + {3397237200 7200 0 EET} {3418408800 10800 1 EEST} - {3429291600 7200 0 EET} + {3428686800 7200 0 EET} {3449858400 10800 1 EEST} - {3461346000 7200 0 EET} + {3460741200 7200 0 EET} {3481308000 10800 1 EEST} - {3492795600 7200 0 EET} + {3492190800 7200 0 EET} {3512757600 10800 1 EEST} - {3524245200 7200 0 EET} + {3523640400 7200 0 EET} {3544207200 10800 1 EEST} - {3555694800 7200 0 EET} + {3555090000 7200 0 EET} {3576261600 10800 1 EEST} - {3587144400 7200 0 EET} + {3586539600 7200 0 EET} {3607711200 10800 1 EEST} - {3619198800 7200 0 EET} + {3618594000 7200 0 EET} {3639160800 10800 1 EEST} - {3650648400 7200 0 EET} + {3650043600 7200 0 EET} {3670610400 10800 1 EEST} - {3682098000 7200 0 EET} + {3681493200 7200 0 EET} {3702060000 10800 1 EEST} - {3713547600 7200 0 EET} + {3712942800 7200 0 EET} {3734114400 10800 1 EEST} - {3744997200 7200 0 EET} + {3744392400 7200 0 EET} {3765564000 10800 1 EEST} - {3776446800 7200 0 EET} + {3775842000 7200 0 EET} {3797013600 10800 1 EEST} - {3808501200 7200 0 EET} + {3807896400 7200 0 EET} {3828463200 10800 1 EEST} - {3839950800 7200 0 EET} + {3839346000 7200 0 EET} {3859912800 10800 1 EEST} - {3871400400 7200 0 EET} + {3870795600 7200 0 EET} {3891362400 10800 1 EEST} - {3902850000 7200 0 EET} + {3902245200 7200 0 EET} {3923416800 10800 1 EEST} - {3934299600 7200 0 EET} + {3933694800 7200 0 EET} {3954866400 10800 1 EEST} - {3965749200 7200 0 EET} + {3965144400 7200 0 EET} {3986316000 10800 1 EEST} - {3997803600 7200 0 EET} + {3997198800 7200 0 EET} {4017765600 10800 1 EEST} - {4029253200 7200 0 EET} + {4028648400 7200 0 EET} {4049215200 10800 1 EEST} - {4060702800 7200 0 EET} + {4060098000 7200 0 EET} {4080664800 10800 1 EEST} - {4092152400 7200 0 EET} + {4091547600 7200 0 EET} } diff --git a/library/tzdata/America/Campo_Grande b/library/tzdata/America/Campo_Grande index 7f9ac17..ced6197 100644 --- a/library/tzdata/America/Campo_Grande +++ b/library/tzdata/America/Campo_Grande @@ -69,189 +69,189 @@ set TZData(:America/Campo_Grande) { {1140318000 -14400 0 AMT} {1162699200 -10800 1 AMST} {1172372400 -14400 0 AMT} - {1194148800 -10800 1 AMST} - {1203822000 -14400 0 AMT} - {1225598400 -10800 1 AMST} - {1235271600 -14400 0 AMT} - {1257048000 -10800 1 AMST} - {1267326000 -14400 0 AMT} - {1289102400 -10800 1 AMST} - {1298775600 -14400 0 AMT} - {1320552000 -10800 1 AMST} - {1330225200 -14400 0 AMT} - {1352001600 -10800 1 AMST} - {1361674800 -14400 0 AMT} - {1383451200 -10800 1 AMST} - {1393124400 -14400 0 AMT} - {1414900800 -10800 1 AMST} - {1424574000 -14400 0 AMT} - {1446350400 -10800 1 AMST} - {1456628400 -14400 0 AMT} - {1478404800 -10800 1 AMST} - {1488078000 -14400 0 AMT} - {1509854400 -10800 1 AMST} - {1519527600 -14400 0 AMT} - {1541304000 -10800 1 AMST} - {1550977200 -14400 0 AMT} - {1572753600 -10800 1 AMST} - {1582426800 -14400 0 AMT} - {1604203200 -10800 1 AMST} - {1614481200 -14400 0 AMT} - {1636257600 -10800 1 AMST} - {1645930800 -14400 0 AMT} - {1667707200 -10800 1 AMST} - {1677380400 -14400 0 AMT} - {1699156800 -10800 1 AMST} - {1708830000 -14400 0 AMT} - {1730606400 -10800 1 AMST} - {1740279600 -14400 0 AMT} - {1762056000 -10800 1 AMST} - {1771729200 -14400 0 AMT} - {1793505600 -10800 1 AMST} - {1803783600 -14400 0 AMT} - {1825560000 -10800 1 AMST} - {1835233200 -14400 0 AMT} - {1857009600 -10800 1 AMST} - {1866682800 -14400 0 AMT} - {1888459200 -10800 1 AMST} - {1898132400 -14400 0 AMT} - {1919908800 -10800 1 AMST} - {1929582000 -14400 0 AMT} - {1951358400 -10800 1 AMST} - {1961636400 -14400 0 AMT} - {1983412800 -10800 1 AMST} - {1993086000 -14400 0 AMT} - {2014862400 -10800 1 AMST} - {2024535600 -14400 0 AMT} - {2046312000 -10800 1 AMST} - {2055985200 -14400 0 AMT} - {2077761600 -10800 1 AMST} - {2087434800 -14400 0 AMT} - {2109211200 -10800 1 AMST} - {2118884400 -14400 0 AMT} - {2140660800 -10800 1 AMST} - {2150938800 -14400 0 AMT} - {2172715200 -10800 1 AMST} - {2182388400 -14400 0 AMT} - {2204164800 -10800 1 AMST} - {2213838000 -14400 0 AMT} - {2235614400 -10800 1 AMST} - {2245287600 -14400 0 AMT} - {2267064000 -10800 1 AMST} - {2276737200 -14400 0 AMT} - {2298513600 -10800 1 AMST} - {2308186800 -14400 0 AMT} - {2329963200 -10800 1 AMST} - {2340241200 -14400 0 AMT} - {2362017600 -10800 1 AMST} - {2371690800 -14400 0 AMT} - {2393467200 -10800 1 AMST} - {2403140400 -14400 0 AMT} - {2424916800 -10800 1 AMST} - {2434590000 -14400 0 AMT} - {2456366400 -10800 1 AMST} - {2466039600 -14400 0 AMT} - {2487816000 -10800 1 AMST} - {2498094000 -14400 0 AMT} - {2519870400 -10800 1 AMST} - {2529543600 -14400 0 AMT} - {2551320000 -10800 1 AMST} - {2560993200 -14400 0 AMT} - {2582769600 -10800 1 AMST} - {2592442800 -14400 0 AMT} - {2614219200 -10800 1 AMST} - {2623892400 -14400 0 AMT} - {2645668800 -10800 1 AMST} - {2655342000 -14400 0 AMT} - {2677118400 -10800 1 AMST} - {2687396400 -14400 0 AMT} - {2709172800 -10800 1 AMST} - {2718846000 -14400 0 AMT} - {2740622400 -10800 1 AMST} - {2750295600 -14400 0 AMT} - {2772072000 -10800 1 AMST} - {2781745200 -14400 0 AMT} - {2803521600 -10800 1 AMST} - {2813194800 -14400 0 AMT} - {2834971200 -10800 1 AMST} - {2845249200 -14400 0 AMT} - {2867025600 -10800 1 AMST} - {2876698800 -14400 0 AMT} - {2898475200 -10800 1 AMST} - {2908148400 -14400 0 AMT} - {2929924800 -10800 1 AMST} - {2939598000 -14400 0 AMT} - {2961374400 -10800 1 AMST} - {2971047600 -14400 0 AMT} - {2992824000 -10800 1 AMST} - {3002497200 -14400 0 AMT} - {3024273600 -10800 1 AMST} - {3034551600 -14400 0 AMT} - {3056328000 -10800 1 AMST} - {3066001200 -14400 0 AMT} - {3087777600 -10800 1 AMST} - {3097450800 -14400 0 AMT} - {3119227200 -10800 1 AMST} - {3128900400 -14400 0 AMT} - {3150676800 -10800 1 AMST} - {3160350000 -14400 0 AMT} - {3182126400 -10800 1 AMST} - {3191799600 -14400 0 AMT} - {3213576000 -10800 1 AMST} - {3223854000 -14400 0 AMT} - {3245630400 -10800 1 AMST} - {3255303600 -14400 0 AMT} - {3277080000 -10800 1 AMST} - {3286753200 -14400 0 AMT} - {3308529600 -10800 1 AMST} - {3318202800 -14400 0 AMT} - {3339979200 -10800 1 AMST} - {3349652400 -14400 0 AMT} - {3371428800 -10800 1 AMST} - {3381706800 -14400 0 AMT} - {3403483200 -10800 1 AMST} - {3413156400 -14400 0 AMT} - {3434932800 -10800 1 AMST} - {3444606000 -14400 0 AMT} - {3466382400 -10800 1 AMST} - {3476055600 -14400 0 AMT} - {3497832000 -10800 1 AMST} - {3507505200 -14400 0 AMT} - {3529281600 -10800 1 AMST} - {3538954800 -14400 0 AMT} - {3560731200 -10800 1 AMST} - {3571009200 -14400 0 AMT} - {3592785600 -10800 1 AMST} - {3602458800 -14400 0 AMT} - {3624235200 -10800 1 AMST} - {3633908400 -14400 0 AMT} - {3655684800 -10800 1 AMST} - {3665358000 -14400 0 AMT} - {3687134400 -10800 1 AMST} - {3696807600 -14400 0 AMT} - {3718584000 -10800 1 AMST} - {3728862000 -14400 0 AMT} - {3750638400 -10800 1 AMST} - {3760311600 -14400 0 AMT} - {3782088000 -10800 1 AMST} - {3791761200 -14400 0 AMT} - {3813537600 -10800 1 AMST} - {3823210800 -14400 0 AMT} - {3844987200 -10800 1 AMST} - {3854660400 -14400 0 AMT} - {3876436800 -10800 1 AMST} - {3886110000 -14400 0 AMT} - {3907886400 -10800 1 AMST} - {3918164400 -14400 0 AMT} - {3939940800 -10800 1 AMST} - {3949614000 -14400 0 AMT} - {3971390400 -10800 1 AMST} - {3981063600 -14400 0 AMT} - {4002840000 -10800 1 AMST} - {4012513200 -14400 0 AMT} - {4034289600 -10800 1 AMST} - {4043962800 -14400 0 AMT} - {4065739200 -10800 1 AMST} - {4075412400 -14400 0 AMT} - {4097188800 -10800 1 AMST} + {1192334400 -10800 1 AMST} + {1203217200 -14400 0 AMT} + {1223784000 -10800 1 AMST} + {1234666800 -14400 0 AMT} + {1255233600 -10800 1 AMST} + {1266721200 -14400 0 AMT} + {1286683200 -10800 1 AMST} + {1298170800 -14400 0 AMT} + {1318132800 -10800 1 AMST} + {1329620400 -14400 0 AMT} + {1350187200 -10800 1 AMST} + {1361070000 -14400 0 AMT} + {1381636800 -10800 1 AMST} + {1392519600 -14400 0 AMT} + {1413086400 -10800 1 AMST} + {1423969200 -14400 0 AMT} + {1444536000 -10800 1 AMST} + {1456023600 -14400 0 AMT} + {1475985600 -10800 1 AMST} + {1487473200 -14400 0 AMT} + {1507435200 -10800 1 AMST} + {1518922800 -14400 0 AMT} + {1539489600 -10800 1 AMST} + {1550372400 -14400 0 AMT} + {1570939200 -10800 1 AMST} + {1581822000 -14400 0 AMT} + {1602388800 -10800 1 AMST} + {1613876400 -14400 0 AMT} + {1633838400 -10800 1 AMST} + {1645326000 -14400 0 AMT} + {1665288000 -10800 1 AMST} + {1676775600 -14400 0 AMT} + {1696737600 -10800 1 AMST} + {1708225200 -14400 0 AMT} + {1728792000 -10800 1 AMST} + {1739674800 -14400 0 AMT} + {1760241600 -10800 1 AMST} + {1771124400 -14400 0 AMT} + {1791691200 -10800 1 AMST} + {1803178800 -14400 0 AMT} + {1823140800 -10800 1 AMST} + {1834628400 -14400 0 AMT} + {1854590400 -10800 1 AMST} + {1866078000 -14400 0 AMT} + {1886644800 -10800 1 AMST} + {1897527600 -14400 0 AMT} + {1918094400 -10800 1 AMST} + {1928977200 -14400 0 AMT} + {1949544000 -10800 1 AMST} + {1960426800 -14400 0 AMT} + {1980993600 -10800 1 AMST} + {1992481200 -14400 0 AMT} + {2012443200 -10800 1 AMST} + {2023930800 -14400 0 AMT} + {2043892800 -10800 1 AMST} + {2055380400 -14400 0 AMT} + {2075947200 -10800 1 AMST} + {2086830000 -14400 0 AMT} + {2107396800 -10800 1 AMST} + {2118279600 -14400 0 AMT} + {2138846400 -10800 1 AMST} + {2150334000 -14400 0 AMT} + {2170296000 -10800 1 AMST} + {2181783600 -14400 0 AMT} + {2201745600 -10800 1 AMST} + {2213233200 -14400 0 AMT} + {2233800000 -10800 1 AMST} + {2244682800 -14400 0 AMT} + {2265249600 -10800 1 AMST} + {2276132400 -14400 0 AMT} + {2296699200 -10800 1 AMST} + {2307582000 -14400 0 AMT} + {2328148800 -10800 1 AMST} + {2339636400 -14400 0 AMT} + {2359598400 -10800 1 AMST} + {2371086000 -14400 0 AMT} + {2391048000 -10800 1 AMST} + {2402535600 -14400 0 AMT} + {2423102400 -10800 1 AMST} + {2433985200 -14400 0 AMT} + {2454552000 -10800 1 AMST} + {2465434800 -14400 0 AMT} + {2486001600 -10800 1 AMST} + {2497489200 -14400 0 AMT} + {2517451200 -10800 1 AMST} + {2528938800 -14400 0 AMT} + {2548900800 -10800 1 AMST} + {2560388400 -14400 0 AMT} + {2580350400 -10800 1 AMST} + {2591838000 -14400 0 AMT} + {2612404800 -10800 1 AMST} + {2623287600 -14400 0 AMT} + {2643854400 -10800 1 AMST} + {2654737200 -14400 0 AMT} + {2675304000 -10800 1 AMST} + {2686791600 -14400 0 AMT} + {2706753600 -10800 1 AMST} + {2718241200 -14400 0 AMT} + {2738203200 -10800 1 AMST} + {2749690800 -14400 0 AMT} + {2770257600 -10800 1 AMST} + {2781140400 -14400 0 AMT} + {2801707200 -10800 1 AMST} + {2812590000 -14400 0 AMT} + {2833156800 -10800 1 AMST} + {2844039600 -14400 0 AMT} + {2864606400 -10800 1 AMST} + {2876094000 -14400 0 AMT} + {2896056000 -10800 1 AMST} + {2907543600 -14400 0 AMT} + {2927505600 -10800 1 AMST} + {2938993200 -14400 0 AMT} + {2959560000 -10800 1 AMST} + {2970442800 -14400 0 AMT} + {2991009600 -10800 1 AMST} + {3001892400 -14400 0 AMT} + {3022459200 -10800 1 AMST} + {3033946800 -14400 0 AMT} + {3053908800 -10800 1 AMST} + {3065396400 -14400 0 AMT} + {3085358400 -10800 1 AMST} + {3096846000 -14400 0 AMT} + {3117412800 -10800 1 AMST} + {3128295600 -14400 0 AMT} + {3148862400 -10800 1 AMST} + {3159745200 -14400 0 AMT} + {3180312000 -10800 1 AMST} + {3191194800 -14400 0 AMT} + {3211761600 -10800 1 AMST} + {3223249200 -14400 0 AMT} + {3243211200 -10800 1 AMST} + {3254698800 -14400 0 AMT} + {3274660800 -10800 1 AMST} + {3286148400 -14400 0 AMT} + {3306715200 -10800 1 AMST} + {3317598000 -14400 0 AMT} + {3338164800 -10800 1 AMST} + {3349047600 -14400 0 AMT} + {3369614400 -10800 1 AMST} + {3381102000 -14400 0 AMT} + {3401064000 -10800 1 AMST} + {3412551600 -14400 0 AMT} + {3432513600 -10800 1 AMST} + {3444001200 -14400 0 AMT} + {3463963200 -10800 1 AMST} + {3475450800 -14400 0 AMT} + {3496017600 -10800 1 AMST} + {3506900400 -14400 0 AMT} + {3527467200 -10800 1 AMST} + {3538350000 -14400 0 AMT} + {3558916800 -10800 1 AMST} + {3570404400 -14400 0 AMT} + {3590366400 -10800 1 AMST} + {3601854000 -14400 0 AMT} + {3621816000 -10800 1 AMST} + {3633303600 -14400 0 AMT} + {3653870400 -10800 1 AMST} + {3664753200 -14400 0 AMT} + {3685320000 -10800 1 AMST} + {3696202800 -14400 0 AMT} + {3716769600 -10800 1 AMST} + {3727652400 -14400 0 AMT} + {3748219200 -10800 1 AMST} + {3759706800 -14400 0 AMT} + {3779668800 -10800 1 AMST} + {3791156400 -14400 0 AMT} + {3811118400 -10800 1 AMST} + {3822606000 -14400 0 AMT} + {3843172800 -10800 1 AMST} + {3854055600 -14400 0 AMT} + {3874622400 -10800 1 AMST} + {3885505200 -14400 0 AMT} + {3906072000 -10800 1 AMST} + {3917559600 -14400 0 AMT} + {3937521600 -10800 1 AMST} + {3949009200 -14400 0 AMT} + {3968971200 -10800 1 AMST} + {3980458800 -14400 0 AMT} + {4001025600 -10800 1 AMST} + {4011908400 -14400 0 AMT} + {4032475200 -10800 1 AMST} + {4043358000 -14400 0 AMT} + {4063924800 -10800 1 AMST} + {4074807600 -14400 0 AMT} + {4095374400 -10800 1 AMST} } diff --git a/library/tzdata/America/Caracas b/library/tzdata/America/Caracas index 057d300..1de29e6 100644 --- a/library/tzdata/America/Caracas +++ b/library/tzdata/America/Caracas @@ -5,4 +5,5 @@ set TZData(:America/Caracas) { {-2524505536 -16060 0 CMT} {-1826739140 -16200 0 VET} {-157750200 -14400 0 VET} + {1199160000 -16200 0 VET} } diff --git a/library/tzdata/America/Cuiaba b/library/tzdata/America/Cuiaba index d5e761d..fb63ee8 100644 --- a/library/tzdata/America/Cuiaba +++ b/library/tzdata/America/Cuiaba @@ -69,189 +69,189 @@ set TZData(:America/Cuiaba) { {1140318000 -14400 0 AMT} {1162699200 -10800 1 AMST} {1172372400 -14400 0 AMT} - {1194148800 -10800 1 AMST} - {1203822000 -14400 0 AMT} - {1225598400 -10800 1 AMST} - {1235271600 -14400 0 AMT} - {1257048000 -10800 1 AMST} - {1267326000 -14400 0 AMT} - {1289102400 -10800 1 AMST} - {1298775600 -14400 0 AMT} - {1320552000 -10800 1 AMST} - {1330225200 -14400 0 AMT} - {1352001600 -10800 1 AMST} - {1361674800 -14400 0 AMT} - {1383451200 -10800 1 AMST} - {1393124400 -14400 0 AMT} - {1414900800 -10800 1 AMST} - {1424574000 -14400 0 AMT} - {1446350400 -10800 1 AMST} - {1456628400 -14400 0 AMT} - {1478404800 -10800 1 AMST} - {1488078000 -14400 0 AMT} - {1509854400 -10800 1 AMST} - {1519527600 -14400 0 AMT} - {1541304000 -10800 1 AMST} - {1550977200 -14400 0 AMT} - {1572753600 -10800 1 AMST} - {1582426800 -14400 0 AMT} - {1604203200 -10800 1 AMST} - {1614481200 -14400 0 AMT} - {1636257600 -10800 1 AMST} - {1645930800 -14400 0 AMT} - {1667707200 -10800 1 AMST} - {1677380400 -14400 0 AMT} - {1699156800 -10800 1 AMST} - {1708830000 -14400 0 AMT} - {1730606400 -10800 1 AMST} - {1740279600 -14400 0 AMT} - {1762056000 -10800 1 AMST} - {1771729200 -14400 0 AMT} - {1793505600 -10800 1 AMST} - {1803783600 -14400 0 AMT} - {1825560000 -10800 1 AMST} - {1835233200 -14400 0 AMT} - {1857009600 -10800 1 AMST} - {1866682800 -14400 0 AMT} - {1888459200 -10800 1 AMST} - {1898132400 -14400 0 AMT} - {1919908800 -10800 1 AMST} - {1929582000 -14400 0 AMT} - {1951358400 -10800 1 AMST} - {1961636400 -14400 0 AMT} - {1983412800 -10800 1 AMST} - {1993086000 -14400 0 AMT} - {2014862400 -10800 1 AMST} - {2024535600 -14400 0 AMT} - {2046312000 -10800 1 AMST} - {2055985200 -14400 0 AMT} - {2077761600 -10800 1 AMST} - {2087434800 -14400 0 AMT} - {2109211200 -10800 1 AMST} - {2118884400 -14400 0 AMT} - {2140660800 -10800 1 AMST} - {2150938800 -14400 0 AMT} - {2172715200 -10800 1 AMST} - {2182388400 -14400 0 AMT} - {2204164800 -10800 1 AMST} - {2213838000 -14400 0 AMT} - {2235614400 -10800 1 AMST} - {2245287600 -14400 0 AMT} - {2267064000 -10800 1 AMST} - {2276737200 -14400 0 AMT} - {2298513600 -10800 1 AMST} - {2308186800 -14400 0 AMT} - {2329963200 -10800 1 AMST} - {2340241200 -14400 0 AMT} - {2362017600 -10800 1 AMST} - {2371690800 -14400 0 AMT} - {2393467200 -10800 1 AMST} - {2403140400 -14400 0 AMT} - {2424916800 -10800 1 AMST} - {2434590000 -14400 0 AMT} - {2456366400 -10800 1 AMST} - {2466039600 -14400 0 AMT} - {2487816000 -10800 1 AMST} - {2498094000 -14400 0 AMT} - {2519870400 -10800 1 AMST} - {2529543600 -14400 0 AMT} - {2551320000 -10800 1 AMST} - {2560993200 -14400 0 AMT} - {2582769600 -10800 1 AMST} - {2592442800 -14400 0 AMT} - {2614219200 -10800 1 AMST} - {2623892400 -14400 0 AMT} - {2645668800 -10800 1 AMST} - {2655342000 -14400 0 AMT} - {2677118400 -10800 1 AMST} - {2687396400 -14400 0 AMT} - {2709172800 -10800 1 AMST} - {2718846000 -14400 0 AMT} - {2740622400 -10800 1 AMST} - {2750295600 -14400 0 AMT} - {2772072000 -10800 1 AMST} - {2781745200 -14400 0 AMT} - {2803521600 -10800 1 AMST} - {2813194800 -14400 0 AMT} - {2834971200 -10800 1 AMST} - {2845249200 -14400 0 AMT} - {2867025600 -10800 1 AMST} - {2876698800 -14400 0 AMT} - {2898475200 -10800 1 AMST} - {2908148400 -14400 0 AMT} - {2929924800 -10800 1 AMST} - {2939598000 -14400 0 AMT} - {2961374400 -10800 1 AMST} - {2971047600 -14400 0 AMT} - {2992824000 -10800 1 AMST} - {3002497200 -14400 0 AMT} - {3024273600 -10800 1 AMST} - {3034551600 -14400 0 AMT} - {3056328000 -10800 1 AMST} - {3066001200 -14400 0 AMT} - {3087777600 -10800 1 AMST} - {3097450800 -14400 0 AMT} - {3119227200 -10800 1 AMST} - {3128900400 -14400 0 AMT} - {3150676800 -10800 1 AMST} - {3160350000 -14400 0 AMT} - {3182126400 -10800 1 AMST} - {3191799600 -14400 0 AMT} - {3213576000 -10800 1 AMST} - {3223854000 -14400 0 AMT} - {3245630400 -10800 1 AMST} - {3255303600 -14400 0 AMT} - {3277080000 -10800 1 AMST} - {3286753200 -14400 0 AMT} - {3308529600 -10800 1 AMST} - {3318202800 -14400 0 AMT} - {3339979200 -10800 1 AMST} - {3349652400 -14400 0 AMT} - {3371428800 -10800 1 AMST} - {3381706800 -14400 0 AMT} - {3403483200 -10800 1 AMST} - {3413156400 -14400 0 AMT} - {3434932800 -10800 1 AMST} - {3444606000 -14400 0 AMT} - {3466382400 -10800 1 AMST} - {3476055600 -14400 0 AMT} - {3497832000 -10800 1 AMST} - {3507505200 -14400 0 AMT} - {3529281600 -10800 1 AMST} - {3538954800 -14400 0 AMT} - {3560731200 -10800 1 AMST} - {3571009200 -14400 0 AMT} - {3592785600 -10800 1 AMST} - {3602458800 -14400 0 AMT} - {3624235200 -10800 1 AMST} - {3633908400 -14400 0 AMT} - {3655684800 -10800 1 AMST} - {3665358000 -14400 0 AMT} - {3687134400 -10800 1 AMST} - {3696807600 -14400 0 AMT} - {3718584000 -10800 1 AMST} - {3728862000 -14400 0 AMT} - {3750638400 -10800 1 AMST} - {3760311600 -14400 0 AMT} - {3782088000 -10800 1 AMST} - {3791761200 -14400 0 AMT} - {3813537600 -10800 1 AMST} - {3823210800 -14400 0 AMT} - {3844987200 -10800 1 AMST} - {3854660400 -14400 0 AMT} - {3876436800 -10800 1 AMST} - {3886110000 -14400 0 AMT} - {3907886400 -10800 1 AMST} - {3918164400 -14400 0 AMT} - {3939940800 -10800 1 AMST} - {3949614000 -14400 0 AMT} - {3971390400 -10800 1 AMST} - {3981063600 -14400 0 AMT} - {4002840000 -10800 1 AMST} - {4012513200 -14400 0 AMT} - {4034289600 -10800 1 AMST} - {4043962800 -14400 0 AMT} - {4065739200 -10800 1 AMST} - {4075412400 -14400 0 AMT} - {4097188800 -10800 1 AMST} + {1192334400 -10800 1 AMST} + {1203217200 -14400 0 AMT} + {1223784000 -10800 1 AMST} + {1234666800 -14400 0 AMT} + {1255233600 -10800 1 AMST} + {1266721200 -14400 0 AMT} + {1286683200 -10800 1 AMST} + {1298170800 -14400 0 AMT} + {1318132800 -10800 1 AMST} + {1329620400 -14400 0 AMT} + {1350187200 -10800 1 AMST} + {1361070000 -14400 0 AMT} + {1381636800 -10800 1 AMST} + {1392519600 -14400 0 AMT} + {1413086400 -10800 1 AMST} + {1423969200 -14400 0 AMT} + {1444536000 -10800 1 AMST} + {1456023600 -14400 0 AMT} + {1475985600 -10800 1 AMST} + {1487473200 -14400 0 AMT} + {1507435200 -10800 1 AMST} + {1518922800 -14400 0 AMT} + {1539489600 -10800 1 AMST} + {1550372400 -14400 0 AMT} + {1570939200 -10800 1 AMST} + {1581822000 -14400 0 AMT} + {1602388800 -10800 1 AMST} + {1613876400 -14400 0 AMT} + {1633838400 -10800 1 AMST} + {1645326000 -14400 0 AMT} + {1665288000 -10800 1 AMST} + {1676775600 -14400 0 AMT} + {1696737600 -10800 1 AMST} + {1708225200 -14400 0 AMT} + {1728792000 -10800 1 AMST} + {1739674800 -14400 0 AMT} + {1760241600 -10800 1 AMST} + {1771124400 -14400 0 AMT} + {1791691200 -10800 1 AMST} + {1803178800 -14400 0 AMT} + {1823140800 -10800 1 AMST} + {1834628400 -14400 0 AMT} + {1854590400 -10800 1 AMST} + {1866078000 -14400 0 AMT} + {1886644800 -10800 1 AMST} + {1897527600 -14400 0 AMT} + {1918094400 -10800 1 AMST} + {1928977200 -14400 0 AMT} + {1949544000 -10800 1 AMST} + {1960426800 -14400 0 AMT} + {1980993600 -10800 1 AMST} + {1992481200 -14400 0 AMT} + {2012443200 -10800 1 AMST} + {2023930800 -14400 0 AMT} + {2043892800 -10800 1 AMST} + {2055380400 -14400 0 AMT} + {2075947200 -10800 1 AMST} + {2086830000 -14400 0 AMT} + {2107396800 -10800 1 AMST} + {2118279600 -14400 0 AMT} + {2138846400 -10800 1 AMST} + {2150334000 -14400 0 AMT} + {2170296000 -10800 1 AMST} + {2181783600 -14400 0 AMT} + {2201745600 -10800 1 AMST} + {2213233200 -14400 0 AMT} + {2233800000 -10800 1 AMST} + {2244682800 -14400 0 AMT} + {2265249600 -10800 1 AMST} + {2276132400 -14400 0 AMT} + {2296699200 -10800 1 AMST} + {2307582000 -14400 0 AMT} + {2328148800 -10800 1 AMST} + {2339636400 -14400 0 AMT} + {2359598400 -10800 1 AMST} + {2371086000 -14400 0 AMT} + {2391048000 -10800 1 AMST} + {2402535600 -14400 0 AMT} + {2423102400 -10800 1 AMST} + {2433985200 -14400 0 AMT} + {2454552000 -10800 1 AMST} + {2465434800 -14400 0 AMT} + {2486001600 -10800 1 AMST} + {2497489200 -14400 0 AMT} + {2517451200 -10800 1 AMST} + {2528938800 -14400 0 AMT} + {2548900800 -10800 1 AMST} + {2560388400 -14400 0 AMT} + {2580350400 -10800 1 AMST} + {2591838000 -14400 0 AMT} + {2612404800 -10800 1 AMST} + {2623287600 -14400 0 AMT} + {2643854400 -10800 1 AMST} + {2654737200 -14400 0 AMT} + {2675304000 -10800 1 AMST} + {2686791600 -14400 0 AMT} + {2706753600 -10800 1 AMST} + {2718241200 -14400 0 AMT} + {2738203200 -10800 1 AMST} + {2749690800 -14400 0 AMT} + {2770257600 -10800 1 AMST} + {2781140400 -14400 0 AMT} + {2801707200 -10800 1 AMST} + {2812590000 -14400 0 AMT} + {2833156800 -10800 1 AMST} + {2844039600 -14400 0 AMT} + {2864606400 -10800 1 AMST} + {2876094000 -14400 0 AMT} + {2896056000 -10800 1 AMST} + {2907543600 -14400 0 AMT} + {2927505600 -10800 1 AMST} + {2938993200 -14400 0 AMT} + {2959560000 -10800 1 AMST} + {2970442800 -14400 0 AMT} + {2991009600 -10800 1 AMST} + {3001892400 -14400 0 AMT} + {3022459200 -10800 1 AMST} + {3033946800 -14400 0 AMT} + {3053908800 -10800 1 AMST} + {3065396400 -14400 0 AMT} + {3085358400 -10800 1 AMST} + {3096846000 -14400 0 AMT} + {3117412800 -10800 1 AMST} + {3128295600 -14400 0 AMT} + {3148862400 -10800 1 AMST} + {3159745200 -14400 0 AMT} + {3180312000 -10800 1 AMST} + {3191194800 -14400 0 AMT} + {3211761600 -10800 1 AMST} + {3223249200 -14400 0 AMT} + {3243211200 -10800 1 AMST} + {3254698800 -14400 0 AMT} + {3274660800 -10800 1 AMST} + {3286148400 -14400 0 AMT} + {3306715200 -10800 1 AMST} + {3317598000 -14400 0 AMT} + {3338164800 -10800 1 AMST} + {3349047600 -14400 0 AMT} + {3369614400 -10800 1 AMST} + {3381102000 -14400 0 AMT} + {3401064000 -10800 1 AMST} + {3412551600 -14400 0 AMT} + {3432513600 -10800 1 AMST} + {3444001200 -14400 0 AMT} + {3463963200 -10800 1 AMST} + {3475450800 -14400 0 AMT} + {3496017600 -10800 1 AMST} + {3506900400 -14400 0 AMT} + {3527467200 -10800 1 AMST} + {3538350000 -14400 0 AMT} + {3558916800 -10800 1 AMST} + {3570404400 -14400 0 AMT} + {3590366400 -10800 1 AMST} + {3601854000 -14400 0 AMT} + {3621816000 -10800 1 AMST} + {3633303600 -14400 0 AMT} + {3653870400 -10800 1 AMST} + {3664753200 -14400 0 AMT} + {3685320000 -10800 1 AMST} + {3696202800 -14400 0 AMT} + {3716769600 -10800 1 AMST} + {3727652400 -14400 0 AMT} + {3748219200 -10800 1 AMST} + {3759706800 -14400 0 AMT} + {3779668800 -10800 1 AMST} + {3791156400 -14400 0 AMT} + {3811118400 -10800 1 AMST} + {3822606000 -14400 0 AMT} + {3843172800 -10800 1 AMST} + {3854055600 -14400 0 AMT} + {3874622400 -10800 1 AMST} + {3885505200 -14400 0 AMT} + {3906072000 -10800 1 AMST} + {3917559600 -14400 0 AMT} + {3937521600 -10800 1 AMST} + {3949009200 -14400 0 AMT} + {3968971200 -10800 1 AMST} + {3980458800 -14400 0 AMT} + {4001025600 -10800 1 AMST} + {4011908400 -14400 0 AMT} + {4032475200 -10800 1 AMST} + {4043358000 -14400 0 AMT} + {4063924800 -10800 1 AMST} + {4074807600 -14400 0 AMT} + {4095374400 -10800 1 AMST} } diff --git a/library/tzdata/America/Havana b/library/tzdata/America/Havana index 43206dc..66e951f 100644 --- a/library/tzdata/America/Havana +++ b/library/tzdata/America/Havana @@ -99,189 +99,189 @@ set TZData(:America/Havana) { {1143954000 -14400 1 CDT} {1162098000 -18000 0 CST} {1173589200 -14400 1 CDT} - {1194152400 -18000 0 CST} + {1193547600 -18000 0 CST} {1205038800 -14400 1 CDT} - {1225602000 -18000 0 CST} + {1224997200 -18000 0 CST} {1236488400 -14400 1 CDT} - {1257051600 -18000 0 CST} + {1256446800 -18000 0 CST} {1268542800 -14400 1 CDT} - {1289106000 -18000 0 CST} + {1288501200 -18000 0 CST} {1299992400 -14400 1 CDT} - {1320555600 -18000 0 CST} + {1319950800 -18000 0 CST} {1331442000 -14400 1 CDT} - {1352005200 -18000 0 CST} + {1351400400 -18000 0 CST} {1362891600 -14400 1 CDT} - {1383454800 -18000 0 CST} + {1382850000 -18000 0 CST} {1394341200 -14400 1 CDT} - {1414904400 -18000 0 CST} + {1414299600 -18000 0 CST} {1425790800 -14400 1 CDT} - {1446354000 -18000 0 CST} + {1445749200 -18000 0 CST} {1457845200 -14400 1 CDT} - {1478408400 -18000 0 CST} + {1477803600 -18000 0 CST} {1489294800 -14400 1 CDT} - {1509858000 -18000 0 CST} + {1509253200 -18000 0 CST} {1520744400 -14400 1 CDT} - {1541307600 -18000 0 CST} + {1540702800 -18000 0 CST} {1552194000 -14400 1 CDT} - {1572757200 -18000 0 CST} + {1572152400 -18000 0 CST} {1583643600 -14400 1 CDT} - {1604206800 -18000 0 CST} + {1603602000 -18000 0 CST} {1615698000 -14400 1 CDT} - {1636261200 -18000 0 CST} + {1635656400 -18000 0 CST} {1647147600 -14400 1 CDT} - {1667710800 -18000 0 CST} + {1667106000 -18000 0 CST} {1678597200 -14400 1 CDT} - {1699160400 -18000 0 CST} + {1698555600 -18000 0 CST} {1710046800 -14400 1 CDT} - {1730610000 -18000 0 CST} + {1730005200 -18000 0 CST} {1741496400 -14400 1 CDT} - {1762059600 -18000 0 CST} + {1761454800 -18000 0 CST} {1772946000 -14400 1 CDT} - {1793509200 -18000 0 CST} + {1792904400 -18000 0 CST} {1805000400 -14400 1 CDT} - {1825563600 -18000 0 CST} + {1824958800 -18000 0 CST} {1836450000 -14400 1 CDT} - {1857013200 -18000 0 CST} + {1856408400 -18000 0 CST} {1867899600 -14400 1 CDT} - {1888462800 -18000 0 CST} + {1887858000 -18000 0 CST} {1899349200 -14400 1 CDT} - {1919912400 -18000 0 CST} + {1919307600 -18000 0 CST} {1930798800 -14400 1 CDT} - {1951362000 -18000 0 CST} + {1950757200 -18000 0 CST} {1962853200 -14400 1 CDT} - {1983416400 -18000 0 CST} + {1982811600 -18000 0 CST} {1994302800 -14400 1 CDT} - {2014866000 -18000 0 CST} + {2014261200 -18000 0 CST} {2025752400 -14400 1 CDT} - {2046315600 -18000 0 CST} + {2045710800 -18000 0 CST} {2057202000 -14400 1 CDT} - {2077765200 -18000 0 CST} + {2077160400 -18000 0 CST} {2088651600 -14400 1 CDT} - {2109214800 -18000 0 CST} + {2108610000 -18000 0 CST} {2120101200 -14400 1 CDT} - {2140664400 -18000 0 CST} + {2140059600 -18000 0 CST} {2152155600 -14400 1 CDT} - {2172718800 -18000 0 CST} + {2172114000 -18000 0 CST} {2183605200 -14400 1 CDT} - {2204168400 -18000 0 CST} + {2203563600 -18000 0 CST} {2215054800 -14400 1 CDT} - {2235618000 -18000 0 CST} + {2235013200 -18000 0 CST} {2246504400 -14400 1 CDT} - {2267067600 -18000 0 CST} + {2266462800 -18000 0 CST} {2277954000 -14400 1 CDT} - {2298517200 -18000 0 CST} + {2297912400 -18000 0 CST} {2309403600 -14400 1 CDT} - {2329966800 -18000 0 CST} + {2329362000 -18000 0 CST} {2341458000 -14400 1 CDT} - {2362021200 -18000 0 CST} + {2361416400 -18000 0 CST} {2372907600 -14400 1 CDT} - {2393470800 -18000 0 CST} + {2392866000 -18000 0 CST} {2404357200 -14400 1 CDT} - {2424920400 -18000 0 CST} + {2424315600 -18000 0 CST} {2435806800 -14400 1 CDT} - {2456370000 -18000 0 CST} + {2455765200 -18000 0 CST} {2467256400 -14400 1 CDT} - {2487819600 -18000 0 CST} + {2487214800 -18000 0 CST} {2499310800 -14400 1 CDT} - {2519874000 -18000 0 CST} + {2519269200 -18000 0 CST} {2530760400 -14400 1 CDT} - {2551323600 -18000 0 CST} + {2550718800 -18000 0 CST} {2562210000 -14400 1 CDT} - {2582773200 -18000 0 CST} + {2582168400 -18000 0 CST} {2593659600 -14400 1 CDT} - {2614222800 -18000 0 CST} + {2613618000 -18000 0 CST} {2625109200 -14400 1 CDT} - {2645672400 -18000 0 CST} + {2645067600 -18000 0 CST} {2656558800 -14400 1 CDT} - {2677122000 -18000 0 CST} + {2676517200 -18000 0 CST} {2688613200 -14400 1 CDT} - {2709176400 -18000 0 CST} + {2708571600 -18000 0 CST} {2720062800 -14400 1 CDT} - {2740626000 -18000 0 CST} + {2740021200 -18000 0 CST} {2751512400 -14400 1 CDT} - {2772075600 -18000 0 CST} + {2771470800 -18000 0 CST} {2782962000 -14400 1 CDT} - {2803525200 -18000 0 CST} + {2802920400 -18000 0 CST} {2814411600 -14400 1 CDT} - {2834974800 -18000 0 CST} + {2834370000 -18000 0 CST} {2846466000 -14400 1 CDT} - {2867029200 -18000 0 CST} + {2866424400 -18000 0 CST} {2877915600 -14400 1 CDT} - {2898478800 -18000 0 CST} + {2897874000 -18000 0 CST} {2909365200 -14400 1 CDT} - {2929928400 -18000 0 CST} + {2929323600 -18000 0 CST} {2940814800 -14400 1 CDT} - {2961378000 -18000 0 CST} + {2960773200 -18000 0 CST} {2972264400 -14400 1 CDT} - {2992827600 -18000 0 CST} + {2992222800 -18000 0 CST} {3003714000 -14400 1 CDT} - {3024277200 -18000 0 CST} + {3023672400 -18000 0 CST} {3035768400 -14400 1 CDT} - {3056331600 -18000 0 CST} + {3055726800 -18000 0 CST} {3067218000 -14400 1 CDT} - {3087781200 -18000 0 CST} + {3087176400 -18000 0 CST} {3098667600 -14400 1 CDT} - {3119230800 -18000 0 CST} + {3118626000 -18000 0 CST} {3130117200 -14400 1 CDT} - {3150680400 -18000 0 CST} + {3150075600 -18000 0 CST} {3161566800 -14400 1 CDT} - {3182130000 -18000 0 CST} + {3181525200 -18000 0 CST} {3193016400 -14400 1 CDT} - {3213579600 -18000 0 CST} + {3212974800 -18000 0 CST} {3225070800 -14400 1 CDT} - {3245634000 -18000 0 CST} + {3245029200 -18000 0 CST} {3256520400 -14400 1 CDT} - {3277083600 -18000 0 CST} + {3276478800 -18000 0 CST} {3287970000 -14400 1 CDT} - {3308533200 -18000 0 CST} + {3307928400 -18000 0 CST} {3319419600 -14400 1 CDT} - {3339982800 -18000 0 CST} + {3339378000 -18000 0 CST} {3350869200 -14400 1 CDT} - {3371432400 -18000 0 CST} + {3370827600 -18000 0 CST} {3382923600 -14400 1 CDT} - {3403486800 -18000 0 CST} + {3402882000 -18000 0 CST} {3414373200 -14400 1 CDT} - {3434936400 -18000 0 CST} + {3434331600 -18000 0 CST} {3445822800 -14400 1 CDT} - {3466386000 -18000 0 CST} + {3465781200 -18000 0 CST} {3477272400 -14400 1 CDT} - {3497835600 -18000 0 CST} + {3497230800 -18000 0 CST} {3508722000 -14400 1 CDT} - {3529285200 -18000 0 CST} + {3528680400 -18000 0 CST} {3540171600 -14400 1 CDT} - {3560734800 -18000 0 CST} + {3560130000 -18000 0 CST} {3572226000 -14400 1 CDT} - {3592789200 -18000 0 CST} + {3592184400 -18000 0 CST} {3603675600 -14400 1 CDT} - {3624238800 -18000 0 CST} + {3623634000 -18000 0 CST} {3635125200 -14400 1 CDT} - {3655688400 -18000 0 CST} + {3655083600 -18000 0 CST} {3666574800 -14400 1 CDT} - {3687138000 -18000 0 CST} + {3686533200 -18000 0 CST} {3698024400 -14400 1 CDT} - {3718587600 -18000 0 CST} + {3717982800 -18000 0 CST} {3730078800 -14400 1 CDT} - {3750642000 -18000 0 CST} + {3750037200 -18000 0 CST} {3761528400 -14400 1 CDT} - {3782091600 -18000 0 CST} + {3781486800 -18000 0 CST} {3792978000 -14400 1 CDT} - {3813541200 -18000 0 CST} + {3812936400 -18000 0 CST} {3824427600 -14400 1 CDT} - {3844990800 -18000 0 CST} + {3844386000 -18000 0 CST} {3855877200 -14400 1 CDT} - {3876440400 -18000 0 CST} + {3875835600 -18000 0 CST} {3887326800 -14400 1 CDT} - {3907890000 -18000 0 CST} + {3907285200 -18000 0 CST} {3919381200 -14400 1 CDT} - {3939944400 -18000 0 CST} + {3939339600 -18000 0 CST} {3950830800 -14400 1 CDT} - {3971394000 -18000 0 CST} + {3970789200 -18000 0 CST} {3982280400 -14400 1 CDT} - {4002843600 -18000 0 CST} + {4002238800 -18000 0 CST} {4013730000 -14400 1 CDT} - {4034293200 -18000 0 CST} + {4033688400 -18000 0 CST} {4045179600 -14400 1 CDT} - {4065742800 -18000 0 CST} + {4065138000 -18000 0 CST} {4076629200 -14400 1 CDT} - {4097192400 -18000 0 CST} + {4096587600 -18000 0 CST} } diff --git a/library/tzdata/America/Sao_Paulo b/library/tzdata/America/Sao_Paulo index e2d8a8f..2f07b61 100644 --- a/library/tzdata/America/Sao_Paulo +++ b/library/tzdata/America/Sao_Paulo @@ -70,189 +70,189 @@ set TZData(:America/Sao_Paulo) { {1140314400 -10800 0 BRT} {1162695600 -7200 1 BRST} {1172368800 -10800 0 BRT} - {1194145200 -7200 1 BRST} - {1203818400 -10800 0 BRT} - {1225594800 -7200 1 BRST} - {1235268000 -10800 0 BRT} - {1257044400 -7200 1 BRST} - {1267322400 -10800 0 BRT} - {1289098800 -7200 1 BRST} - {1298772000 -10800 0 BRT} - {1320548400 -7200 1 BRST} - {1330221600 -10800 0 BRT} - {1351998000 -7200 1 BRST} - {1361671200 -10800 0 BRT} - {1383447600 -7200 1 BRST} - {1393120800 -10800 0 BRT} - {1414897200 -7200 1 BRST} - {1424570400 -10800 0 BRT} - {1446346800 -7200 1 BRST} - {1456624800 -10800 0 BRT} - {1478401200 -7200 1 BRST} - {1488074400 -10800 0 BRT} - {1509850800 -7200 1 BRST} - {1519524000 -10800 0 BRT} - {1541300400 -7200 1 BRST} - {1550973600 -10800 0 BRT} - {1572750000 -7200 1 BRST} - {1582423200 -10800 0 BRT} - {1604199600 -7200 1 BRST} - {1614477600 -10800 0 BRT} - {1636254000 -7200 1 BRST} - {1645927200 -10800 0 BRT} - {1667703600 -7200 1 BRST} - {1677376800 -10800 0 BRT} - {1699153200 -7200 1 BRST} - {1708826400 -10800 0 BRT} - {1730602800 -7200 1 BRST} - {1740276000 -10800 0 BRT} - {1762052400 -7200 1 BRST} - {1771725600 -10800 0 BRT} - {1793502000 -7200 1 BRST} - {1803780000 -10800 0 BRT} - {1825556400 -7200 1 BRST} - {1835229600 -10800 0 BRT} - {1857006000 -7200 1 BRST} - {1866679200 -10800 0 BRT} - {1888455600 -7200 1 BRST} - {1898128800 -10800 0 BRT} - {1919905200 -7200 1 BRST} - {1929578400 -10800 0 BRT} - {1951354800 -7200 1 BRST} - {1961632800 -10800 0 BRT} - {1983409200 -7200 1 BRST} - {1993082400 -10800 0 BRT} - {2014858800 -7200 1 BRST} - {2024532000 -10800 0 BRT} - {2046308400 -7200 1 BRST} - {2055981600 -10800 0 BRT} - {2077758000 -7200 1 BRST} - {2087431200 -10800 0 BRT} - {2109207600 -7200 1 BRST} - {2118880800 -10800 0 BRT} - {2140657200 -7200 1 BRST} - {2150935200 -10800 0 BRT} - {2172711600 -7200 1 BRST} - {2182384800 -10800 0 BRT} - {2204161200 -7200 1 BRST} - {2213834400 -10800 0 BRT} - {2235610800 -7200 1 BRST} - {2245284000 -10800 0 BRT} - {2267060400 -7200 1 BRST} - {2276733600 -10800 0 BRT} - {2298510000 -7200 1 BRST} - {2308183200 -10800 0 BRT} - {2329959600 -7200 1 BRST} - {2340237600 -10800 0 BRT} - {2362014000 -7200 1 BRST} - {2371687200 -10800 0 BRT} - {2393463600 -7200 1 BRST} - {2403136800 -10800 0 BRT} - {2424913200 -7200 1 BRST} - {2434586400 -10800 0 BRT} - {2456362800 -7200 1 BRST} - {2466036000 -10800 0 BRT} - {2487812400 -7200 1 BRST} - {2498090400 -10800 0 BRT} - {2519866800 -7200 1 BRST} - {2529540000 -10800 0 BRT} - {2551316400 -7200 1 BRST} - {2560989600 -10800 0 BRT} - {2582766000 -7200 1 BRST} - {2592439200 -10800 0 BRT} - {2614215600 -7200 1 BRST} - {2623888800 -10800 0 BRT} - {2645665200 -7200 1 BRST} - {2655338400 -10800 0 BRT} - {2677114800 -7200 1 BRST} - {2687392800 -10800 0 BRT} - {2709169200 -7200 1 BRST} - {2718842400 -10800 0 BRT} - {2740618800 -7200 1 BRST} - {2750292000 -10800 0 BRT} - {2772068400 -7200 1 BRST} - {2781741600 -10800 0 BRT} - {2803518000 -7200 1 BRST} - {2813191200 -10800 0 BRT} - {2834967600 -7200 1 BRST} - {2845245600 -10800 0 BRT} - {2867022000 -7200 1 BRST} - {2876695200 -10800 0 BRT} - {2898471600 -7200 1 BRST} - {2908144800 -10800 0 BRT} - {2929921200 -7200 1 BRST} - {2939594400 -10800 0 BRT} - {2961370800 -7200 1 BRST} - {2971044000 -10800 0 BRT} - {2992820400 -7200 1 BRST} - {3002493600 -10800 0 BRT} - {3024270000 -7200 1 BRST} - {3034548000 -10800 0 BRT} - {3056324400 -7200 1 BRST} - {3065997600 -10800 0 BRT} - {3087774000 -7200 1 BRST} - {3097447200 -10800 0 BRT} - {3119223600 -7200 1 BRST} - {3128896800 -10800 0 BRT} - {3150673200 -7200 1 BRST} - {3160346400 -10800 0 BRT} - {3182122800 -7200 1 BRST} - {3191796000 -10800 0 BRT} - {3213572400 -7200 1 BRST} - {3223850400 -10800 0 BRT} - {3245626800 -7200 1 BRST} - {3255300000 -10800 0 BRT} - {3277076400 -7200 1 BRST} - {3286749600 -10800 0 BRT} - {3308526000 -7200 1 BRST} - {3318199200 -10800 0 BRT} - {3339975600 -7200 1 BRST} - {3349648800 -10800 0 BRT} - {3371425200 -7200 1 BRST} - {3381703200 -10800 0 BRT} - {3403479600 -7200 1 BRST} - {3413152800 -10800 0 BRT} - {3434929200 -7200 1 BRST} - {3444602400 -10800 0 BRT} - {3466378800 -7200 1 BRST} - {3476052000 -10800 0 BRT} - {3497828400 -7200 1 BRST} - {3507501600 -10800 0 BRT} - {3529278000 -7200 1 BRST} - {3538951200 -10800 0 BRT} - {3560727600 -7200 1 BRST} - {3571005600 -10800 0 BRT} - {3592782000 -7200 1 BRST} - {3602455200 -10800 0 BRT} - {3624231600 -7200 1 BRST} - {3633904800 -10800 0 BRT} - {3655681200 -7200 1 BRST} - {3665354400 -10800 0 BRT} - {3687130800 -7200 1 BRST} - {3696804000 -10800 0 BRT} - {3718580400 -7200 1 BRST} - {3728858400 -10800 0 BRT} - {3750634800 -7200 1 BRST} - {3760308000 -10800 0 BRT} - {3782084400 -7200 1 BRST} - {3791757600 -10800 0 BRT} - {3813534000 -7200 1 BRST} - {3823207200 -10800 0 BRT} - {3844983600 -7200 1 BRST} - {3854656800 -10800 0 BRT} - {3876433200 -7200 1 BRST} - {3886106400 -10800 0 BRT} - {3907882800 -7200 1 BRST} - {3918160800 -10800 0 BRT} - {3939937200 -7200 1 BRST} - {3949610400 -10800 0 BRT} - {3971386800 -7200 1 BRST} - {3981060000 -10800 0 BRT} - {4002836400 -7200 1 BRST} - {4012509600 -10800 0 BRT} - {4034286000 -7200 1 BRST} - {4043959200 -10800 0 BRT} - {4065735600 -7200 1 BRST} - {4075408800 -10800 0 BRT} - {4097185200 -7200 1 BRST} + {1192330800 -7200 1 BRST} + {1203213600 -10800 0 BRT} + {1223780400 -7200 1 BRST} + {1234663200 -10800 0 BRT} + {1255230000 -7200 1 BRST} + {1266717600 -10800 0 BRT} + {1286679600 -7200 1 BRST} + {1298167200 -10800 0 BRT} + {1318129200 -7200 1 BRST} + {1329616800 -10800 0 BRT} + {1350183600 -7200 1 BRST} + {1361066400 -10800 0 BRT} + {1381633200 -7200 1 BRST} + {1392516000 -10800 0 BRT} + {1413082800 -7200 1 BRST} + {1423965600 -10800 0 BRT} + {1444532400 -7200 1 BRST} + {1456020000 -10800 0 BRT} + {1475982000 -7200 1 BRST} + {1487469600 -10800 0 BRT} + {1507431600 -7200 1 BRST} + {1518919200 -10800 0 BRT} + {1539486000 -7200 1 BRST} + {1550368800 -10800 0 BRT} + {1570935600 -7200 1 BRST} + {1581818400 -10800 0 BRT} + {1602385200 -7200 1 BRST} + {1613872800 -10800 0 BRT} + {1633834800 -7200 1 BRST} + {1645322400 -10800 0 BRT} + {1665284400 -7200 1 BRST} + {1676772000 -10800 0 BRT} + {1696734000 -7200 1 BRST} + {1708221600 -10800 0 BRT} + {1728788400 -7200 1 BRST} + {1739671200 -10800 0 BRT} + {1760238000 -7200 1 BRST} + {1771120800 -10800 0 BRT} + {1791687600 -7200 1 BRST} + {1803175200 -10800 0 BRT} + {1823137200 -7200 1 BRST} + {1834624800 -10800 0 BRT} + {1854586800 -7200 1 BRST} + {1866074400 -10800 0 BRT} + {1886641200 -7200 1 BRST} + {1897524000 -10800 0 BRT} + {1918090800 -7200 1 BRST} + {1928973600 -10800 0 BRT} + {1949540400 -7200 1 BRST} + {1960423200 -10800 0 BRT} + {1980990000 -7200 1 BRST} + {1992477600 -10800 0 BRT} + {2012439600 -7200 1 BRST} + {2023927200 -10800 0 BRT} + {2043889200 -7200 1 BRST} + {2055376800 -10800 0 BRT} + {2075943600 -7200 1 BRST} + {2086826400 -10800 0 BRT} + {2107393200 -7200 1 BRST} + {2118276000 -10800 0 BRT} + {2138842800 -7200 1 BRST} + {2150330400 -10800 0 BRT} + {2170292400 -7200 1 BRST} + {2181780000 -10800 0 BRT} + {2201742000 -7200 1 BRST} + {2213229600 -10800 0 BRT} + {2233796400 -7200 1 BRST} + {2244679200 -10800 0 BRT} + {2265246000 -7200 1 BRST} + {2276128800 -10800 0 BRT} + {2296695600 -7200 1 BRST} + {2307578400 -10800 0 BRT} + {2328145200 -7200 1 BRST} + {2339632800 -10800 0 BRT} + {2359594800 -7200 1 BRST} + {2371082400 -10800 0 BRT} + {2391044400 -7200 1 BRST} + {2402532000 -10800 0 BRT} + {2423098800 -7200 1 BRST} + {2433981600 -10800 0 BRT} + {2454548400 -7200 1 BRST} + {2465431200 -10800 0 BRT} + {2485998000 -7200 1 BRST} + {2497485600 -10800 0 BRT} + {2517447600 -7200 1 BRST} + {2528935200 -10800 0 BRT} + {2548897200 -7200 1 BRST} + {2560384800 -10800 0 BRT} + {2580346800 -7200 1 BRST} + {2591834400 -10800 0 BRT} + {2612401200 -7200 1 BRST} + {2623284000 -10800 0 BRT} + {2643850800 -7200 1 BRST} + {2654733600 -10800 0 BRT} + {2675300400 -7200 1 BRST} + {2686788000 -10800 0 BRT} + {2706750000 -7200 1 BRST} + {2718237600 -10800 0 BRT} + {2738199600 -7200 1 BRST} + {2749687200 -10800 0 BRT} + {2770254000 -7200 1 BRST} + {2781136800 -10800 0 BRT} + {2801703600 -7200 1 BRST} + {2812586400 -10800 0 BRT} + {2833153200 -7200 1 BRST} + {2844036000 -10800 0 BRT} + {2864602800 -7200 1 BRST} + {2876090400 -10800 0 BRT} + {2896052400 -7200 1 BRST} + {2907540000 -10800 0 BRT} + {2927502000 -7200 1 BRST} + {2938989600 -10800 0 BRT} + {2959556400 -7200 1 BRST} + {2970439200 -10800 0 BRT} + {2991006000 -7200 1 BRST} + {3001888800 -10800 0 BRT} + {3022455600 -7200 1 BRST} + {3033943200 -10800 0 BRT} + {3053905200 -7200 1 BRST} + {3065392800 -10800 0 BRT} + {3085354800 -7200 1 BRST} + {3096842400 -10800 0 BRT} + {3117409200 -7200 1 BRST} + {3128292000 -10800 0 BRT} + {3148858800 -7200 1 BRST} + {3159741600 -10800 0 BRT} + {3180308400 -7200 1 BRST} + {3191191200 -10800 0 BRT} + {3211758000 -7200 1 BRST} + {3223245600 -10800 0 BRT} + {3243207600 -7200 1 BRST} + {3254695200 -10800 0 BRT} + {3274657200 -7200 1 BRST} + {3286144800 -10800 0 BRT} + {3306711600 -7200 1 BRST} + {3317594400 -10800 0 BRT} + {3338161200 -7200 1 BRST} + {3349044000 -10800 0 BRT} + {3369610800 -7200 1 BRST} + {3381098400 -10800 0 BRT} + {3401060400 -7200 1 BRST} + {3412548000 -10800 0 BRT} + {3432510000 -7200 1 BRST} + {3443997600 -10800 0 BRT} + {3463959600 -7200 1 BRST} + {3475447200 -10800 0 BRT} + {3496014000 -7200 1 BRST} + {3506896800 -10800 0 BRT} + {3527463600 -7200 1 BRST} + {3538346400 -10800 0 BRT} + {3558913200 -7200 1 BRST} + {3570400800 -10800 0 BRT} + {3590362800 -7200 1 BRST} + {3601850400 -10800 0 BRT} + {3621812400 -7200 1 BRST} + {3633300000 -10800 0 BRT} + {3653866800 -7200 1 BRST} + {3664749600 -10800 0 BRT} + {3685316400 -7200 1 BRST} + {3696199200 -10800 0 BRT} + {3716766000 -7200 1 BRST} + {3727648800 -10800 0 BRT} + {3748215600 -7200 1 BRST} + {3759703200 -10800 0 BRT} + {3779665200 -7200 1 BRST} + {3791152800 -10800 0 BRT} + {3811114800 -7200 1 BRST} + {3822602400 -10800 0 BRT} + {3843169200 -7200 1 BRST} + {3854052000 -10800 0 BRT} + {3874618800 -7200 1 BRST} + {3885501600 -10800 0 BRT} + {3906068400 -7200 1 BRST} + {3917556000 -10800 0 BRT} + {3937518000 -7200 1 BRST} + {3949005600 -10800 0 BRT} + {3968967600 -7200 1 BRST} + {3980455200 -10800 0 BRT} + {4001022000 -7200 1 BRST} + {4011904800 -10800 0 BRT} + {4032471600 -7200 1 BRST} + {4043354400 -10800 0 BRT} + {4063921200 -7200 1 BRST} + {4074804000 -10800 0 BRT} + {4095370800 -7200 1 BRST} } diff --git a/library/tzdata/Asia/Damascus b/library/tzdata/Asia/Damascus index a99f3c1..1dc6889 100644 --- a/library/tzdata/Asia/Damascus +++ b/library/tzdata/Asia/Damascus @@ -92,189 +92,189 @@ set TZData(:Asia/Damascus) { {1143842400 10800 1 EEST} {1158872400 7200 0 EET} {1175205600 10800 1 EEST} - {1191186000 7200 0 EET} + {1193950800 7200 0 EET} {1206655200 10800 1 EEST} - {1222808400 7200 0 EET} + {1226005200 7200 0 EET} {1238104800 10800 1 EEST} - {1254344400 7200 0 EET} + {1257454800 7200 0 EET} {1269554400 10800 1 EEST} - {1285880400 7200 0 EET} + {1288904400 7200 0 EET} {1301004000 10800 1 EEST} - {1317416400 7200 0 EET} + {1320354000 7200 0 EET} {1333058400 10800 1 EEST} - {1349038800 7200 0 EET} + {1351803600 7200 0 EET} {1364508000 10800 1 EEST} - {1380574800 7200 0 EET} + {1383253200 7200 0 EET} {1395957600 10800 1 EEST} - {1412110800 7200 0 EET} + {1415307600 7200 0 EET} {1427407200 10800 1 EEST} - {1443646800 7200 0 EET} + {1446757200 7200 0 EET} {1458856800 10800 1 EEST} - {1475269200 7200 0 EET} + {1478206800 7200 0 EET} {1490911200 10800 1 EEST} - {1506805200 7200 0 EET} + {1509656400 7200 0 EET} {1522360800 10800 1 EEST} - {1538341200 7200 0 EET} + {1541106000 7200 0 EET} {1553810400 10800 1 EEST} - {1569877200 7200 0 EET} + {1572555600 7200 0 EET} {1585260000 10800 1 EEST} - {1601499600 7200 0 EET} + {1604610000 7200 0 EET} {1616709600 10800 1 EEST} - {1633035600 7200 0 EET} + {1636059600 7200 0 EET} {1648159200 10800 1 EEST} - {1664571600 7200 0 EET} + {1667509200 7200 0 EET} {1680213600 10800 1 EEST} - {1696107600 7200 0 EET} + {1698958800 7200 0 EET} {1711663200 10800 1 EEST} - {1727730000 7200 0 EET} + {1730408400 7200 0 EET} {1743112800 10800 1 EEST} - {1759266000 7200 0 EET} + {1762462800 7200 0 EET} {1774562400 10800 1 EEST} - {1790802000 7200 0 EET} + {1793912400 7200 0 EET} {1806012000 10800 1 EEST} - {1822338000 7200 0 EET} + {1825362000 7200 0 EET} {1838066400 10800 1 EEST} - {1853960400 7200 0 EET} + {1856811600 7200 0 EET} {1869516000 10800 1 EEST} - {1885496400 7200 0 EET} + {1888261200 7200 0 EET} {1900965600 10800 1 EEST} - {1917032400 7200 0 EET} + {1919710800 7200 0 EET} {1932415200 10800 1 EEST} - {1948568400 7200 0 EET} + {1951765200 7200 0 EET} {1963864800 10800 1 EEST} - {1980190800 7200 0 EET} + {1983214800 7200 0 EET} {1995314400 10800 1 EEST} - {2011726800 7200 0 EET} + {2014664400 7200 0 EET} {2027368800 10800 1 EEST} - {2043262800 7200 0 EET} + {2046114000 7200 0 EET} {2058818400 10800 1 EEST} - {2074798800 7200 0 EET} + {2077563600 7200 0 EET} {2090268000 10800 1 EEST} - {2106421200 7200 0 EET} + {2109618000 7200 0 EET} {2121717600 10800 1 EEST} - {2137957200 7200 0 EET} + {2141067600 7200 0 EET} {2153167200 10800 1 EEST} - {2169493200 7200 0 EET} + {2172517200 7200 0 EET} {2184616800 10800 1 EEST} - {2201029200 7200 0 EET} + {2203966800 7200 0 EET} {2216671200 10800 1 EEST} - {2232651600 7200 0 EET} + {2235416400 7200 0 EET} {2248120800 10800 1 EEST} - {2264187600 7200 0 EET} + {2266866000 7200 0 EET} {2279570400 10800 1 EEST} - {2295723600 7200 0 EET} + {2298920400 7200 0 EET} {2311020000 10800 1 EEST} - {2327259600 7200 0 EET} + {2330370000 7200 0 EET} {2342469600 10800 1 EEST} - {2358882000 7200 0 EET} + {2361819600 7200 0 EET} {2374524000 10800 1 EEST} - {2390418000 7200 0 EET} + {2393269200 7200 0 EET} {2405973600 10800 1 EEST} - {2421954000 7200 0 EET} + {2424718800 7200 0 EET} {2437423200 10800 1 EEST} - {2453490000 7200 0 EET} + {2456168400 7200 0 EET} {2468872800 10800 1 EEST} - {2485112400 7200 0 EET} + {2488222800 7200 0 EET} {2500322400 10800 1 EEST} - {2516648400 7200 0 EET} + {2519672400 7200 0 EET} {2531772000 10800 1 EEST} - {2548184400 7200 0 EET} + {2551122000 7200 0 EET} {2563826400 10800 1 EEST} - {2579720400 7200 0 EET} + {2582571600 7200 0 EET} {2595276000 10800 1 EEST} - {2611342800 7200 0 EET} + {2614021200 7200 0 EET} {2626725600 10800 1 EEST} - {2642878800 7200 0 EET} + {2646075600 7200 0 EET} {2658175200 10800 1 EEST} - {2674414800 7200 0 EET} + {2677525200 7200 0 EET} {2689624800 10800 1 EEST} - {2705950800 7200 0 EET} + {2708974800 7200 0 EET} {2721679200 10800 1 EEST} - {2737573200 7200 0 EET} + {2740424400 7200 0 EET} {2753128800 10800 1 EEST} - {2769109200 7200 0 EET} + {2771874000 7200 0 EET} {2784578400 10800 1 EEST} - {2800645200 7200 0 EET} + {2803323600 7200 0 EET} {2816028000 10800 1 EEST} - {2832181200 7200 0 EET} + {2835378000 7200 0 EET} {2847477600 10800 1 EEST} - {2863803600 7200 0 EET} + {2866827600 7200 0 EET} {2878927200 10800 1 EEST} - {2895339600 7200 0 EET} + {2898277200 7200 0 EET} {2910981600 10800 1 EEST} - {2926875600 7200 0 EET} + {2929726800 7200 0 EET} {2942431200 10800 1 EEST} - {2958411600 7200 0 EET} + {2961176400 7200 0 EET} {2973880800 10800 1 EEST} - {2990034000 7200 0 EET} + {2993230800 7200 0 EET} {3005330400 10800 1 EEST} - {3021570000 7200 0 EET} + {3024680400 7200 0 EET} {3036780000 10800 1 EEST} - {3053106000 7200 0 EET} + {3056130000 7200 0 EET} {3068229600 10800 1 EEST} - {3084642000 7200 0 EET} + {3087579600 7200 0 EET} {3100284000 10800 1 EEST} - {3116264400 7200 0 EET} + {3119029200 7200 0 EET} {3131733600 10800 1 EEST} - {3147800400 7200 0 EET} + {3150478800 7200 0 EET} {3163183200 10800 1 EEST} - {3179336400 7200 0 EET} + {3182533200 7200 0 EET} {3194632800 10800 1 EEST} - {3210872400 7200 0 EET} + {3213982800 7200 0 EET} {3226082400 10800 1 EEST} - {3242494800 7200 0 EET} + {3245432400 7200 0 EET} {3258136800 10800 1 EEST} - {3274030800 7200 0 EET} + {3276882000 7200 0 EET} {3289586400 10800 1 EEST} - {3305566800 7200 0 EET} + {3308331600 7200 0 EET} {3321036000 10800 1 EEST} - {3337102800 7200 0 EET} + {3339781200 7200 0 EET} {3352485600 10800 1 EEST} - {3368725200 7200 0 EET} + {3371835600 7200 0 EET} {3383935200 10800 1 EEST} - {3400261200 7200 0 EET} + {3403285200 7200 0 EET} {3415384800 10800 1 EEST} - {3431797200 7200 0 EET} + {3434734800 7200 0 EET} {3447439200 10800 1 EEST} - {3463333200 7200 0 EET} + {3466184400 7200 0 EET} {3478888800 10800 1 EEST} - {3494955600 7200 0 EET} + {3497634000 7200 0 EET} {3510338400 10800 1 EEST} - {3526491600 7200 0 EET} + {3529688400 7200 0 EET} {3541788000 10800 1 EEST} - {3558027600 7200 0 EET} + {3561138000 7200 0 EET} {3573237600 10800 1 EEST} - {3589563600 7200 0 EET} + {3592587600 7200 0 EET} {3605292000 10800 1 EEST} - {3621186000 7200 0 EET} + {3624037200 7200 0 EET} {3636741600 10800 1 EEST} - {3652722000 7200 0 EET} + {3655486800 7200 0 EET} {3668191200 10800 1 EEST} - {3684258000 7200 0 EET} + {3686936400 7200 0 EET} {3699640800 10800 1 EEST} - {3715794000 7200 0 EET} + {3718990800 7200 0 EET} {3731090400 10800 1 EEST} - {3747416400 7200 0 EET} + {3750440400 7200 0 EET} {3762540000 10800 1 EEST} - {3778952400 7200 0 EET} + {3781890000 7200 0 EET} {3794594400 10800 1 EEST} - {3810488400 7200 0 EET} + {3813339600 7200 0 EET} {3826044000 10800 1 EEST} - {3842024400 7200 0 EET} + {3844789200 7200 0 EET} {3857493600 10800 1 EEST} - {3873646800 7200 0 EET} + {3876843600 7200 0 EET} {3888943200 10800 1 EEST} - {3905182800 7200 0 EET} + {3908293200 7200 0 EET} {3920392800 10800 1 EEST} - {3936718800 7200 0 EET} + {3939742800 7200 0 EET} {3951842400 10800 1 EEST} - {3968254800 7200 0 EET} + {3971192400 7200 0 EET} {3983896800 10800 1 EEST} - {3999877200 7200 0 EET} + {4002642000 7200 0 EET} {4015346400 10800 1 EEST} - {4031413200 7200 0 EET} + {4034091600 7200 0 EET} {4046796000 10800 1 EEST} - {4062949200 7200 0 EET} + {4066146000 7200 0 EET} {4078245600 10800 1 EEST} - {4094485200 7200 0 EET} + {4097595600 7200 0 EET} } diff --git a/library/tzdata/Asia/Gaza b/library/tzdata/Asia/Gaza index 3ceb8bb..5995729 100644 --- a/library/tzdata/Asia/Gaza +++ b/library/tzdata/Asia/Gaza @@ -87,189 +87,189 @@ set TZData(:Asia/Gaza) { {1143842400 10800 1 EEST} {1158872400 7200 0 EET} {1175378400 10800 1 EEST} - {1192741200 7200 0 EET} + {1189638000 7200 0 EET} {1207000800 10800 1 EEST} - {1224190800 7200 0 EET} + {1221087600 7200 0 EET} {1238536800 10800 1 EEST} - {1255640400 7200 0 EET} + {1252537200 7200 0 EET} {1270072800 10800 1 EEST} - {1287090000 7200 0 EET} + {1283986800 7200 0 EET} {1301608800 10800 1 EEST} - {1319144400 7200 0 EET} + {1315436400 7200 0 EET} {1333231200 10800 1 EEST} - {1350594000 7200 0 EET} + {1347490800 7200 0 EET} {1364767200 10800 1 EEST} - {1382043600 7200 0 EET} + {1378940400 7200 0 EET} {1396303200 10800 1 EEST} - {1413493200 7200 0 EET} + {1410390000 7200 0 EET} {1427839200 10800 1 EEST} - {1444942800 7200 0 EET} + {1441839600 7200 0 EET} {1459461600 10800 1 EEST} - {1476997200 7200 0 EET} + {1473289200 7200 0 EET} {1490997600 10800 1 EEST} - {1508446800 7200 0 EET} + {1505343600 7200 0 EET} {1522533600 10800 1 EEST} - {1539896400 7200 0 EET} + {1536793200 7200 0 EET} {1554069600 10800 1 EEST} - {1571346000 7200 0 EET} + {1568242800 7200 0 EET} {1585692000 10800 1 EEST} - {1602795600 7200 0 EET} + {1599692400 7200 0 EET} {1617228000 10800 1 EEST} - {1634245200 7200 0 EET} + {1631142000 7200 0 EET} {1648764000 10800 1 EEST} - {1666299600 7200 0 EET} + {1662591600 7200 0 EET} {1680300000 10800 1 EEST} - {1697749200 7200 0 EET} + {1694646000 7200 0 EET} {1711922400 10800 1 EEST} - {1729198800 7200 0 EET} + {1726095600 7200 0 EET} {1743458400 10800 1 EEST} - {1760648400 7200 0 EET} + {1757545200 7200 0 EET} {1774994400 10800 1 EEST} - {1792098000 7200 0 EET} + {1788994800 7200 0 EET} {1806530400 10800 1 EEST} - {1823547600 7200 0 EET} + {1820444400 7200 0 EET} {1838152800 10800 1 EEST} - {1855602000 7200 0 EET} + {1852498800 7200 0 EET} {1869688800 10800 1 EEST} - {1887051600 7200 0 EET} + {1883948400 7200 0 EET} {1901224800 10800 1 EEST} - {1918501200 7200 0 EET} + {1915398000 7200 0 EET} {1932760800 10800 1 EEST} - {1949950800 7200 0 EET} + {1946847600 7200 0 EET} {1964383200 10800 1 EEST} - {1981400400 7200 0 EET} + {1978297200 7200 0 EET} {1995919200 10800 1 EEST} - {2013454800 7200 0 EET} + {2009746800 7200 0 EET} {2027455200 10800 1 EEST} - {2044904400 7200 0 EET} + {2041801200 7200 0 EET} {2058991200 10800 1 EEST} - {2076354000 7200 0 EET} + {2073250800 7200 0 EET} {2090613600 10800 1 EEST} - {2107803600 7200 0 EET} + {2104700400 7200 0 EET} {2122149600 10800 1 EEST} - {2139253200 7200 0 EET} + {2136150000 7200 0 EET} {2153685600 10800 1 EEST} - {2170702800 7200 0 EET} + {2167599600 7200 0 EET} {2185221600 10800 1 EEST} - {2202757200 7200 0 EET} + {2199049200 7200 0 EET} {2216844000 10800 1 EEST} - {2234206800 7200 0 EET} + {2231103600 7200 0 EET} {2248380000 10800 1 EEST} - {2265656400 7200 0 EET} + {2262553200 7200 0 EET} {2279916000 10800 1 EEST} - {2297106000 7200 0 EET} + {2294002800 7200 0 EET} {2311452000 10800 1 EEST} - {2328555600 7200 0 EET} + {2325452400 7200 0 EET} {2343074400 10800 1 EEST} - {2360610000 7200 0 EET} + {2356902000 7200 0 EET} {2374610400 10800 1 EEST} - {2392059600 7200 0 EET} + {2388956400 7200 0 EET} {2406146400 10800 1 EEST} - {2423509200 7200 0 EET} + {2420406000 7200 0 EET} {2437682400 10800 1 EEST} - {2454958800 7200 0 EET} + {2451855600 7200 0 EET} {2469304800 10800 1 EEST} - {2486408400 7200 0 EET} + {2483305200 7200 0 EET} {2500840800 10800 1 EEST} - {2517858000 7200 0 EET} + {2514754800 7200 0 EET} {2532376800 10800 1 EEST} - {2549912400 7200 0 EET} + {2546204400 7200 0 EET} {2563912800 10800 1 EEST} - {2581362000 7200 0 EET} + {2578258800 7200 0 EET} {2595535200 10800 1 EEST} - {2612811600 7200 0 EET} + {2609708400 7200 0 EET} {2627071200 10800 1 EEST} - {2644261200 7200 0 EET} + {2641158000 7200 0 EET} {2658607200 10800 1 EEST} - {2675710800 7200 0 EET} + {2672607600 7200 0 EET} {2690143200 10800 1 EEST} - {2707160400 7200 0 EET} + {2704057200 7200 0 EET} {2721765600 10800 1 EEST} - {2739214800 7200 0 EET} + {2736111600 7200 0 EET} {2753301600 10800 1 EEST} - {2770664400 7200 0 EET} + {2767561200 7200 0 EET} {2784837600 10800 1 EEST} - {2802114000 7200 0 EET} + {2799010800 7200 0 EET} {2816373600 10800 1 EEST} - {2833563600 7200 0 EET} + {2830460400 7200 0 EET} {2847996000 10800 1 EEST} - {2865013200 7200 0 EET} + {2861910000 7200 0 EET} {2879532000 10800 1 EEST} - {2897067600 7200 0 EET} + {2893359600 7200 0 EET} {2911068000 10800 1 EEST} - {2928517200 7200 0 EET} + {2925414000 7200 0 EET} {2942604000 10800 1 EEST} - {2959966800 7200 0 EET} + {2956863600 7200 0 EET} {2974226400 10800 1 EEST} - {2991416400 7200 0 EET} + {2988313200 7200 0 EET} {3005762400 10800 1 EEST} - {3022866000 7200 0 EET} + {3019762800 7200 0 EET} {3037298400 10800 1 EEST} - {3054315600 7200 0 EET} + {3051212400 7200 0 EET} {3068834400 10800 1 EEST} - {3086370000 7200 0 EET} + {3082662000 7200 0 EET} {3100456800 10800 1 EEST} - {3117819600 7200 0 EET} + {3114716400 7200 0 EET} {3131992800 10800 1 EEST} - {3149269200 7200 0 EET} + {3146166000 7200 0 EET} {3163528800 10800 1 EEST} - {3180718800 7200 0 EET} + {3177615600 7200 0 EET} {3195064800 10800 1 EEST} - {3212168400 7200 0 EET} + {3209065200 7200 0 EET} {3226687200 10800 1 EEST} - {3244222800 7200 0 EET} + {3240514800 7200 0 EET} {3258223200 10800 1 EEST} - {3275672400 7200 0 EET} + {3272569200 7200 0 EET} {3289759200 10800 1 EEST} - {3307122000 7200 0 EET} + {3304018800 7200 0 EET} {3321295200 10800 1 EEST} - {3338571600 7200 0 EET} + {3335468400 7200 0 EET} {3352917600 10800 1 EEST} - {3370021200 7200 0 EET} + {3366918000 7200 0 EET} {3384453600 10800 1 EEST} - {3401470800 7200 0 EET} + {3398367600 7200 0 EET} {3415989600 10800 1 EEST} - {3433525200 7200 0 EET} + {3429817200 7200 0 EET} {3447525600 10800 1 EEST} - {3464974800 7200 0 EET} + {3461871600 7200 0 EET} {3479148000 10800 1 EEST} - {3496424400 7200 0 EET} + {3493321200 7200 0 EET} {3510684000 10800 1 EEST} - {3527874000 7200 0 EET} + {3524770800 7200 0 EET} {3542220000 10800 1 EEST} - {3559323600 7200 0 EET} + {3556220400 7200 0 EET} {3573756000 10800 1 EEST} - {3590773200 7200 0 EET} + {3587670000 7200 0 EET} {3605378400 10800 1 EEST} - {3622827600 7200 0 EET} + {3619724400 7200 0 EET} {3636914400 10800 1 EEST} - {3654277200 7200 0 EET} + {3651174000 7200 0 EET} {3668450400 10800 1 EEST} - {3685726800 7200 0 EET} + {3682623600 7200 0 EET} {3699986400 10800 1 EEST} - {3717176400 7200 0 EET} + {3714073200 7200 0 EET} {3731608800 10800 1 EEST} - {3748626000 7200 0 EET} + {3745522800 7200 0 EET} {3763144800 10800 1 EEST} - {3780680400 7200 0 EET} + {3776972400 7200 0 EET} {3794680800 10800 1 EEST} - {3812130000 7200 0 EET} + {3809026800 7200 0 EET} {3826216800 10800 1 EEST} - {3843579600 7200 0 EET} + {3840476400 7200 0 EET} {3857839200 10800 1 EEST} - {3875029200 7200 0 EET} + {3871926000 7200 0 EET} {3889375200 10800 1 EEST} - {3906478800 7200 0 EET} + {3903375600 7200 0 EET} {3920911200 10800 1 EEST} - {3937928400 7200 0 EET} + {3934825200 7200 0 EET} {3952447200 10800 1 EEST} - {3969982800 7200 0 EET} + {3966274800 7200 0 EET} {3984069600 10800 1 EEST} - {4001432400 7200 0 EET} + {3998329200 7200 0 EET} {4015605600 10800 1 EEST} - {4032882000 7200 0 EET} + {4029778800 7200 0 EET} {4047141600 10800 1 EEST} - {4064331600 7200 0 EET} + {4061228400 7200 0 EET} {4078677600 10800 1 EEST} - {4095781200 7200 0 EET} + {4092678000 7200 0 EET} } diff --git a/library/tzdata/Asia/Tehran b/library/tzdata/Asia/Tehran index 9985844..7dca0ae 100644 --- a/library/tzdata/Asia/Tehran +++ b/library/tzdata/Asia/Tehran @@ -42,4 +42,64 @@ set TZData(:Asia/Tehran) { {1095708600 12600 0 IRST} {1111437000 16200 1 IRDT} {1127331000 12600 0 IRST} + {1206045000 16200 1 IRDT} + {1221939000 12600 0 IRST} + {1237667400 16200 1 IRDT} + {1253561400 12600 0 IRST} + {1269203400 16200 1 IRDT} + {1285097400 12600 0 IRST} + {1300739400 16200 1 IRDT} + {1316633400 12600 0 IRST} + {1332275400 16200 1 IRDT} + {1348169400 12600 0 IRST} + {1363897800 16200 1 IRDT} + {1379791800 12600 0 IRST} + {1395433800 16200 1 IRDT} + {1411327800 12600 0 IRST} + {1426969800 16200 1 IRDT} + {1442863800 12600 0 IRST} + {1458505800 16200 1 IRDT} + {1474399800 12600 0 IRST} + {1490128200 16200 1 IRDT} + {1506022200 12600 0 IRST} + {1521664200 16200 1 IRDT} + {1537558200 12600 0 IRST} + {1553200200 16200 1 IRDT} + {1569094200 12600 0 IRST} + {1584736200 16200 1 IRDT} + {1600630200 12600 0 IRST} + {1616358600 16200 1 IRDT} + {1632252600 12600 0 IRST} + {1647894600 16200 1 IRDT} + {1663788600 12600 0 IRST} + {1679430600 16200 1 IRDT} + {1695324600 12600 0 IRST} + {1710966600 16200 1 IRDT} + {1726860600 12600 0 IRST} + {1742589000 16200 1 IRDT} + {1758483000 12600 0 IRST} + {1774125000 16200 1 IRDT} + {1790019000 12600 0 IRST} + {1805661000 16200 1 IRDT} + {1821555000 12600 0 IRST} + {1837197000 16200 1 IRDT} + {1853091000 12600 0 IRST} + {1868733000 16200 1 IRDT} + {1884627000 12600 0 IRST} + {1900355400 16200 1 IRDT} + {1916249400 12600 0 IRST} + {1931891400 16200 1 IRDT} + {1947785400 12600 0 IRST} + {1963427400 16200 1 IRDT} + {1979321400 12600 0 IRST} + {1994963400 16200 1 IRDT} + {2010857400 12600 0 IRST} + {2026585800 16200 1 IRDT} + {2042479800 12600 0 IRST} + {2058121800 16200 1 IRDT} + {2074015800 12600 0 IRST} + {2089657800 16200 1 IRDT} + {2105551800 12600 0 IRST} + {2121193800 16200 1 IRDT} + {2137087800 12600 0 IRST} } diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 9a4a80d..81a3118 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: ioCmd.test,v 1.31 2006/12/01 15:55:45 dgp Exp $ +# RCS: @(#) $Id: ioCmd.test,v 1.31.2.1 2007/11/21 06:30:57 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -118,7 +118,7 @@ test iocmd-4.4 {read command} { } {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"}} test iocmd-4.5 {read command} { list [catch {read -nonew file4} msg] $msg $::errorCode -} {1 {can not find channel named "-nonew"} NONE} +} {1 {can not find channel named "-nonew"} {TCL LOOKUP CHANNEL -nonew}} test iocmd-4.6 {read command} { list [catch {read stdout} msg] $msg } {1 {channel "stdout" wasn't opened for reading}} @@ -141,10 +141,8 @@ test iocmd-4.9 {read command} { } {1 {bad argument "foo": should be "nonewline"} NONE} test iocmd-4.10 {read command} { list [catch {read file107} msg] $msg $::errorCode -} {1 {can not find channel named "file107"} NONE} - +} {1 {can not find channel named "file107"} {TCL LOOKUP CHANNEL file107}} set path(test3) [makeFile {} test3] - test iocmd-4.11 {read command} { set f [open $path(test3) w] set x [list [catch {read $f} msg] $msg $::errorCode] @@ -245,9 +243,7 @@ test iocmd-8.9 {fconfigure command} { test iocmd-8.10 {fconfigure command} { list [catch {fconfigure a b} msg] $msg } {1 {can not find channel named "a"}} - set path(fconfigure.dummy) [makeFile {} fconfigure.dummy] - test iocmd-8.11 {fconfigure command} { set chan [open $path(fconfigure.dummy) r] set res [list [catch {fconfigure $chan -froboz blarfo} msg] $msg] @@ -266,9 +262,7 @@ test iocmd-8.13 {fconfigure command} { close $chan set res } {1 {bad option "-buffer": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}} - removeFile fconfigure.dummy - test iocmd-8.14 {fconfigure command} { fconfigure stdin -buffers } 4096 @@ -351,7 +345,7 @@ test iocmd-9.2 {eof command} { test iocmd-9.3 {eof command} { catch {close file100} list [catch {eof file100} msg] $msg $::errorCode -} {1 {can not find channel named "file100"} NONE} +} {1 {can not find channel named "file100"} {TCL LOOKUP CHANNEL file100}} # The tests for Tcl_ExecObjCmd are in exec.test @@ -502,7 +496,6 @@ test iocmd-13.8 {errors in open command} { test iocmd-13.9 {errors in open command} { list [catch {open $path(test1) r++} msg] $msg } {1 {illegal access mode "r++"}} - test iocmd-13.10.1 {open for append, a mode} -setup { set log [makeFile {} out] set chans {} @@ -518,7 +511,6 @@ test iocmd-13.10.1 {open for append, a mode} -setup { # Ensure that channels are gone, even if body failed to do so foreach ch $chans {catch {close $ch}} } -result {0 1 2 3 4 5 6 7 8 9} - test iocmd-13.10.2 {open for append, O_APPEND} -setup { set log [makeFile {} out] set chans {} @@ -537,7 +529,7 @@ test iocmd-13.10.2 {open for append, O_APPEND} -setup { test iocmd-14.1 {file id parsing errors} { list [catch {eof gorp} msg] $msg $::errorCode -} {1 {can not find channel named "gorp"} NONE} +} {1 {can not find channel named "gorp"} {TCL LOOKUP CHANNEL gorp}} test iocmd-14.2 {file id parsing errors} { list [catch {eof filex} msg] $msg } {1 {can not find channel named "filex"}} diff --git a/tests/namespace.test b/tests/namespace.test index 3ea7f3e..0fe16d3 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: namespace.test,v 1.66.2.2 2007/09/10 03:06:47 dgp Exp $ +# RCS: @(#) $Id: namespace.test,v 1.66.2.3 2007/11/21 06:30:57 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -174,7 +174,7 @@ test namespace-7.7 {Bug 1655305} -setup { interp create slave # Can't invoke through the ensemble, since deleting the global namespace # (indirectly, via deleting ::tcl) deletes the ensemble. - slave eval {rename ::tcl::Info_commands ::infocommands} + slave eval {rename ::tcl::info::commands ::infocommands} slave hide infocommands slave eval { proc foo {} { diff --git a/tests/trace.test b/tests/trace.test index a15790e..12f9a0f 100644 --- a/tests/trace.test +++ b/tests/trace.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: trace.test,v 1.51.2.6 2007/09/04 17:44:11 dgp Exp $ +# RCS: @(#) $Id: trace.test,v 1.51.2.7 2007/11/21 06:30:57 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -2277,7 +2277,7 @@ test trace-29.1 {Tcl_CreateTrace, correct command and argc/argv arguments of tra } {{expr 14 + 16} {expr 14 + 16} {set stuff [expr 14 + 16]} {set stuff 30}} test trace-29.2 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} { testcmdtrace tracetest {set stuff [info tclversion]} -} [concat {{info tclversion} {info tclversion} ::tcl::Info_tclversion {::tcl::Info_tclversion} {set stuff [info tclversion]}} [list "set stuff [info tclversion]"]] +} [concat {{info tclversion} {info tclversion} ::tcl::info::tclversion {::tcl::info::tclversion} {set stuff [info tclversion]}} [list "set stuff [info tclversion]"]] test trace-29.3 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} { testcmdtrace deletetest {set stuff [info tclversion]} } [info tclversion] diff --git a/unix/configure b/unix/configure index 12e498c..c266e59 100755 --- a/unix/configure +++ b/unix/configure @@ -7012,12 +7012,12 @@ fi # Use updated header definitions where possible cat >>confdefs.h <<\_ACEOF -#define _XOPEN_SOURCE 1 +#define _XOPEN_SOURCE_EXTENDED 1 _ACEOF cat >>confdefs.h <<\_ACEOF -#define _XOPEN_SOURCE_EXTENDED 1 +#define _XOPEN_SOURCE 1 _ACEOF LIBS="$LIBS -lxnet" # Use the XOPEN network library @@ -7954,9 +7954,24 @@ echo "${ECHO_T}$tcl_cv_ld_search_paths_first" >&6 fi + if test "$tcl_cv_cc_visibility_hidden" != yes; then + + +cat >>confdefs.h <<\_ACEOF +#define MODULE_SCOPE __private_extern__ +_ACEOF + + +fi + CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH" + +cat >>confdefs.h <<\_ACEOF +#define MAC_OSX_TCL 1 +_ACEOF + PLAT_OBJS='${MAC_OSX_OBJS}' PLAT_SRCS='${MAC_OSX_SRCS}' echo "$as_me:$LINENO: checking whether to use CoreFoundation" >&5 @@ -8141,21 +8156,6 @@ fi fi - if test "$tcl_cv_cc_visibility_hidden" != yes; then - - -cat >>confdefs.h <<\_ACEOF -#define MODULE_SCOPE __private_extern__ -_ACEOF - - -fi - - -cat >>confdefs.h <<\_ACEOF -#define MAC_OSX_TCL 1 -_ACEOF - ;; NEXTSTEP-*) SHLIB_CFLAGS="" diff --git a/unix/configure.in b/unix/configure.in index 8f4d212..1f37674 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -3,7 +3,7 @@ dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. # -# RCS: @(#) $Id: configure.in,v 1.157.2.10 2007/11/16 07:20:57 dgp Exp $ +# RCS: @(#) $Id: configure.in,v 1.157.2.11 2007/11/21 06:31:00 dgp Exp $ AC_INIT([tcl],[8.5]) AC_PREREQ(2.59) diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 5b6f6eb..3cc5dc9 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -231,6 +231,7 @@ AC_DEFUN([SC_PATH_TKCONFIG], [ fi done fi + # check in a few other private locations if test x"${ac_cv_c_tkconfig}" = x ; then for i in \ @@ -282,7 +283,7 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [ if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then AC_MSG_RESULT([loading]) - . ${TCL_BIN_DIR}/tclConfig.sh + . "${TCL_BIN_DIR}/tclConfig.sh" else AC_MSG_RESULT([could not find ${TCL_BIN_DIR}/tclConfig.sh]) fi @@ -1287,8 +1288,8 @@ dnl AC_CHECK_TOOL(AR, ar) ;; HP-UX-*.11.*) # Use updated header definitions where possible - AC_DEFINE(_XOPEN_SOURCE, 1, [Do we want to use the XOPEN network library?]) AC_DEFINE(_XOPEN_SOURCE_EXTENDED, 1, [Do we want to use the XOPEN network library?]) + AC_DEFINE(_XOPEN_SOURCE, 1, [Do we want to use the XOPEN network library?]) LIBS="$LIBS -lxnet" # Use the XOPEN network library AS_IF([test "`uname -m`" = ia64], [ @@ -1660,9 +1661,14 @@ dnl AC_CHECK_TOOL(AR, ar) AS_IF([test $tcl_cv_ld_search_paths_first = yes], [ LDFLAGS="$LDFLAGS -Wl,-search_paths_first" ]) + AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [ + AC_DEFINE(MODULE_SCOPE, [__private_extern__], + [Compiler support for module scope symbols]) + ]) CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH" + AC_DEFINE(MAC_OSX_TCL, 1, [Is this a Mac I see before me?]) PLAT_OBJS='${MAC_OSX_OBJS}' PLAT_SRCS='${MAC_OSX_SRCS}' AC_MSG_CHECKING([whether to use CoreFoundation]) @@ -1718,11 +1724,6 @@ dnl AC_CHECK_TOOL(AR, ar) ]) ]) ]) - AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [ - AC_DEFINE(MODULE_SCOPE, [__private_extern__], - [Compiler support for module scope symbols]) - ]) - AC_DEFINE(MAC_OSX_TCL, 1, [Is this a Mac I see before me?]) ;; NEXTSTEP-*) SHLIB_CFLAGS="" diff --git a/unix/tcl.spec b/unix/tcl.spec index 6d8a3ce..f833a14 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -1,4 +1,4 @@ -# $Id: tcl.spec,v 1.27.2.3 2007/10/27 04:11:51 dgp Exp $ +# $Id: tcl.spec,v 1.27.2.4 2007/11/21 06:31:01 dgp Exp $ # This file is the basis for a binary Tcl RPM for Linux. %{!?directory:%define directory /usr/local} diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index d6be698..5b67f33 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixFCmd.c,v 1.61.2.2 2007/10/16 03:50:33 dgp Exp $ + * RCS: @(#) $Id: tclUnixFCmd.c,v 1.61.2.3 2007/11/21 06:31:02 dgp Exp $ * * Portions of this code were derived from NetBSD source code which has the * following copyright notice: @@ -1052,7 +1052,7 @@ TraverseUnixTree( while ((ent = fts_read(fts)) != NULL) { unsigned short info = ent->fts_info; - char * path = ent->fts_path + sourceLen; + char *path = ent->fts_path + sourceLen; unsigned short pathlen = ent->fts_pathlen - sourceLen; int type; Tcl_StatBuf *statBufPtr = NULL; @@ -1084,7 +1084,7 @@ TraverseUnixTree( break; } } else { - statBufPtr = ent->fts_statp; + statBufPtr = (Tcl_StatBuf *) ent->fts_statp; } } result = (*traverseProc)(sourcePtr, targetPtr, statBufPtr, type, diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index 8b611b5..0eb0aa4 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixThrd.c,v 1.51.2.1 2007/05/30 03:31:31 dgp Exp $ + * RCS: @(#) $Id: tclUnixThrd.c,v 1.51.2.2 2007/11/21 06:31:02 dgp Exp $ */ #include "tclInt.h" @@ -157,14 +157,14 @@ int Tcl_JoinThread( Tcl_ThreadId threadId, /* Id of the thread to wait upon. */ int *state) /* Reference to the storage the result of the - * thread we wait upon will be written - * into. May be NULL. */ + * thread we wait upon will be written into. + * May be NULL. */ { #ifdef TCL_THREADS int result; - unsigned long retcode; + unsigned long retcode, *retcodePtr = &retcode; - result = pthread_join((pthread_t) threadId, (void**) &retcode); + result = pthread_join((pthread_t) threadId, (void**) retcodePtr); if (state) { *state = (int) retcode; } diff --git a/win/configure.in b/win/configure.in index 08dbbe6..8585602 100644 --- a/win/configure.in +++ b/win/configure.in @@ -3,7 +3,7 @@ # generate the file "configure", which is run during Tcl installation # to configure the system for the local environment. # -# RCS: @(#) $Id: configure.in,v 1.92.2.4 2007/10/27 04:11:51 dgp Exp $ +# RCS: @(#) $Id: configure.in,v 1.92.2.5 2007/11/21 06:31:02 dgp Exp $ AC_INIT(../generic/tcl.h) AC_PREREQ(2.59) diff --git a/win/tclWinInit.c b/win/tclWinInit.c index a179365..1bc5a56 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinInit.c,v 1.73 2007/05/05 07:23:18 dkf Exp $ + * RCS: @(#) $Id: tclWinInit.c,v 1.73.2.1 2007/11/21 06:31:02 dgp Exp $ */ #include "tclWinInt.h" @@ -592,7 +592,7 @@ TclpSetVariables( * TclpFindVariable -- * * Locate the entry in environ for a given name. On Unix this routine is - * case sensetive, on Windows this matches mioxed case. + * case sensitive, on Windows this matches mioxed case. * * Results: * The return value is the index in environ of an entry with the name diff --git a/win/tclWinTest.c b/win/tclWinTest.c index ac00411..eb3123c 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinTest.c,v 1.19.2.1 2007/09/04 17:44:27 dgp Exp $ + * RCS: @(#) $Id: tclWinTest.c,v 1.19.2.2 2007/11/21 06:31:03 dgp Exp $ */ #include "tclInt.h" @@ -73,18 +73,13 @@ TclplatformtestInit( * Add commands for platform specific tests for Windows here. */ - Tcl_CreateCommand(interp, "testchmod", TestchmodCmd, - (ClientData) 0, NULL); - Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd, - (ClientData) 0, NULL); + Tcl_CreateCommand(interp, "testchmod", TestchmodCmd, NULL, NULL); + Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd, - (ClientData) 0, NULL); - Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, - (ClientData) 0, NULL); - Tcl_CreateObjCommand(interp, "testwincpuid", TestwincpuidCmd, - (ClientData) 0, NULL); - Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, - (ClientData) 0, NULL); + NULL, NULL); + Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testwincpuid", TestwincpuidCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL); return TCL_OK; } @@ -112,23 +107,21 @@ TesteventloopCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + const char **argv) /* Argument strings. */ { static int *framePtr = NULL;/* Pointer to integer on stack frame of * innermost invocation of the "wait" * subcommand. */ - if (argc < 2) { + if (argc < 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " option ... \"", NULL); - return TCL_ERROR; + " option ... \"", NULL); + return TCL_ERROR; } if (strcmp(argv[1], "done") == 0) { *framePtr = 1; } else if (strcmp(argv[1], "wait") == 0) { - int *oldFramePtr; - int done; - MSG msg; + int *oldFramePtr, done; int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); /* @@ -139,19 +132,21 @@ TesteventloopCmd( framePtr = &done; /* - * Enter a standard Windows event loop until the flag changes. - * Note that we do not explicitly call Tcl_ServiceEvent(). + * Enter a standard Windows event loop until the flag changes. Note + * that we do not explicitly call Tcl_ServiceEvent(). */ done = 0; while (!done) { + MSG msg; + if (!GetMessage(&msg, NULL, 0, 0)) { /* - * The application is exiting, so repost the quit message - * and start unwinding. + * The application is exiting, so repost the quit message and + * start unwinding. */ - PostQuitMessage((int)msg.wParam); + PostQuitMessage((int) msg.wParam); break; } TranslateMessage(&msg); @@ -198,19 +193,20 @@ TestvolumetypeCmd( if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?name?"); - return TCL_ERROR; + return TCL_ERROR; } if (objc == 2) { /* - * path has to be really a proper volume, but we don't - * get query APIs for that until NT5 + * path has to be really a proper volume, but we don't get query APIs + * for that until NT5 */ + path = Tcl_GetString(objv[1]); } else { path = NULL; } - found = GetVolumeInformationA(path, NULL, 0, NULL, NULL, - NULL, volType, VOL_BUF_SIZE); + found = GetVolumeInformationA(path, NULL, 0, NULL, NULL, NULL, volType, + VOL_BUF_SIZE); if (found == 0) { Tcl_AppendResult(interp, "could not get volume type for \"", @@ -228,9 +224,9 @@ TestvolumetypeCmd( * * TestwinclockCmd -- * - * Command that returns the seconds and microseconds portions of - * the system clock and of the Tcl clock so that they can be - * compared to validate that the Tcl clock is staying in sync. + * Command that returns the seconds and microseconds portions of the + * system clock and of the Tcl clock so that they can be compared to + * validate that the Tcl clock is staying in sync. * * Usage: * testclock @@ -239,9 +235,9 @@ TestvolumetypeCmd( * None. * * Results: - * Returns a standard Tcl result comprising a four-element list: - * the seconds and microseconds portions of the system clock, - * and the seconds and microseconds portions of the Tcl clock. + * Returns a standard Tcl result comprising a four-element list: the + * seconds and microseconds portions of the system clock, and the seconds + * and microseconds portions of the Tcl clock. * * Side effects: * None. @@ -261,7 +257,7 @@ TestwinclockCmd( * FILETIME */ Tcl_Time tclTime; /* Tcl clock */ FILETIME sysTime; /* System clock */ - Tcl_Obj* result; /* Result of the command */ + Tcl_Obj *result; /* Result of the command */ LARGE_INTEGER t1, t2; LARGE_INTEGER p1, p2; @@ -312,8 +308,8 @@ TestwinclockCmd( * eax - The value to pass in the EAX register to a CPUID instruction. * * Results: - * Returns a four-element list containing the values from the - * EAX, EBX, ECX and EDX registers returned from the CPUID instruction. + * Returns a four-element list containing the values from the EAX, EBX, + * ECX and EDX registers returned from the CPUID instruction. * * Side effects: * None. @@ -328,11 +324,9 @@ TestwincpuidCmd( int objc, /* Parameter count */ Tcl_Obj *const * objv) /* Parameter vector */ { - int status; - int index; + int status, index, i; unsigned int regs[4]; - Tcl_Obj * regsObjs[4]; - int i; + Tcl_Obj *regsObjs[4]; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "eax"); @@ -341,7 +335,7 @@ TestwincpuidCmd( if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) { return TCL_ERROR; } - status = TclWinCPUID((unsigned int) index, regs); + status = TclWinCPUID((unsigned) index, regs); if (status != TCL_OK) { Tcl_SetObjResult(interp, Tcl_NewStringObj("operation not available", -1)); @@ -385,6 +379,7 @@ TestwinsleepCmd( Tcl_Obj *const * objv) /* Parameter vector */ { int ms; + if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "ms"); return TCL_ERROR; @@ -427,51 +422,25 @@ TestExceptionCmd( Tcl_Obj *const objv[]) /* Argument vector */ { static const char *cmds[] = { - "access_violation", - "datatype_misalignment", - "array_bounds", - "float_denormal", - "float_divbyzero", - "float_inexact", - "float_invalidop", - "float_overflow", - "float_stack", - "float_underflow", - "int_divbyzero", - "int_overflow", - "private_instruction", - "inpageerror", - "illegal_instruction", - "noncontinue", - "stack_overflow", - "invalid_disp", - "guard_page", - "invalid_handle", - "ctrl+c", - NULL + "access_violation", "datatype_misalignment", "array_bounds", + "float_denormal", "float_divbyzero", "float_inexact", + "float_invalidop", "float_overflow", "float_stack", "float_underflow", + "int_divbyzero", "int_overflow", "private_instruction", "inpageerror", + "illegal_instruction", "noncontinue", "stack_overflow", + "invalid_disp", "guard_page", "invalid_handle", "ctrl+c", + NULL }; static DWORD exceptions[] = { - EXCEPTION_ACCESS_VIOLATION, - EXCEPTION_DATATYPE_MISALIGNMENT, - EXCEPTION_ARRAY_BOUNDS_EXCEEDED, - EXCEPTION_FLT_DENORMAL_OPERAND, - EXCEPTION_FLT_DIVIDE_BY_ZERO, - EXCEPTION_FLT_INEXACT_RESULT, - EXCEPTION_FLT_INVALID_OPERATION, - EXCEPTION_FLT_OVERFLOW, - EXCEPTION_FLT_STACK_CHECK, - EXCEPTION_FLT_UNDERFLOW, - EXCEPTION_INT_DIVIDE_BY_ZERO, - EXCEPTION_INT_OVERFLOW, - EXCEPTION_PRIV_INSTRUCTION, - EXCEPTION_IN_PAGE_ERROR, - EXCEPTION_ILLEGAL_INSTRUCTION, - EXCEPTION_NONCONTINUABLE_EXCEPTION, - EXCEPTION_STACK_OVERFLOW, - EXCEPTION_INVALID_DISPOSITION, - EXCEPTION_GUARD_PAGE, - EXCEPTION_INVALID_HANDLE, - CONTROL_C_EXIT + EXCEPTION_ACCESS_VIOLATION, EXCEPTION_DATATYPE_MISALIGNMENT, + EXCEPTION_ARRAY_BOUNDS_EXCEEDED, EXCEPTION_FLT_DENORMAL_OPERAND, + EXCEPTION_FLT_DIVIDE_BY_ZERO, EXCEPTION_FLT_INEXACT_RESULT, + EXCEPTION_FLT_INVALID_OPERATION, EXCEPTION_FLT_OVERFLOW, + EXCEPTION_FLT_STACK_CHECK, EXCEPTION_FLT_UNDERFLOW, + EXCEPTION_INT_DIVIDE_BY_ZERO, EXCEPTION_INT_OVERFLOW, + EXCEPTION_PRIV_INSTRUCTION, EXCEPTION_IN_PAGE_ERROR, + EXCEPTION_ILLEGAL_INSTRUCTION, EXCEPTION_NONCONTINUABLE_EXCEPTION, + EXCEPTION_STACK_OVERFLOW, EXCEPTION_INVALID_DISPOSITION, + EXCEPTION_GUARD_PAGE, EXCEPTION_INVALID_HANDLE, CONTROL_C_EXIT }; int cmd; @@ -504,258 +473,307 @@ TestExceptionCmd( return TCL_OK; } -static int +static int TestplatformChmod( const char *nativePath, int pmode) { - SID_IDENTIFIER_AUTHORITY userSidAuthority = - { SECURITY_WORLD_SID_AUTHORITY }; + typedef DWORD (WINAPI *getSidLengthRequiredDef)(UCHAR); + typedef BOOL (WINAPI *initializeSidDef)(PSID, PSID_IDENTIFIER_AUTHORITY, + BYTE); + typedef PDWORD (WINAPI *getSidSubAuthorityDef)(PSID, DWORD); + typedef DWORD (WINAPI *setNamedSecurityInfoADef)(IN LPSTR, + IN SE_OBJECT_TYPE, IN SECURITY_INFORMATION, IN PSID, IN PSID, + IN PACL, IN PACL); + typedef BOOL (WINAPI *getAceDef)(PACL, DWORD, LPVOID *); + typedef BOOL (WINAPI *addAceDef)(PACL, DWORD, DWORD, LPVOID, DWORD); + typedef BOOL (WINAPI *equalSidDef)(PSID, PSID); + typedef BOOL (WINAPI *addAccessDeniedAceDef)(PACL, DWORD, DWORD, PSID); + typedef BOOL (WINAPI *initializeAclDef)(PACL, DWORD, DWORD); + typedef DWORD (WINAPI *getLengthSidDef)(PSID); + typedef BOOL (WINAPI *getAclInformationDef)(PACL, LPVOID, DWORD, + ACL_INFORMATION_CLASS); + typedef BOOL (WINAPI *getSecurityDescriptorDaclDef)(PSECURITY_DESCRIPTOR, + LPBOOL, PACL *, LPBOOL); + typedef BOOL (WINAPI *lookupAccountNameADef)(LPCSTR, LPCSTR, PSID, + PDWORD, LPSTR, LPDWORD, PSID_NAME_USE); + typedef BOOL (WINAPI *getFileSecurityADef)(LPCSTR, SECURITY_INFORMATION, + PSECURITY_DESCRIPTOR, DWORD, LPDWORD); + + static const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION + | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION; + static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE + | FILE_ADD_SUBDIRECTORY | FILE_WRITE_EA | FILE_APPEND_DATA + | FILE_WRITE_DATA | DELETE; - typedef DWORD (WINAPI *getSidLengthRequiredDef) ( UCHAR ); - typedef BOOL (WINAPI *initializeSidDef) ( PSID, - PSID_IDENTIFIER_AUTHORITY, BYTE ); - typedef PDWORD (WINAPI *getSidSubAuthorityDef) ( PSID, DWORD ); + /* + * References to security functions (only available on NT and later). + */ static getSidLengthRequiredDef getSidLengthRequiredProc; static initializeSidDef initializeSidProc; static getSidSubAuthorityDef getSidSubAuthorityProc; - static const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION - | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION; - static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE - | FILE_ADD_SUBDIRECTORY | FILE_WRITE_EA | FILE_APPEND_DATA - | FILE_WRITE_DATA | DELETE; - - BYTE *secDesc = 0; - DWORD secDescLen; + static setNamedSecurityInfoADef setNamedSecurityInfoProc; + static getAceDef getAceProc; + static addAceDef addAceProc; + static equalSidDef equalSidProc; + static addAccessDeniedAceDef addAccessDeniedAceProc; + static initializeAclDef initializeAclProc; + static getLengthSidDef getLengthSidProc; + static getAclInformationDef getAclInformationProc; + static getSecurityDescriptorDaclDef getSecurityDescriptorDaclProc; + static lookupAccountNameADef lookupAccountNameProc; + static getFileSecurityADef getFileSecurityProc; + static int initialized = 0; const BOOL set_readOnly = !(pmode & 0222); - BOOL acl_readOnly_found = FALSE; - + BOOL acl_readOnly_found = FALSE, curAclPresent, curAclDefaulted; + SID_IDENTIFIER_AUTHORITY userSidAuthority = { + SECURITY_WORLD_SID_AUTHORITY + }; + BYTE *secDesc = 0; + DWORD secDescLen, attr, newAclSize; ACL_SIZE_INFORMATION ACLSize; - BOOL curAclPresent, curAclDefaulted; - PACL curAcl; - PACL newAcl = 0; - DWORD newAclSize; - + PACL curAcl, newAcl = 0; WORD j; - SID *userSid = 0; TCHAR *userDomain = 0; - - DWORD attr; - int res = 0; /* * One time initialization, dynamically load Windows NT features */ - typedef DWORD (WINAPI *setNamedSecurityInfoADef)( IN LPSTR, - IN SE_OBJECT_TYPE, IN SECURITY_INFORMATION, IN PSID, IN PSID, - IN PACL, IN PACL ); - typedef BOOL (WINAPI *getAceDef) (PACL, DWORD, LPVOID *); - typedef BOOL (WINAPI *addAceDef) ( PACL, DWORD, DWORD, LPVOID, DWORD ); - typedef BOOL (WINAPI *equalSidDef) ( PSID, PSID ); - typedef BOOL (WINAPI *addAccessDeniedAceDef) ( PACL, DWORD, DWORD, PSID ); - typedef BOOL (WINAPI *initializeAclDef) ( PACL, DWORD, DWORD ); - typedef DWORD (WINAPI *getLengthSidDef) ( PSID ); - typedef BOOL (WINAPI *getAclInformationDef) (PACL, LPVOID, DWORD, - ACL_INFORMATION_CLASS ); - typedef BOOL (WINAPI *getSecurityDescriptorDaclDef) (PSECURITY_DESCRIPTOR, - LPBOOL, PACL *, LPBOOL ); - typedef BOOL (WINAPI *lookupAccountNameADef) ( LPCSTR, LPCSTR, PSID, - PDWORD, LPSTR, LPDWORD, PSID_NAME_USE ); - typedef BOOL (WINAPI *getFileSecurityADef) ( LPCSTR, SECURITY_INFORMATION, - PSECURITY_DESCRIPTOR, DWORD, LPDWORD ); - - static setNamedSecurityInfoADef setNamedSecurityInfoProc; - static getAceDef getAceProc; - static addAceDef addAceProc; - static equalSidDef equalSidProc; - static addAccessDeniedAceDef addAccessDeniedAceProc; - static initializeAclDef initializeAclProc; - static getLengthSidDef getLengthSidProc; - static getAclInformationDef getAclInformationProc; - static getSecurityDescriptorDaclDef getSecurityDescriptorDaclProc; - static lookupAccountNameADef lookupAccountNameProc; - static getFileSecurityADef getFileSecurityProc; - static int initialized = 0; if (!initialized) { TCL_DECLARE_MUTEX(initializeMutex) Tcl_MutexLock(&initializeMutex); if (!initialized) { HINSTANCE hInstance = LoadLibrary("Advapi32"); + if (hInstance != NULL) { setNamedSecurityInfoProc = (setNamedSecurityInfoADef) - GetProcAddress(hInstance, "SetNamedSecurityInfoA"); + GetProcAddress(hInstance, "SetNamedSecurityInfoA"); getFileSecurityProc = (getFileSecurityADef) - GetProcAddress(hInstance, "GetFileSecurityA"); + GetProcAddress(hInstance, "GetFileSecurityA"); getAceProc = (getAceDef) - GetProcAddress(hInstance, "GetAce"); + GetProcAddress(hInstance, "GetAce"); addAceProc = (addAceDef) - GetProcAddress(hInstance, "AddAce"); + GetProcAddress(hInstance, "AddAce"); equalSidProc = (equalSidDef) - GetProcAddress(hInstance, "EqualSid"); + GetProcAddress(hInstance, "EqualSid"); addAccessDeniedAceProc = (addAccessDeniedAceDef) - GetProcAddress(hInstance, "AddAccessDeniedAce"); + GetProcAddress(hInstance, "AddAccessDeniedAce"); initializeAclProc = (initializeAclDef) - GetProcAddress(hInstance, "InitializeAcl"); + GetProcAddress(hInstance, "InitializeAcl"); getLengthSidProc = (getLengthSidDef) - GetProcAddress(hInstance, "GetLengthSid"); + GetProcAddress(hInstance, "GetLengthSid"); getAclInformationProc = (getAclInformationDef) - GetProcAddress(hInstance, "GetAclInformation"); + GetProcAddress(hInstance, "GetAclInformation"); getSecurityDescriptorDaclProc = (getSecurityDescriptorDaclDef) - GetProcAddress(hInstance, "GetSecurityDescriptorDacl"); + GetProcAddress(hInstance, "GetSecurityDescriptorDacl"); lookupAccountNameProc = (lookupAccountNameADef) - GetProcAddress(hInstance, "LookupAccountNameA"); + GetProcAddress(hInstance, "LookupAccountNameA"); getSidLengthRequiredProc = (getSidLengthRequiredDef) - GetProcAddress(hInstance, "GetSidLengthRequired"); + GetProcAddress(hInstance, "GetSidLengthRequired"); initializeSidProc = (initializeSidDef) - GetProcAddress(hInstance, "InitializeSid"); + GetProcAddress(hInstance, "InitializeSid"); getSidSubAuthorityProc = (getSidSubAuthorityDef) - GetProcAddress(hInstance, "GetSidSubAuthority"); - if (setNamedSecurityInfoProc && getAceProc - && addAceProc && equalSidProc && addAccessDeniedAceProc - && initializeAclProc && getLengthSidProc - && getAclInformationProc && getSecurityDescriptorDaclProc - && lookupAccountNameProc && getFileSecurityProc - && getSidLengthRequiredProc && initializeSidProc - && getSidSubAuthorityProc) + GetProcAddress(hInstance, "GetSidSubAuthority"); + + if (setNamedSecurityInfoProc && getAceProc && addAceProc + && equalSidProc && addAccessDeniedAceProc + && initializeAclProc && getLengthSidProc + && getAclInformationProc + && getSecurityDescriptorDaclProc + && lookupAccountNameProc && getFileSecurityProc + && getSidLengthRequiredProc && initializeSidProc + && getSidSubAuthorityProc) { initialized = 1; + } } - if (!initialized) + if (!initialized) { initialized = -1; + } } Tcl_MutexUnlock(&initializeMutex); } - /* Process the chmod request */ + /* + * Process the chmod request. + */ + attr = GetFileAttributes(nativePath); - /* nativePath not found */ + /* + * nativePath not found + */ + if (attr == 0xffffffff) { res = -1; goto done; } - /* If no ACL API is present or nativePath is not a directory, - * there is no special handling + /* + * If no ACL API is present or nativePath is not a directory, there is no + * special handling. */ + if (initialized < 0 || !(attr & FILE_ATTRIBUTE_DIRECTORY)) { goto done; } - - /* Set the result to error, if the ACL change is successful it will - * be reset to 0 + + /* + * Set the result to error, if the ACL change is successful it will be + * reset to 0. */ + res = -1; /* - * Read the security descriptor for the directory. Note the - * first call obtains the size of the security descriptor. + * Read the security descriptor for the directory. Note the first call + * obtains the size of the security descriptor. */ + if (!getFileSecurityProc(nativePath, infoBits, NULL, 0, &secDescLen)) { - if (GetLastError() == ERROR_INSUFFICIENT_BUFFER) { - DWORD secDescLen2 = 0; - secDesc = (BYTE *) ckalloc(secDescLen); - if (!getFileSecurityProc(nativePath, infoBits, - (PSECURITY_DESCRIPTOR)secDesc, - secDescLen, &secDescLen2) + DWORD secDescLen2 = 0; + + if (GetLastError() != ERROR_INSUFFICIENT_BUFFER) { + goto done; + } + + secDesc = (BYTE *) ckalloc(secDescLen); + if (!getFileSecurityProc(nativePath, infoBits, + (PSECURITY_DESCRIPTOR) secDesc, secDescLen, &secDescLen2) || (secDescLen < secDescLen2)) { - goto done; - } - } else { goto done; } } - /* Get the World SID */ - userSid = (SID*) ckalloc(getSidLengthRequiredProc((UCHAR)1)); - initializeSidProc( userSid, &userSidAuthority, (BYTE)1); - *(getSidSubAuthorityProc( userSid, 0)) = SECURITY_WORLD_RID; + /* + * Get the World SID. + */ + + userSid = (SID *) ckalloc(getSidLengthRequiredProc((UCHAR) 1)); + initializeSidProc(userSid, &userSidAuthority, (BYTE) 1); + *(getSidSubAuthorityProc(userSid, 0)) = SECURITY_WORLD_RID; + + /* + * If curAclPresent == false then curAcl and curAclDefaulted not valid. + */ - /* If curAclPresent == false then curAcl and curAclDefaulted not valid */ - if (!getSecurityDescriptorDaclProc((PSECURITY_DESCRIPTOR)secDesc, - &curAclPresent, &curAcl, - &curAclDefaulted)) { + if (!getSecurityDescriptorDaclProc((PSECURITY_DESCRIPTOR) secDesc, + &curAclPresent, &curAcl, &curAclDefaulted)) { goto done; } if (!curAclPresent || !curAcl) { ACLSize.AclBytesInUse = 0; ACLSize.AceCount = 0; - } else if (!getAclInformationProc(curAcl, &ACLSize, sizeof(ACLSize), - AclSizeInformation)) + } else if (!getAclInformationProc(curAcl, &ACLSize, sizeof(ACLSize), + AclSizeInformation)) { goto done; + } - /* Allocate memory for the new ACL */ - newAclSize = ACLSize.AclBytesInUse + sizeof (ACCESS_DENIED_ACE) - + getLengthSidProc(userSid) - sizeof (DWORD); - newAcl = (ACL *) ckalloc (newAclSize); - - /* Initialize the new ACL */ - if(!initializeAclProc(newAcl, newAclSize, ACL_REVISION)) { + /* + * Allocate memory for the new ACL. + */ + + newAclSize = ACLSize.AclBytesInUse + sizeof(ACCESS_DENIED_ACE) + + getLengthSidProc(userSid) - sizeof(DWORD); + newAcl = (ACL *) ckalloc(newAclSize); + + /* + * Initialize the new ACL. + */ + + if (!initializeAclProc(newAcl, newAclSize, ACL_REVISION)) { goto done; } - - /* Add denied to make readonly, this will be known as a "read-only tag" */ - if (set_readOnly && !addAccessDeniedAceProc(newAcl, ACL_REVISION, - readOnlyMask, userSid)) { + + /* + * Add denied to make readonly, this will be known as a "read-only tag". + */ + + if (set_readOnly && !addAccessDeniedAceProc(newAcl, ACL_REVISION, + readOnlyMask, userSid)) { goto done; } - + acl_readOnly_found = FALSE; for (j = 0; j < ACLSize.AceCount; j++) { PACL *pACE2; ACE_HEADER *phACE2; - if (! getAceProc (curAcl, j, (LPVOID*) &pACE2)) { + + if (!getAceProc(curAcl, j, (LPVOID *) &pACE2)) { goto done; } - - phACE2 = ((ACE_HEADER *) pACE2); - /* Do NOT propagate inherited ACEs */ + phACE2 = (ACE_HEADER *) pACE2; + + /* + * Do NOT propagate inherited ACEs. + */ + if (phACE2->AceFlags & INHERITED_ACE) { continue; } - - /* Skip the "read-only tag" restriction (either added above, or it - * is being removed) + + /* + * Skip the "read-only tag" restriction (either added above, or it is + * being removed). */ + if (phACE2->AceType == ACCESS_DENIED_ACE_TYPE) { - ACCESS_DENIED_ACE *pACEd = (ACCESS_DENIED_ACE *)phACE2; - if (pACEd->Mask == readOnlyMask && equalSidProc(userSid, - (PSID)&(pACEd->SidStart))) { + ACCESS_DENIED_ACE *pACEd = (ACCESS_DENIED_ACE *) phACE2; + + if (pACEd->Mask == readOnlyMask + && equalSidProc(userSid, (PSID) &pACEd->SidStart)) { acl_readOnly_found = TRUE; continue; } } - /* Copy the current ACE from the old to the new ACL */ - if(! addAceProc (newAcl, ACL_REVISION, MAXDWORD, pACE2, - ((PACE_HEADER) pACE2)->AceSize)) { + /* + * Copy the current ACE from the old to the new ACL. + */ + + if (!addAceProc(newAcl, ACL_REVISION, MAXDWORD, pACE2, + ((PACE_HEADER) pACE2)->AceSize)) { goto done; } } - /* Apply the new ACL */ - if (set_readOnly == acl_readOnly_found - || setNamedSecurityInfoProc((LPSTR)nativePath, SE_FILE_OBJECT, - DACL_SECURITY_INFORMATION, NULL, NULL, newAcl, NULL) - == ERROR_SUCCESS ) { + /* + * Apply the new ACL. + */ + + if (set_readOnly == acl_readOnly_found || setNamedSecurityInfoProc( + (LPSTR) nativePath, SE_FILE_OBJECT, DACL_SECURITY_INFORMATION, + NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) { res = 0; } - done: - if (secDesc) ckfree(secDesc); - if (newAcl) ckfree((char *)newAcl); - if (userSid) ckfree((char *)userSid); - if (userDomain) ckfree(userDomain); + done: + if (secDesc) { + ckfree(secDesc); + } + if (newAcl) { + ckfree((char *) newAcl); + } + if (userSid) { + ckfree((char *) userSid); + } + if (userDomain) { + ckfree(userDomain); + } - if (res != 0) + if (res != 0) { return res; - - /* Run normal chmod command */ + } + + /* + * Run normal chmod command. + */ + return chmod(nativePath, pmode); } @@ -764,10 +782,10 @@ TestplatformChmod( * * TestchmodCmd -- * - * Implements the "testchmod" cmd. Used when testing "file" command. - * The only attribute used by the Windows platform is the user write - * flag; if this is not set, the file is made read-only. Otehrwise, the - * file is made read-write. + * Implements the "testchmod" cmd. Used when testing "file" command. The + * only attribute used by the Windows platform is the user write flag; if + * this is not set, the file is made read-only. Otherwise, the file is + * made read-write. * * Results: * A standard Tcl result. @@ -780,16 +798,16 @@ TestplatformChmod( static int TestchmodCmd( - ClientData dummy, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int argc, /* Number of arguments. */ + const char **argv) /* Argument strings. */ { int i, mode; char *rest; if (argc < 2) { - usage: + usage: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " mode file ?file ...?", NULL); return TCL_ERROR; @@ -817,3 +835,11 @@ TestchmodCmd( } return TCL_OK; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |