From 6071dd54232192dfc2f58917e4e64fd8d3940368 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 4 Sep 2007 17:43:42 +0000 Subject: merge updates from HEAD --- ChangeLog | 486 +++++- doc/Hash.3 | 8 +- doc/interp.n | 158 +- doc/lsearch.n | 11 +- doc/platform.n | 6 +- doc/platform_shell.n | 6 +- generic/tcl.h | 3 +- generic/tclBasic.c | 151 +- generic/tclCmdIL.c | 455 +----- generic/tclCmdMZ.c | 10 +- generic/tclCompCmds.c | 82 +- generic/tclCompExpr.c | 1547 ++++++++++-------- generic/tclCompile.c | 111 +- generic/tclCompile.h | 34 +- generic/tclDate.c | 1161 ++++++++----- generic/tclEnv.c | 32 +- generic/tclExecute.c | 1238 +++++++++----- generic/tclGetDate.y | 4 +- generic/tclHash.c | 7 +- generic/tclIOUtil.c | 34 +- generic/tclInt.decls | 13 +- generic/tclInt.h | 371 +++-- generic/tclIntDecls.h | 28 +- generic/tclListObj.c | 11 +- generic/tclLiteral.c | 270 ++-- generic/tclMain.c | 44 +- generic/tclNamesp.c | 229 +-- generic/tclObj.c | 41 +- generic/tclProc.c | 656 ++++---- generic/tclStubInit.c | 4 +- generic/tclThreadStorage.c | 5 +- generic/tclTrace.c | 256 +-- generic/tclVar.c | 2512 +++++++++++++++++++---------- library/clock.tcl | 41 +- library/init.tcl | 4 +- library/platform/pkgIndex.tcl | 2 +- library/platform/platform.tcl | 26 +- library/tzdata/Africa/Cairo | 186 +-- library/tzdata/America/Grand_Turk | 484 +++--- library/tzdata/America/Indiana/Petersburg | 370 ++--- library/tzdata/America/Indiana/Tell_City | 234 +++ library/tzdata/America/Indiana/Vincennes | 370 ++--- library/tzdata/America/Port-au-Prince | 186 --- library/tzdata/Antarctica/McMurdo | 370 ++--- library/tzdata/Australia/Adelaide | 368 ++--- library/tzdata/Australia/Broken_Hill | 368 ++--- library/tzdata/Australia/Currie | 184 +-- library/tzdata/Australia/Hobart | 184 +-- library/tzdata/Australia/Lord_Howe | 368 ++--- library/tzdata/Australia/Melbourne | 368 ++--- library/tzdata/Australia/Sydney | 368 ++--- library/tzdata/Pacific/Auckland | 370 ++--- library/tzdata/Pacific/Chatham | 370 ++--- library/word.tcl | 150 +- macosx/Tcl.xcodeproj/project.pbxproj | 4 +- macosx/tclMacOSXNotify.c | 4 +- tests/clock.test | 41 +- tests/compExpr.test | 25 +- tests/expr.test | 128 +- tests/ioUtil.test | 23 +- tests/lindex.test | 24 +- tests/load.test | 12 +- tests/main.test | 31 +- tests/parseExpr.test | 6 +- tests/set-old.test | 4 +- tests/thread.test | 3 +- tests/trace.test | 30 +- unix/Makefile.in | 40 +- unix/configure | 91 +- unix/configure.in | 18 +- unix/dltest/pkga.c | 3 +- unix/dltest/pkgb.c | 9 +- unix/dltest/pkgc.c | 10 +- unix/dltest/pkge.c | 3 +- unix/dltest/pkgf.c | 46 - unix/dltest/pkgua.c | 14 +- unix/tclConfig.h.in | 6 + unix/tclLoadDyld.c | 539 +++++-- unix/tclUnixChan.c | 307 ++-- unix/tclUnixCompat.c | 730 +++++---- unix/tclUnixFCmd.c | 117 +- unix/tclUnixInit.c | 36 +- unix/tclUnixPort.h | 14 +- unix/tclUnixSock.c | 8 +- unix/tclUnixTime.c | 5 +- win/Makefile.in | 10 +- win/configure | 75 +- win/configure.in | 3 +- win/makefile.vc | 4 +- win/tclWinTest.c | 9 +- 90 files changed, 10343 insertions(+), 7444 deletions(-) create mode 100755 library/tzdata/America/Indiana/Tell_City delete mode 100644 unix/dltest/pkgf.c diff --git a/ChangeLog b/ChangeLog index e8a755c..7890d52 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,434 @@ +2007-09-03 Kevin B, Kenny + + * library/tzdata/Africa/Cairo: + * library/tzdata/America/Grand_Turk: + * library/tzdata/America/Port-au-Prince: + * library/tzdata/America/Indiana/Petersburg: + * library/tzdata/America/Indiana/Tell_City: + * library/tzdata/America/Indiana/Vincennes: + * library/tzdata/Antarctica/McMurdo: + * library/tzdata/Australia/Adelaide: + * library/tzdata/Australia/Broken_Hill: + * library/tzdata/Australia/Currie: + * library/tzdata/Australia/Hobart: + * library/tzdata/Australia/Lord_Howe: + * library/tzdata/Australia/Melbourne: + * library/tzdata/Australia/Sydney: + * library/tzdata/Pacific/Auckland: + * library/tzdata/Pacific/Chatham: Olson's tzdata2007g. + + * generic/tclListObj.c (TclLindexFlat): + * tests/lindex.test (lindex-17.[01]): Added code to detect the + error when a script does [lindex {} end foo]; an overaggressive + optimisation caused this call to return an empty object rather + than an error. + +2007-09-03 Daniel Steffen + + * generic/tclObj.c (TclInitObjSubsystem): restore registration of the + "wideInt" Tcl_ObjType for compatibility with 8.4 extensions that access + the tclWideIntType Tcl_ObjType; add setFromAnyProc for tclWideIntType. + +2007-09-02 Donal K. Fellows + + * doc/lsearch.n: Added note that order of results with the -all option + is that of the input list. It always was, but this makes it crystal. + +2007-08-30 Don Porter + + * generic/tclCompile.c: Added fflush() calls following all callers of + * generic/tclExecute.c: TclPrintByteCodeObj() so that tcl_traceCompile + output is less likely to get mangled when writes to stdout interleave + with other code. + +2007-08-28 Don Porter + + * generic/tclCompExpr.c: Use a table lookup in ParseLexeme() + to determine lexemes with single-byte representations. + + * generic/tclBasic.c: Used unions to better clarify overloading of + * generic/tclCompExpr.c: the fields of the OpCmdInfo and + * generic/tclCompile.h: TclOpCmdClientData structs. + +2007-08-27 Don Porter + + * generic/tclCompExpr.c: Call TclCompileSyntaxError() when + expression syntax errors are found when compiling expressions. With + this in place, convert TclCompileExpr to return void, since there's no + longer any need to report TCL_ERROR. + * generic/tclCompile.c: Update callers. + * generic/tclExecute.c: + + * generic/tclCompCmds.c: New routine TclCompileSyntaxError() + * generic/tclCompile.h: to directly compile bytecodes that report a + * generic/tclCompile.c: syntax error, rather than (ab)use a call to + TclCompileReturnCmd. Also, undo the most recent commit that papered + over some issues with that (ab)use. New routine produces a new + opcode INST_SYNTAX, which is a minor variation of INST_RETURN_IMM. + Also a bit of constification. + + * generic/tclCompile.c: Move the deallocation of local LiteralTable + * generic/tclCompExpr.c: entries into TclFreeCompileEnv(). + * generic/tclExecute.c: Update callers. + + * generic/tclCompExpr.c: Force numeric and boolean literals + in expressions to register with their intreps intact, even if that + means overwriting existing intreps in already registered literals. + +2007-08-25 Kevin B. Kenny + + * generic/tclExecute.c (TclExecuteByteCode): Added code to handle + * tests/expr.test (expr-23.48-53) integer exponentiation + that results in 32- and 64-bit integer results, avoiding calls to + wide integer exponentiation routines in this common case. + [Bug 1767293] + + * library/clock.tcl (ParseClockScanFormat): Modified code to allow + * tests/clock.test (clock-60.*): case-insensitive + matching of time zone and month names. [Bug 1781282] + + +2007-08-24 Don Porter + + * generic/tclCompExpr.c: Register literals found in expressions + * tests/compExpr.test: to restore literal sharing. Preserve numeric + intreps when literals are created for the first time. Correct memleak + in ExecConstantExprTree() and add test for the leak. + +2007-08-24 Miguel Sofer + + * generic/tclCompile.c: replaced copy loop that tripped some + compilers with memmove [Bug 1780870] + +2007-08-23 Don Porter + + * library/init.tcl ([auto_load_index]): Delete stray "]" that created + an expr syntax error (masked by a [catch]). + + * generic/tclCompCmds.c (TclCompileReturnCmd): Added crash protection + to handle callers other than TclCompileScript() failing to meet the + initialization assumptions of the TIP 280 code in CompileWord(). + + * generic/tclCompExpr.c: Suppress the attempt to convert to + numeric when pre-compiling a constant expresion indicates an error. + +2007-08-22 Miguel Sofer + + * generic/tclExecute.c (TEBC): disable the new shortcut to frequent + INSTs for debug builds. REVERTED (collision with alternative fix) + +2007-08-21 Don Porter + + * generic/tclMain.c: Corrected the logic of dropping the last + * tests/main.test: newline from an interactively typed command. + [Bug 1775878]. + +2007-08-21 Pat Thoyts + + * tests/thread.test: thread-4.4: clear ::errorInfo in the thread as + a message is left here from init.tcl on windows due to no tcl_pkgPath. + +2007-08-20 Miguel Sofer + + * generic/tclExecute.c (INST_SUB): fix usage of the new macro for + overflow detection in sums, adapt to subtraction. Lenghty comment + added. + +2007-08-19 Donal K. Fellows + + * generic/tclExecute.c (Overflowing, TclIncrObj, TclExecuteByteCode): + Encapsulate Miguel's last change in a more mnemonic macro. + +2007-08-19 Miguel Sofer + + * generic/tclExecute.c: changed the check for overflow in sums, + reducing objsize, number of branches and cache misses (according to + cachegrind). Non-overflow for s=a+b: + previous + ((a >= 0 || b >= 0 || s < 0) && (s >= 0 || b < 0 || a < 0)) + now + (((a^s) >= 0) || ((a^b) < 0)) + This expresses: "a and s have the same sign or else a and b have + different sign". + +2007-08-19 Donal K. Fellows + + * doc/interp.n (RESOURCE LIMITS): Added text to better explain why + time limits are described using absolute times. [Bug 1752148] + +2007-08-16 Miguel Sofer + + * generic/tclVar.c: improved localVarNameType caching to leverage + the new availability of Tcl_Obj in variable names, avoiding string + comparisons to verify that the cached value is usable. + + * generic/tclExecute.c: check the two most frequent instructions + before the switch. Reduces both runtime and obj size a tiny bit. + +2007-08-16 Don Porter + + * generic/tclCompExpr.c: Added a "constant" field to the OpNode + struct (again "free" due to alignment requirements) to mark those + subexpressions that are completely known at compile time. Enhanced + CompileExprTree() and its callers to precompute these constant + subexpressions at compile time. This resolves the issue raised + in [Bug 1564517]. + +2007-08-15 Donal K. Fellows + + * generic/tclIOUtil.c (TclGetOpenModeEx): Only set the O_APPEND flag + * tests/ioUtil.test (ioUtil-4.1): on a channel for the 'a' + mode and not for 'a+'. [Bug 1773127] + +2007-08-14 Miguel Sofer + + * generic/tclExecute.c (INST_INVOKE*): peephole opt, do not get + the interp's result if it will be pushed/popped. + +2007-08-14 Don Porter + + * generic/tclBasic.c: Use fully qualified variable names for + * tests/thread.test: ::errorInfo and ::errorCode so that string + * tests/trace.test: reported to variable traces are fully + qualified in agreement with Tcl 8.4 operations. + +2007-08-14 Daniel Steffen + + * unix/tclLoadDyld.c: use dlfcn API on Mac OS X 10.4 and later; fix + issues with loading from memory on intel and 64bit; add debug messages. + + * tests/load.test: add test load-10.1 for loading from vfs. + + * unix/dltest/pkga.c: whitespace & comment cleanup, remove + * unix/dltest/pkgb.c: unused pkgf.c. + * unix/dltest/pkgc.c: + * unix/dltest/pkge.c: + * unix/dltest/pkgf.c (removed): + * unix/dltest/pkgua.c: + * macosx/Tcl.xcodeproj/project.pbxproj: + +2007-08-13 Don Porter + + * generic/tclExecute.c: Provide DECACHE/CACHE protection to the + * tests/trace.test: Tcl_LogCommandInfo() call. [Bug 1773040] + +2007-08-12 Miguel Sofer + + * generic/tclCmdMZ.c (Tcl_SplitObjCmd): use TclNewStringObj macro + instead of calling the function. + + * generic/tcl_Obj.c (TclAllocateFreeObjects): remove unneeded + memset to 0 of all allocated objects. + +2007-08-10 Miguel Sofer + + * generic/tclInt.h: remove redundant ops in TclNewStringObj macro + +2007-08-10 Miguel Sofer + + * generic/tclInt.h: fix the TclSetVarNamespaceVar macro, was + causing a leak. + +2007-08-10 Don Porter + + * generic/tclCompExpr.c: Revise CompileExprTree() to use the + OpNode mark field scheme of tree traversal. This eliminates the need + to use magic values in the left and right fields for that purpose. + Also stop abusing the left field within ParseExpr() to store the + number of arguments in a parsed function call. CompileExprTree() now + determines that for itself at compile time. Then reorder code to + eliminate duplication. + +2007-08-09 Miguel Sofer + + * generic/tclProc.c (TclCreateProc): better comments on the + required varflag values when loading precompiled procs. + + * generic/tclExecute.c (INST_STORE_ARRAY): + * tests/trace.test (trace-2.6): whole array write traces on + compiled local variables were not firing [Bug 1770591] + +2007-08-08 Jeff Hobbs + + * generic/tclProc.c (InitLocalCache): reference firstLocalPtr via + procPtr. codePtr->procPtr == NULL exposed by tbcload. + +2007-08-08 Don Porter + + * generic/tclExecute.c: Corrected failure to compile/link + in the -DNO_WIDE_TYPE configuration. + + * generic/tclExecute.c: Corrected improper use of bignum arguments + * tests/expr.test: to *SHIFT operations. [Bug 1770224]. + +2007-08-07 Miguel Sofer + + * generic/tclInt.h: remove comments refering to VAR_SCALAR, as + that flag bit does not exist any longer. + * generic/tclProc.c (InitCompiledLocals): removed optimisation for + non-resolved case, as the function is never called in that + case. Renamed the function to InitResolvedLocals to calrify the + point. + +2007-08-07 Miguel Sofer + + * generic/tclInt.decls: Exporting via stubs to help + * generic/tclInt.h: xotcl adapt to VarReform. + * generic/tclIntDecls.h: + * generic/tclStubInit.c: + +2007-08-07 Daniel Steffen + + * generic/tclEnv.c: improve environ handling on Mac OS X (adapted + * unix/tclUnixPort.h: from Apple changes in Darwin tcl-64). + + * unix/Makefile.in: add support for compile flags specific to + object files linked directly into executables. + + * unix/configure.in (Darwin): only use -seg1addr flag when prebinding; + use -mdynamic-no-pic flag for object files linked directly into exes; + support overriding TCL_PACKAGE_PATH/TCL_MODULE_PATH in environment. + + * unix/configure: autoconf-2.59 + +2007-08-06 Don Porter + + * tests/parseExpr.test: Update source file name of expr parser code. + + * generic/tclCompExpr.c: Added a "mark" field to the OpNode + struct, which is used to guide tree traversal. This field costs + nothing since alignement requirements used the memory already. + Rewrote ConvertTreeToTokens() to use the new field, which permitted + consolidation of utility routines CopyTokens() and + GenerateTokensForLiteral(). + +2007-08-06 Kevin B. Kenny + + * generic/tclGetDate.y: Added a cast to the definition of YYFREE to + silence compiler warnings. + * generic/tclDate.c: Regenerated + * win/tclWinTest.c: Added a cast to the call to + GetSecurityDescriptorDacl to silence compiler + warnings. + +2007-08-04 Miguel Sofer + + * generic/tclInt.decls: Exporting via stubs to help + * generic/tclInt.h: itcl adapt to VarReform. Added + * generic/tclIntDecls.h: localCache initialization to + * generic/tclProc.c: TclInitCompiledLocals (which + * generic/tclStubInit.c: only exists for itcl). + * generic/tclVar.c: + +2007-08-01 Donal K. Fellows + + * library/word.tcl: Rewrote for greater efficiency. [Bug 1764318] + +2007-08-01 Pat Thoyts + + * generic/tclInt.h: Added a TclOffset macro ala Tk_Offset to + * generic/tclVar.c: abstract out 'offsetof' which may not be + * generic/tclExceute.c: defined (eg: msvc6). + +2007-08-01 Miguel Sofer + + * generic/tclVar.c (TclCleanupVar): fix [Bug 1765225], thx Larry + Virden. + +2007-07-31 Miguel Sofer + + * doc/Hash.3: + * generic/tclHash.c: + * generic/tclObj.c: + * generic/tclThreadStorage.c: (changes part of the patch below) + Stop Tcl_CreateHashVar from resetting hPtr->clientData to NULL after + calling the allocEntryProc for a custom table. + + * generic/tcl.h: + * generic/tclBasic.c: + * generic/tclCmdIL.c: + * generic/tclCompCmds.c: + * generic/tclCompile.c: + * generic/tclCompile.h: + * generic/tclExecute.c: + * generic/tclHash.c: + * generic/tclInt.decls: + * generic/tclInt.h: + * generic/tclIntDecls.h: + * generic/tclLiteral.c: + * generic/tclNamesp.c: + * generic/tclObj.c: + * generic/tclProc.c: + * generic/tclThreadStorage.c: + * generic/tclTrace.c: + * generic/tclVar.c: VarReform [Patch 1750051] + + *** POTENTIAL INCOMPATIBILITY *** (tclInt.h and tclCompile.h) + Extensions that access internals defined in tclInt.h and/or + tclCompile.h may lose both binary and source compatibility. The + relevant changes are: + 1. 'struct Var' is completely changed, all acceses to its internals + (either direct or via the TclSetVar* and TclIsVar* macros) will + malfunction. Var flag values and semantics changed too. + 2. 'struct Bytecode' has an additional field that has to be + initialised to NULL + 3. 'struct Namespace' is larger, as the varTable is now one pointer + larger than a Tcl_HashTable. Direct access to its fields will + malfunction. + 4. 'struct CallFrame' grew one more field (the second such growth with + respect to Tcl8.4). + 5. api change for the functions TclFindCompiledLocal, TclDeleteVars + and many internal functions in tclVar.c + + Additionally, direct access to variable hash tables via the standard + Tcl_Hash* interface is to be considered as deprecated. It still works + in the present version, but will be broken by further specialisation + of these hash tables. This concerns especially the table of array + elements in an array, as well as the varTable field in the Namespace + struct. + +2007-07-31 Miguel Sofer + + * unix/configure.in: allow use of 'inline' in Tcl sources + * win/configure.in: [Patch 1754128] + * win/makefile.vc: Regen with autoconf 2.61 + +2007-07-31 Donal K. Fellows + + * unix/tclUnixInit.c (TclpSetVariables): Use the thread-safe getpwuid + replacement to fill the tcl_platform(user) field as it is not subject + to spoofing. [Bug 681877] + + * unix/tclUnixCompat.c: Simplify the #ifdef logic. + + * unix/tclUnixChan.c (FileWatchProc): Fix test failures. + +2007-07-30 Donal K. Fellows + + * unix/tclUnixChan.c (SET_BITS, CLEAR_BITS): Added macros to make this + file clearer. + +2007-07-24 Miguel Sofer + + * generic/tclBasic.c (TEOvI, GetCommandSource): + * generic/tclExecute.c (TEBC, TclGetSrcInfoForCmd): + * generic/tclInt.h: + * generic/tclTrace.c (TclCheck(Interp|Execution)Traces): + Removed the need for TEBC to inspect the command before calling TEOvI, + leveraging the TIP 280 infrastructure. Moved the generation of a + correct nul-terminated command string away from the trace code, back + into TEOvI/GetCommandSource. + +2007-07-20 Andreas Kupries + + * library/platform/platform.tcl: Fixed bug in 'platform::patterns' + * library/platform/pkgIndex.tcl: where identifiers not matching + * unix/Makefile.in: the special linux and solaris forms would not + * win/Makefile.in: get 'tcl' as an acceptable platform added to + * doc/platform.n: the result. Bumped package to version 1.0.3 and + * doc/platform_shell.n: updated documentation and Makefiles. Also + fixed bad version info in the documentation of platform::shell. + 2007-07-19 Don Porter * generic/tclParse.c: In contexts where interp and parsePtr->interp @@ -12,9 +443,9 @@ 2007-07-17 Don Porter * generic/tclCompExpr.c (ParseExpr): While adding comments to - explain the operations of ParseExpr(), made significant revisions - to the code so it would be easier to explain, and in the process - made the code simpler and clearer as well. + explain the operations of ParseExpr(), made significant revisions to + the code so it would be easier to explain, and in the process made the + code simpler and clearer as well. 2007-07-15 Don Porter @@ -32,9 +463,9 @@ * generic/tclCompCmds.c (TclCompileWhileCmd): * generic/tclCompile.c (TclCompileScript): - Corrected faulty avoidance of INST_START_CMD when the first opcode - in a script is within a loop (as produced by 'while 1'), so that - the corresponding command is properly counted [Bug 1752146]. + Corrected faulty avoidance of INST_START_CMD when the first opcode in + a script is within a loop (as produced by 'while 1'), so that the + corresponding command is properly counted. [Bug 1752146] 2007-07-11 Don Porter @@ -42,33 +473,33 @@ ParseExpr() to indicate whether the caller is Tcl_ParseExpr(), with an end goal of filling a Tcl_Parse with Tcl_Tokens representing the parsed expression, or TclCompileExpr() with the goal of compiling and - executing the expression. In the latter case, more aggressive - conversion of QUOTED and BRACED lexeme to literals is done. In the + executing the expression. In the latter case, more aggressive + conversion of QUOTED and BRACED lexeme to literals is done. In the former case, all such conversion is avoided, since Tcl_Token production - would revert it anyway. This enables simplifications to the + would revert it anyway. This enables simplifications to the GenerateTokensForLiteral() routine as well. 2007-07-10 Don Porter * generic/tclCompExpr.c: Added a field for operator precedence - to be stored directly in the parse tree. There's no memory cost to + to be stored directly in the parse tree. There's no memory cost to this addition, since that memory would have been lost to alignment - issues anyway. Also, converted precedence definitions and lookup + issues anyway. Also, converted precedence definitions and lookup tables to use symbolic constants instead of raw number for improved readability, and continued extending/improving/correcting comments. - Removed some unused counter variables. Renamed some variables for + Removed some unused counter variables. Renamed some variables for clarity and replaced some cryptic logic with more readable macros. 2007-07-09 Don Porter * generic/tclCompExpr.c: Revision so that the END lexeme never - gets inserted into the parse tree. Later tree traversal never reaches - it since its location in the tree is not variable. Starting and - stopping with the START lexeme (node 0) is sufficient. Also finished + gets inserted into the parse tree. Later tree traversal never reaches + it since its location in the tree is not variable. Starting and + stopping with the START lexeme (node 0) is sufficient. Also finished lexeme code commentary. - * generic/tclCompExpr.c: Added missing creation and return - of the Tcl_Parse fields that indicate error conditions. [Bug 1749987] + * generic/tclCompExpr.c: Added missing creation and return of + the Tcl_Parse fields that indicate error conditions. [Bug 1749987] 2007-07-05 Don Porter @@ -77,15 +508,14 @@ 2007-07-05 Miguel Sofer - * generic/tclNamesp.c (SetNsNameFromAny): - * generic/tclObj.c (SetCmdNameFromAny): Avoid unnecessary + * generic/tclNamesp.c (SetNsNameFromAny): + * generic/tclObj.c (SetCmdNameFromAny): Avoid unnecessary ckfree/ckalloc when the old structs can be reused. - + 2007-07-04 Miguel Sofer - * generic/tclNamesp.c: Fix case where a FQ cmd or ns was being - * generic/tclObj.c: cached in a different interp, tkcon - [Bug 1747512] + * generic/tclNamesp.c: Fix case where a FQ cmd or ns was being cached + * generic/tclObj.c: in a different interp, tkcon. [Bug 1747512] 2007-07-03 Don Porter @@ -194,12 +624,12 @@ * generic/tclExecute.c: Safety checks to avoid crashes in the TclStack* routines when called with an incompletely initialized - interp. [Bug 1743302] + interp. [Bug 1743302] 2007-06-25 Miguel Sofer - * generic/tclVar.c (UnsetVarStruct): fixing incomplete change, - more streamlining. + * generic/tclVar.c (UnsetVarStruct): fixing incomplete change, more + streamlining. 2007-06-24 Miguel Sofer @@ -208,8 +638,8 @@ UnsetVarStruct (streamlined old code is #ifdef'ed out, in case better benchmarks do show a difference). - * generic/tclVar.c (UnsetVarStruct): fixed a leak introduced in - last commit. + * generic/tclVar.c (UnsetVarStruct): fixed a leak introduced in last + commit. 2007-06-23 Miguel Sofer diff --git a/doc/Hash.3 b/doc/Hash.3 index d21ba2b..e995fb3 100644 --- a/doc/Hash.3 +++ b/doc/Hash.3 @@ -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: Hash.3,v 1.18 2004/10/07 16:05:14 dkf Exp $ +'\" RCS: @(#) $Id: Hash.3,v 1.18.12.1 2007/09/04 17:43:46 dgp Exp $ '\" .so man.macros .TH Tcl_Hash 3 "" Tcl "Tcl Library Procedures" @@ -291,21 +291,21 @@ If the keys don't match then the function returns 0, otherwise it returns 1. .PP The \fIallocEntryProc\fR member contains the address of a function -called to allocate space for an entry and initialize the key. +called to allocate space for an entry and initialize the key and clientData. .CS typedef Tcl_HashEntry *(Tcl_AllocHashEntryProc) ( Tcl_HashTable *\fItablePtr\fR, void *\fIkeyPtr\fR); .CE If this is NULL then Tcl_Alloc is used to allocate enough space for a -Tcl_HashEntry and the key pointer is assigned to key.oneWordValue. +Tcl_HashEntry, the key pointer is assigned to key.oneWordValue and the +cleintData is set to NULL. String keys and array keys use this function to allocate enough space for the entry and the key in one block, rather than doing it in two blocks. This saves space for a pointer to the key from the entry and another memory allocation. Tcl_Obj * keys use this function to allocate enough space for an entry and increment the reference count on the object. -If .PP The \fIfreeEntryProc\fR member contains the address of a function called to free space for an entry. diff --git a/doc/interp.n b/doc/interp.n index 8b32ee0..4aa75b1 100644 --- a/doc/interp.n +++ b/doc/interp.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: interp.n,v 1.27 2007/02/18 18:42:54 dkf Exp $ +'\" RCS: @(#) $Id: interp.n,v 1.27.2.1 2007/09/04 17:43:46 dgp Exp $ '\" .so man.macros .TH interp n 7.6 Tcl "Tcl Built-In Commands" @@ -660,97 +660,97 @@ command, by making the current namespace be different from the global one. .SH "RESOURCE LIMITS" .VS 8.5 .PP -Every interpreter has two kinds of resource limits that may be imposed -by any master interpreter upon its slaves. Command limits (of type -\fBcommand\fR) restrict the total number of Tcl commands that may be -executed by an interpreter (as can be inspected via the \fBinfo -cmdcount\fR command), and time limits (of type \fBtime\fR) place a -limit by which execution within the interpreter must complete. -.PP -When a limit is exceeded for an interpreter, first any handler -callbacks defined by master interpreters are called. If those -callbacks increase or remove the limit, execution within the -(previously) limited interpreter continues. If the limit is still in -force, an error is generated at that point and normal processing of -errors within the interpreter (by the \fBcatch\fR command) is -disabled, so the error propagates outwards (building a stack-trace as -it goes) to the point where the limited interpreter was invoked -(e.g. by \fBinterp eval\fR) where it becomes the responsibility of the -calling code to catch and handle. -.PP -Every limit has a number of options associated with it, some of which -are common across all kinds of limits, and others of which are -particular to the kind of limit. +Every interpreter has two kinds of resource limits that may be imposed by any +master interpreter upon its slaves. Command limits (of type \fBcommand\fR) +restrict the total number of Tcl commands that may be executed by an +interpreter (as can be inspected via the \fBinfo cmdcount\fR command), and +time limits (of type \fBtime\fR) place a limit by which execution within the +interpreter must complete. Note that time limits are expressed as +\fIabsolute\fR times (as in \fBclock seconds\fR) and not relative times (as in +\fBafter\fR) because they may be modified after creation. +.PP +When a limit is exceeded for an interpreter, first any handler callbacks +defined by master interpreters are called. If those callbacks increase or +remove the limit, execution within the (previously) limited interpreter +continues. If the limit is still in force, an error is generated at that point +and normal processing of errors within the interpreter (by the \fBcatch\fR +command) is disabled, so the error propagates outwards (building a stack-trace +as it goes) to the point where the limited interpreter was invoked (e.g. by +\fBinterp eval\fR) where it becomes the responsibility of the calling code to +catch and handle. +.SS "LIMIT OPTIONS" +.PP +Every limit has a number of options associated with it, some of which are +common across all kinds of limits, and others of which are particular to the +kind of limit. .TP \fB\-command\fR -This option (common for all limit types) specifies (if non-empty) a -Tcl script to be executed in the global namespace of the interpreter -reading and writing the option when the particular limit in the -limited interpreter is exceeded. The callback may modify the limit on -the interpreter if it wishes the limited interpreter to continue -executing. If the callback generates an error, it is reported through -the background error mechanism (see \fBBACKGROUND ERROR HANDLING\fR). -Note that the -callbacks defined by one interpreter are completely isolated from the -callbacks defined by another, and that the order in which those -callbacks are called is undefined. +. +This option (common for all limit types) specifies (if non-empty) a Tcl script +to be executed in the global namespace of the interpreter reading and writing +the option when the particular limit in the limited interpreter is exceeded. +The callback may modify the limit on the interpreter if it wishes the limited +interpreter to continue executing. If the callback generates an error, it is +reported through the background error mechanism (see \fBBACKGROUND ERROR +HANDLING\fR). Note that the callbacks defined by one interpreter are +completely isolated from the callbacks defined by another, and that the order +in which those callbacks are called is undefined. .TP \fB\-granularity\fR -This option (common for all limit types) specifies how frequently (out -of the points when the Tcl interpreter is in a consistent state where -limit checking is possible) that the limit is actually checked. This -allows the tuning of how frequently a limit is checked, and hence how -often the limit-checking overhead (which may be substantial in the -case of time limits) is incurred. +. +This option (common for all limit types) specifies how frequently (out of the +points when the Tcl interpreter is in a consistent state where limit checking +is possible) that the limit is actually checked. This allows the tuning of how +frequently a limit is checked, and hence how often the limit-checking overhead +(which may be substantial in the case of time limits) is incurred. .TP \fB\-milliseconds\fR -This option specifies the number of milliseconds after the moment -defined in the \fB\-seconds\fR option that the time limit will fire. -It should only ever be specified in conjunction with the -\fB\-seconds\fR option (whether it was set previously or is being set -this invocation.) +. +This option specifies the number of milliseconds after the moment defined in +the \fB\-seconds\fR option that the time limit will fire. It should only ever +be specified in conjunction with the \fB\-seconds\fR option (whether it was +set previously or is being set this invocation.) .TP \fB\-seconds\fR -This option specifies the number of seconds after the epoch (see -\fBclock seconds\fR) that the time limit for the interpreter will be -triggered. The limit will be triggered at the start of the second -unless specified at a sub-second level using the \fB\-milliseconds\fR -option. This option may be the empty string, which indicates that a -time limit is not set for the interpreter. +. +This option specifies the number of seconds after the epoch (see \fBclock +seconds\fR) that the time limit for the interpreter will be triggered. The +limit will be triggered at the start of the second unless specified at a +sub-second level using the \fB\-milliseconds\fR option. This option may be the +empty string, which indicates that a time limit is not set for the +interpreter. .TP \fB\-value\fR -This option specifies the number of commands that the interpreter may -execute before triggering the command limit. This option may be the -empty string, which indicates that a command limit is not set for the -interpreter. +. +This option specifies the number of commands that the interpreter may execute +before triggering the command limit. This option may be the empty string, +which indicates that a command limit is not set for the interpreter. .PP Where an interpreter with a resource limit set on it creates a slave -interpreter, that slave interpreter will have resource limits imposed -on it that are at least as restrictive as the limits on the creating -master interpreter. If the master interpreter of the limited master -wishes to relax these conditions, it should hide the \fBinterp\fR -command in the child and then use aliases and the \fBinterp -invokehidden\fR subcommand to provide such access as it chooses to the -\fBinterp\fR command to the limited master as necessary. -.VE 8.5 +interpreter, that slave interpreter will have resource limits imposed on it +that are at least as restrictive as the limits on the creating master +interpreter. If the master interpreter of the limited master wishes to relax +these conditions, it should hide the \fBinterp\fR command in the child and +then use aliases and the \fBinterp invokehidden\fR subcommand to provide such +access as it chooses to the \fBinterp\fR command to the limited master as +necessary. .SH "BACKGROUND ERROR HANDLING" -.VS 8.5 -When an error happens in a situation where it cannot be reported -directly up the stack (e.g. when processing events in an \fBupdate\fR -or \fBvwait\fR call) the error is instead reported through the -background error handling mechanism. Every interpreter has a -background error handler registered; the default error handler -arranges for the \fBbgerror\fR command in the interpreter's global -namespace to be called, but other error handlers may be installed and -process background errors in substantially different ways. -.PP -A background error handler consists of a non-empty list of words to -which will, at invocation time, be appended two further words. The -first word will be the error message string, and the second will a -dictionary of return options (this is also the sort of information -that can be obtained by trapping a normal error using \fBcatch\fR of -course.) The resulting list will then be executed in the interpreter's -global namespace without further substitutions being performed. +.PP +When an error happens in a situation where it cannot be reported directly up +the stack (e.g. when processing events in an \fBupdate\fR or \fBvwait\fR call) +the error is instead reported through the background error handling mechanism. +Every interpreter has a background error handler registered; the default error +handler arranges for the \fBbgerror\fR command in the interpreter's global +namespace to be called, but other error handlers may be installed and process +background errors in substantially different ways. +.PP +A background error handler consists of a non-empty list of words to which will +be appended two further words at invocation time. The first word will be the +error message string, and the second will a dictionary of return options (this +is also the sort of information that can be obtained by trapping a normal +error using \fBcatch\fR of course.) The resulting list will then be executed +in the interpreter's global namespace without further substitutions being +performed. .VE 8.5 .SH CREDITS This mechanism is based on the Safe-Tcl prototype implemented diff --git a/doc/lsearch.n b/doc/lsearch.n index 726f060..431ba90 100644 --- a/doc/lsearch.n +++ b/doc/lsearch.n @@ -7,7 +7,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: lsearch.n,v 1.26 2005/07/12 09:39:53 dkf Exp $ +'\" RCS: @(#) $Id: lsearch.n,v 1.26.8.1 2007/09/04 17:43:47 dgp Exp $ '\" .so man.macros .TH lsearch n 8.5 Tcl "Tcl Built-In Commands" @@ -58,8 +58,11 @@ is treated exactly like \fB-exact\fR when either \fB\-all\fR or These options may be given with all matching styles. .TP \fB\-all\fR -Changes the result to be the list of all matching indices (or all -matching values if \fB\-inline\fR is specified as well.) +. +Changes the result to be the list of all matching indices (or all matching +values if \fB\-inline\fR is specified as well.) If indices are returned, the +indices will be in numeric order. If values are returned, the order of the +values will be the order of those values within the input \fIlist\fR. .TP \fB\-inline\fR The matching value is returned instead of its index (or an empty @@ -71,7 +74,7 @@ This negates the sense of the match, returning the index of the first non-matching value in the list. .TP \fB\-start\fR\0\fIindex\fR -The list is searched starting at position \fIindex\fR. +The list is searched starting at position \fIindex\fR. .VS 8.5 The interpretation of the \fIindex\fR value is the same as for the command \fBstring index\fR, supporting simple index diff --git a/doc/platform.n b/doc/platform.n index 827e188..2a565ab 100644 --- a/doc/platform.n +++ b/doc/platform.n @@ -4,17 +4,17 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: platform.n,v 1.1 2006/12/05 18:46:59 andreas_kupries Exp $ +'\" RCS: @(#) $Id: platform.n,v 1.1.4.1 2007/09/04 17:43:47 dgp Exp $ '\" .so man.macros -.TH "platform" n 1.0.2 platform "Tcl Bundled Packages" +.TH "platform" n 1.0.3 platform "Tcl Bundled Packages" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME platform \- System identification support code and utilities .SH SYNOPSIS .nf -\fBpackage require platform ?1.0.2?\fR +\fBpackage require platform ?1.0.3?\fR .sp \fBplatform::generic\fR \fBplatform::identify\fR diff --git a/doc/platform_shell.n b/doc/platform_shell.n index f3ef6b9..9283c06 100644 --- a/doc/platform_shell.n +++ b/doc/platform_shell.n @@ -4,17 +4,17 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: platform_shell.n,v 1.3 2007/02/18 18:42:55 dkf Exp $ +'\" RCS: @(#) $Id: platform_shell.n,v 1.3.4.1 2007/09/04 17:43:47 dgp Exp $ '\" .so man.macros -.TH "platform::shell" n 1.0.2 platform::shell "Tcl Bundled Packages" +.TH "platform::shell" n 1.1.3 platform::shell "Tcl Bundled Packages" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME platform::shell \- System identification support code and utilities .SH SYNOPSIS .nf -\fBpackage require platform::shell ?1.0.1?\fR +\fBpackage require platform::shell ?1.1.3?\fR .sp \fBplatform::shell::generic \fIshell\fR \fBplatform::shell::identify \fIshell\fR diff --git a/generic/tcl.h b/generic/tcl.h index a4b07ee..1ceb974 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.3 2007/07/03 02:28:35 dgp Exp $ + * RCS: @(#) $Id: tcl.h,v 1.231.2.4 2007/09/04 17:43:47 dgp Exp $ */ #ifndef _TCL @@ -870,6 +870,7 @@ typedef struct Tcl_CallFrame { int dummy9; char *dummy10; char *dummy11; + char *dummy12; } Tcl_CallFrame; /* diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 8a1fba1..261ceac 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.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: tclBasic.c,v 1.244.2.9 2007/07/01 17:31:22 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.244.2.10 2007/09/04 17:43:47 dgp Exp $ */ #include "tclInt.h" @@ -54,6 +54,8 @@ static char * CallCommandTraces(Interp *iPtr, Command *cmdPtr, static int CheckDoubleResult(Tcl_Interp *interp, double dResult); static void DeleteInterpProc(Tcl_Interp *interp); static void DeleteOpCmdClientData(ClientData clientData); +static Tcl_Obj *GetCommandSource(Interp *iPtr, const char *command, + int numChars, int objc, Tcl_Obj *const objv[]); static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode); static int OldMathFuncProc(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const *objv); @@ -271,36 +273,63 @@ typedef struct { const char *name; /* Name of object-based command. */ Tcl_ObjCmdProc *objProc; /* Object-based function for command. */ CompileProc *compileProc; /* Function called to compile command. */ - int numArgs; + union { + int numArgs; + int identity; + } i; const char *expected; /* For error message, what argument(s) * were expected. */ } OpCmdInfo; static const OpCmdInfo mathOpCmds[] = { - { "~", TclSingleOpCmd, TclCompileInvertOpCmd, 1, "integer" }, - { "!", TclSingleOpCmd, TclCompileNotOpCmd, 1, "boolean" }, - { "+", TclVariadicOpCmd, TclCompileAddOpCmd, 0, NULL }, - { "*", TclVariadicOpCmd, TclCompileMulOpCmd, 1, NULL }, - { "&", TclVariadicOpCmd, TclCompileAndOpCmd, -1, NULL }, - { "|", TclVariadicOpCmd, TclCompileOrOpCmd, 0, NULL }, - { "^", TclVariadicOpCmd, TclCompileXorOpCmd, 0, NULL }, - { "**", TclVariadicOpCmd, TclCompilePowOpCmd, 1, NULL }, - { "<<", TclSingleOpCmd, TclCompileLshiftOpCmd, 2, "integer shift" }, - { ">>", TclSingleOpCmd, TclCompileRshiftOpCmd, 2, "integer shift" }, - { "%", TclSingleOpCmd, TclCompileModOpCmd, 2, "integer integer" }, - { "!=", TclSingleOpCmd, TclCompileNeqOpCmd, 2, "value value"}, - { "ne", TclSingleOpCmd, TclCompileStrneqOpCmd, 2, "value value" }, - { "in", TclSingleOpCmd, TclCompileInOpCmd, 2, "value list"}, - { "ni", TclSingleOpCmd, TclCompileNiOpCmd, 2, "value list"}, - { "-", TclNoIdentOpCmd, TclCompileMinusOpCmd, 0, "value ?value ...?"}, - { "/", TclNoIdentOpCmd, TclCompileDivOpCmd, 0, "value ?value ...?"}, - { "<", TclSortingOpCmd, TclCompileLessOpCmd, 0, NULL }, - { "<=", TclSortingOpCmd, TclCompileLeqOpCmd, 0, NULL }, - { ">", TclSortingOpCmd, TclCompileGreaterOpCmd, 0, NULL }, - { ">=", TclSortingOpCmd, TclCompileGeqOpCmd, 0, NULL }, - { "==", TclSortingOpCmd, TclCompileEqOpCmd, 0, NULL }, - { "eq", TclSortingOpCmd, TclCompileStreqOpCmd, 0, NULL }, - { NULL, NULL, NULL, 0, NULL } + { "~", TclSingleOpCmd, TclCompileInvertOpCmd, + /* numArgs */ {1}, "integer" }, + { "!", TclSingleOpCmd, TclCompileNotOpCmd, + /* numArgs */ {1}, "boolean" }, + { "+", TclVariadicOpCmd, TclCompileAddOpCmd, + /* identity */ {0}, NULL }, + { "*", TclVariadicOpCmd, TclCompileMulOpCmd, + /* identity */ {1}, NULL }, + { "&", TclVariadicOpCmd, TclCompileAndOpCmd, + /* identity */ {-1}, NULL }, + { "|", TclVariadicOpCmd, TclCompileOrOpCmd, + /* identity */ {0}, NULL }, + { "^", TclVariadicOpCmd, TclCompileXorOpCmd, + /* identity */ {0}, NULL }, + { "**", TclVariadicOpCmd, TclCompilePowOpCmd, + /* identity */ {1}, NULL }, + { "<<", TclSingleOpCmd, TclCompileLshiftOpCmd, + /* numArgs */ {2}, "integer shift" }, + { ">>", TclSingleOpCmd, TclCompileRshiftOpCmd, + /* numArgs */ {2}, "integer shift" }, + { "%", TclSingleOpCmd, TclCompileModOpCmd, + /* numArgs */ {2}, "integer integer" }, + { "!=", TclSingleOpCmd, TclCompileNeqOpCmd, + /* numArgs */ {2}, "value value"}, + { "ne", TclSingleOpCmd, TclCompileStrneqOpCmd, + /* numArgs */ {2}, "value value" }, + { "in", TclSingleOpCmd, TclCompileInOpCmd, + /* numArgs */ {2}, "value list"}, + { "ni", TclSingleOpCmd, TclCompileNiOpCmd, + /* numArgs */ {2}, "value list"}, + { "-", TclNoIdentOpCmd, TclCompileMinusOpCmd, + /* unused */ {0}, "value ?value ...?"}, + { "/", TclNoIdentOpCmd, TclCompileDivOpCmd, + /* unused */ {0}, "value ?value ...?"}, + { "<", TclSortingOpCmd, TclCompileLessOpCmd, + /* unused */ {0}, NULL }, + { "<=", TclSortingOpCmd, TclCompileLeqOpCmd, + /* unused */ {0}, NULL }, + { ">", TclSortingOpCmd, TclCompileGreaterOpCmd, + /* unused */ {0}, NULL }, + { ">=", TclSortingOpCmd, TclCompileGeqOpCmd, + /* unused */ {0}, NULL }, + { "==", TclSortingOpCmd, TclCompileEqOpCmd, + /* unused */ {0}, NULL }, + { "eq", TclSortingOpCmd, TclCompileStreqOpCmd, + /* unused */ {0}, NULL }, + { NULL, NULL, NULL, + {0}, NULL } }; /* @@ -394,10 +423,10 @@ Tcl_CreateInterp(void) iPtr->returnOpts = NULL; iPtr->errorInfo = NULL; - TclNewLiteralStringObj(iPtr->eiVar, "errorInfo"); + TclNewLiteralStringObj(iPtr->eiVar, "::errorInfo"); Tcl_IncrRefCount(iPtr->eiVar); iPtr->errorCode = NULL; - TclNewLiteralStringObj(iPtr->ecVar, "errorCode"); + TclNewLiteralStringObj(iPtr->ecVar, "::errorCode"); Tcl_IncrRefCount(iPtr->ecVar); iPtr->returnLevel = 1; iPtr->returnCode = TCL_OK; @@ -438,6 +467,15 @@ Tcl_CreateInterp(void) iPtr->resultSpace[0] = 0; iPtr->threadId = Tcl_GetCurrentThread(); + /* + * Initialise the tables for variable traces and searches *before* + * creating the global ns - so that the trace on errorInfo can be + * recorded. + */ + + Tcl_InitHashTable(&iPtr->varTraces, TCL_ONE_WORD_KEYS); + Tcl_InitHashTable(&iPtr->varSearches, TCL_ONE_WORD_KEYS); + iPtr->globalNsPtr = NULL; /* Force creation of global ns below */ iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(interp, "", (ClientData) NULL, NULL); @@ -649,7 +687,7 @@ Tcl_CreateInterp(void) TclOpCmdClientData *occdPtr = (TclOpCmdClientData *) ckalloc(sizeof(TclOpCmdClientData)); occdPtr->operator = opcmdInfoPtr->name; - occdPtr->numArgs = opcmdInfoPtr->numArgs; + occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs; occdPtr->expected = opcmdInfoPtr->expected; strcpy(mathFuncName + MATH_OP_PREFIX_LEN, opcmdInfoPtr->name); cmdPtr = (Command *) Tcl_CreateObjCommand(interp, mathFuncName, @@ -1332,6 +1370,10 @@ DeleteInterpProc( ckfree((char *) iPtr->lineBCPtr); iPtr->lineBCPtr = NULL; } + + Tcl_DeleteHashTable(&iPtr->varTraces); + Tcl_DeleteHashTable(&iPtr->varSearches); + ckfree((char *) iPtr); } @@ -2863,6 +2905,40 @@ CallCommandTraces( Tcl_Release((ClientData) iPtr); return result; } + +/* + *---------------------------------------------------------------------- + * + * GetCommandSource -- + * + * This function returns a Tcl_Obj with the full source string for the + * command. This insures that traces get a correct nul-terminated command + * string. + * + */ + +static Tcl_Obj * +GetCommandSource( + Interp *iPtr, + const char *command, + int numChars, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_Obj *commandPtr; + + if (!command) { + commandPtr = Tcl_NewListObj(objc, objv); + } else { + if (command == (char *) -1) { + command = TclGetSrcInfoForCmd(iPtr, &numChars); + } + commandPtr = Tcl_NewStringObj(command, numChars); + } + + return commandPtr; +} + /* *---------------------------------------------------------------------- @@ -3358,7 +3434,9 @@ TclEvalObjvInternal( * representation of the command; this is used * for traces. NULL if the string * representation of the command is unknown is - * to be generated from (objc,objv).*/ + * to be generated from (objc,objv), -1 if it + * is to be generated from bytecode + * source. This is only needed the traces. */ int length, /* Number of bytes in command; if -1, all * characters up to the first null byte are * used. */ @@ -3378,7 +3456,7 @@ TclEvalObjvInternal( int checkTraces = 1, traced; Namespace *savedNsPtr = NULL; Namespace *lookupNsPtr = iPtr->lookupNsPtr; - + Tcl_Obj *commandPtr = NULL; if (TclInterpReady(interp) == TCL_ERROR) { return TCL_ERROR; @@ -3449,6 +3527,14 @@ TclEvalObjvInternal( int newEpoch; /* + * Insure that we have a correct nul-terminated command string for the + * trace code. + */ + + commandPtr = GetCommandSource(iPtr, command, length, objc, objv); + command = Tcl_GetStringFromObj(commandPtr, &length); + + /* * Execute any command or execution traces. Note that we bump up the * command's reference count for the duration of the calling of the * traces so that the structure doesn't go away underneath our feet. @@ -3521,6 +3607,9 @@ TclEvalObjvInternal( if (traceCode != TCL_OK) { code = traceCode; } + if (commandPtr) { + Tcl_DecrRefCount(commandPtr); + } } /* diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 4357e6b..17f7b27 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.5 2007/07/01 17:31:23 dgp Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.115.2.6 2007/09/04 17:43:48 dgp Exp $ */ #include "tclInt.h" @@ -97,8 +97,6 @@ typedef struct SortInfo { * Forward declarations for procedures defined in this file: */ -static void AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr, - CONST char *pattern, int includeLinks); static int DictionaryCompare(char *left, char *right); static int InfoArgsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); @@ -119,8 +117,6 @@ static int InfoFrameCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int InfoFunctionsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); -static int InfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); static int InfoHostnameCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int InfoLevelCmd(ClientData dummy, Tcl_Interp *interp, @@ -129,8 +125,6 @@ static int InfoLibraryCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int InfoLoadedCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); -static int InfoLocalsCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); static int InfoNameOfExecutableCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); @@ -144,8 +138,6 @@ static int InfoSharedlibCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int InfoTclVersionCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); -static int InfoVarsCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); static SortElement * MergeSort(SortElement *headPt, SortInfo *infoPtr); static SortElement * MergeLists(SortElement *leftPtr, SortElement *rightPtr, SortInfo *infoPtr); @@ -172,19 +164,19 @@ static const struct { {"exists", InfoExistsCmd}, {"frame", InfoFrameCmd}, {"functions", InfoFunctionsCmd}, - {"globals", InfoGlobalsCmd}, + {"globals", TclInfoGlobalsCmd}, {"hostname", InfoHostnameCmd}, {"level", InfoLevelCmd}, {"library", InfoLibraryCmd}, {"loaded", InfoLoadedCmd}, - {"locals", InfoLocalsCmd}, + {"locals", TclInfoLocalsCmd}, {"nameofexecutable",InfoNameOfExecutableCmd}, {"patchlevel", InfoPatchLevelCmd}, {"procs", InfoProcsCmd}, {"script", InfoScriptCmd}, {"sharedlibextension", InfoSharedlibCmd}, {"tclversion", InfoTclVersionCmd}, - {"vars", InfoVarsCmd}, + {"vars", TclInfoVarsCmd}, {NULL, NULL} }; @@ -1033,8 +1025,8 @@ InfoExistsCmd( varName = TclGetString(objv[1]); varPtr = TclVarTraceExists(interp, varName); - Tcl_SetObjResult(interp, Tcl_NewBooleanObj( - ((varPtr != NULL) && !TclIsVarUndefined(varPtr)))); + Tcl_SetObjResult(interp, + Tcl_NewBooleanObj(varPtr && varPtr->value.objPtr)); return TCL_OK; } @@ -1359,94 +1351,6 @@ InfoFunctionsCmd( /* *---------------------------------------------------------------------- * - * InfoGlobalsCmd -- - * - * Called to implement the "info globals" command that returns the list - * of global variables matching an optional pattern. Handles the - * following syntax: - * - * info globals ?pattern? - * - * Results: - * Returns TCL_OK if successful and TCL_ERROR if there is an error. - * - * Side effects: - * Returns a result in the interpreter's result object. If there is an - * error, the result is an error message. - * - *---------------------------------------------------------------------- - */ - -static int -InfoGlobalsCmd( - ClientData dummy, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ -{ - char *varName, *pattern; - Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); - register Tcl_HashEntry *entryPtr; - Tcl_HashSearch search; - Var *varPtr; - Tcl_Obj *listPtr; - - if (objc == 1) { - pattern = NULL; - } else if (objc == 2) { - pattern = TclGetString(objv[1]); - - /* - * Strip leading global-namespace qualifiers. [Bug 1057461] - */ - - if (pattern[0] == ':' && pattern[1] == ':') { - while (*pattern == ':') { - pattern++; - } - } - } else { - Tcl_WrongNumArgs(interp, 1, objv, "?pattern?"); - return TCL_ERROR; - } - - /* - * Scan through the global :: namespace's variable table and create a list - * of all global variables that match the pattern. - */ - - listPtr = Tcl_NewListObj(0, NULL); - if (pattern != NULL && TclMatchIsTrivial(pattern)) { - entryPtr = Tcl_FindHashEntry(&globalNsPtr->varTable, pattern); - if (entryPtr != NULL) { - varPtr = (Var *) Tcl_GetHashValue(entryPtr); - if (!TclIsVarUndefined(varPtr)) { - Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewStringObj(pattern, -1)); - } - } - } else { - for (entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search); - entryPtr != NULL; - entryPtr = Tcl_NextHashEntry(&search)) { - varPtr = (Var *) Tcl_GetHashValue(entryPtr); - if (TclIsVarUndefined(varPtr)) { - continue; - } - varName = Tcl_GetHashKey(&globalNsPtr->varTable, entryPtr); - if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) { - Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewStringObj(varName, -1)); - } - } - } - Tcl_SetObjResult(interp, listPtr); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * * InfoHostnameCmd -- * * Called to implement the "info hostname" command that returns the host @@ -1650,162 +1554,6 @@ InfoLoadedCmd( /* *---------------------------------------------------------------------- * - * InfoLocalsCmd -- - * - * Called to implement the "info locals" command to return a list of - * local variables that match an optional pattern. Handles the following - * syntax: - * - * info locals ?pattern? - * - * Results: - * Returns TCL_OK if successful and TCL_ERROR if there is an error. - * - * Side effects: - * Returns a result in the interpreter's result object. If there is an - * error, the result is an error message. - * - *---------------------------------------------------------------------- - */ - -static int -InfoLocalsCmd( - ClientData dummy, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ -{ - Interp *iPtr = (Interp *) interp; - char *pattern; - Tcl_Obj *listPtr; - - if (objc == 1) { - pattern = NULL; - } else if (objc == 2) { - pattern = TclGetString(objv[1]); - } else { - Tcl_WrongNumArgs(interp, 1, objv, "?pattern?"); - return TCL_ERROR; - } - - if (!(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC )) { - return TCL_OK; - } - - /* - * Return a list containing names of first the compiled locals (i.e. the - * ones stored in the call frame), then the variables in the local hash - * table (if one exists). - */ - - listPtr = Tcl_NewListObj(0, NULL); - AppendLocals(interp, listPtr, pattern, 0); - Tcl_SetObjResult(interp, listPtr); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * AppendLocals -- - * - * Append the local variables for the current frame to the specified list - * object. - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static void -AppendLocals( - Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Obj *listPtr, /* List object to append names to. */ - CONST char *pattern, /* Pattern to match against. */ - int includeLinks) /* 1 if upvars should be included, else 0. */ -{ - Interp *iPtr = (Interp *) interp; - CompiledLocal *localPtr; - Var *varPtr; - int i, localVarCt; - const char *varName; - Tcl_HashTable *localVarTablePtr; - register Tcl_HashEntry *entryPtr; - Tcl_HashSearch search; - - localPtr = iPtr->varFramePtr->procPtr->firstLocalPtr; - localVarCt = iPtr->varFramePtr->numCompiledLocals; - varPtr = iPtr->varFramePtr->compiledLocals; - localVarTablePtr = iPtr->varFramePtr->varTablePtr; - - for (i = 0; i < localVarCt; i++) { - /* - * Skip nameless (temporary) variables and undefined variables. - */ - - if (!TclIsVarTemporary(localPtr) && !TclIsVarUndefined(varPtr) - && (includeLinks || !TclIsVarLink(varPtr))) { - varName = varPtr->name; - if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) { - Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewStringObj(varName, -1)); - } - } - varPtr++; - localPtr = localPtr->nextPtr; - } - - /* - * Do nothing if no local variables. - */ - - if (localVarTablePtr == NULL) { - return; - } - - /* - * Check for the simple and fast case. - */ - - if ((pattern != NULL) && TclMatchIsTrivial(pattern)) { - entryPtr = Tcl_FindHashEntry(localVarTablePtr, pattern); - if (entryPtr != NULL) { - varPtr = (Var *) Tcl_GetHashValue(entryPtr); - if (!TclIsVarUndefined(varPtr) - && (includeLinks || !TclIsVarLink(varPtr))) { - Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewStringObj(pattern, -1)); - } - } - return; - } - - /* - * Scan over and process all local variables. - */ - - for (entryPtr = Tcl_FirstHashEntry(localVarTablePtr, &search); - entryPtr != NULL; - entryPtr = Tcl_NextHashEntry(&search)) { - varPtr = (Var *) Tcl_GetHashValue(entryPtr); - if (!TclIsVarUndefined(varPtr) - && (includeLinks || !TclIsVarLink(varPtr))) { - varName = Tcl_GetHashKey(localVarTablePtr, entryPtr); - if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) { - Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewStringObj(varName, -1)); - } - } - } -} - -/* - *---------------------------------------------------------------------- - * * InfoNameOfExecutableCmd -- * * Called to implement the "info nameofexecutable" command that returns @@ -2206,197 +1954,6 @@ InfoTclVersionCmd( /* *---------------------------------------------------------------------- * - * InfoVarsCmd -- - * - * Called to implement the "info vars" command that returns the list of - * variables in the interpreter that match an optional pattern. The - * pattern, if any, consists of an optional sequence of namespace names - * separated by "::" qualifiers, which is followed by a glob-style - * pattern that restricts which variables are returned. Handles the - * following syntax: - * - * info vars ?pattern? - * - * Results: - * Returns TCL_OK if successful and TCL_ERROR if there is an error. - * - * Side effects: - * Returns a result in the interpreter's result object. If there is an - * error, the result is an error message. - * - *---------------------------------------------------------------------- - */ - -static int -InfoVarsCmd( - ClientData dummy, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ -{ - Interp *iPtr = (Interp *) interp; - char *varName, *pattern; - CONST char *simplePattern; - register Tcl_HashEntry *entryPtr; - Tcl_HashSearch search; - Var *varPtr; - Namespace *nsPtr; - Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); - Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); - Tcl_Obj *listPtr, *elemObjPtr; - int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ - - /* - * Get the pattern and find the "effective namespace" in which to list - * variables. We only use this effective namespace if there's no active - * Tcl procedure frame. - */ - - if (objc == 1) { - simplePattern = NULL; - nsPtr = currNsPtr; - specificNsInPattern = 0; - } else if (objc == 2) { - /* - * From the pattern, get the effective namespace and the simple - * pattern (no namespace qualifiers or ::'s) at the end. If an error - * was found while parsing the pattern, return it. Otherwise, if the - * namespace wasn't found, just leave nsPtr NULL: we will return an - * empty list since no variables there can be found. - */ - - Namespace *dummy1NsPtr, *dummy2NsPtr; - - pattern = TclGetString(objv[1]); - TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL, - /*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr, - &simplePattern); - - if (nsPtr != NULL) { /* We successfully found the pattern's ns. */ - specificNsInPattern = (strcmp(simplePattern, pattern) != 0); - } - } else { - Tcl_WrongNumArgs(interp, 1, objv, "?pattern?"); - return TCL_ERROR; - } - - /* - * If the namespace specified in the pattern wasn't found, just return. - */ - - if (nsPtr == NULL) { - return TCL_OK; - } - - listPtr = Tcl_NewListObj(0, NULL); - - if (!(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC) - || specificNsInPattern) { - /* - * There is no frame pointer, the frame pointer was pushed only to - * activate a namespace, or we are in a procedure call frame but a - * specific namespace was specified. Create a list containing only the - * variables in the effective namespace's variable table. - */ - - if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) { - /* - * If we can just do hash lookups, that simplifies things a lot. - */ - - entryPtr = Tcl_FindHashEntry(&nsPtr->varTable, simplePattern); - if (entryPtr != NULL) { - varPtr = (Var *) Tcl_GetHashValue(entryPtr); - if (!TclIsVarUndefined(varPtr) - || TclIsVarNamespaceVar(varPtr)) { - if (specificNsInPattern) { - elemObjPtr = Tcl_NewObj(); - Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, - elemObjPtr); - } else { - elemObjPtr = Tcl_NewStringObj(simplePattern, -1); - } - Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); - } - } else if ((nsPtr != globalNsPtr) && !specificNsInPattern) { - entryPtr = Tcl_FindHashEntry(&globalNsPtr->varTable, - simplePattern); - if (entryPtr != NULL) { - varPtr = (Var *) Tcl_GetHashValue(entryPtr); - if (!TclIsVarUndefined(varPtr) - || TclIsVarNamespaceVar(varPtr)) { - Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewStringObj(simplePattern, -1)); - } - } - } - } else { - /* - * Have to scan the tables of variables. - */ - - entryPtr = Tcl_FirstHashEntry(&nsPtr->varTable, &search); - while (entryPtr != NULL) { - varPtr = (Var *) Tcl_GetHashValue(entryPtr); - if (!TclIsVarUndefined(varPtr) - || TclIsVarNamespaceVar(varPtr)) { - varName = Tcl_GetHashKey(&nsPtr->varTable, entryPtr); - if ((simplePattern == NULL) - || Tcl_StringMatch(varName, simplePattern)) { - if (specificNsInPattern) { - elemObjPtr = Tcl_NewObj(); - Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, - elemObjPtr); - } else { - elemObjPtr = Tcl_NewStringObj(varName, -1); - } - Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); - } - } - entryPtr = Tcl_NextHashEntry(&search); - } - - /* - * If the effective namespace isn't the global :: namespace, and a - * specific namespace wasn't requested in the pattern (i.e., the - * pattern only specifies variable names), then add in all global - * :: variables that match the simple pattern. Of course, add in - * only those variables that aren't hidden by a variable in the - * effective namespace. - */ - - if ((nsPtr != globalNsPtr) && !specificNsInPattern) { - entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable,&search); - while (entryPtr != NULL) { - varPtr = (Var *) Tcl_GetHashValue(entryPtr); - if (!TclIsVarUndefined(varPtr) - || TclIsVarNamespaceVar(varPtr)) { - varName = Tcl_GetHashKey(&globalNsPtr->varTable, - entryPtr); - if ((simplePattern == NULL) - || Tcl_StringMatch(varName, simplePattern)) { - if (Tcl_FindHashEntry(&nsPtr->varTable, - varName) == NULL) { - Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewStringObj(varName, -1)); - } - } - } - entryPtr = Tcl_NextHashEntry(&search); - } - } - } - } else if (((Interp *)interp)->varFramePtr->procPtr != NULL) { - AppendLocals(interp, listPtr, simplePattern, 1); - } - - Tcl_SetObjResult(interp, listPtr); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * * Tcl_JoinObjCmd -- * * This procedure is invoked to process the "join" Tcl command. See the diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 9260723..41fe7d8 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.3 2007/06/21 16:04:55 dgp Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.150.2.4 2007/09/04 17:43:48 dgp Exp $ */ #include "tclInt.h" @@ -1026,7 +1026,7 @@ Tcl_SplitObjCmd( hPtr = Tcl_CreateHashEntry(&charReuseTable, (char*)0+ch, &isNew); if (isNew) { - objPtr = Tcl_NewStringObj(stringPtr, len); + TclNewStringObj(objPtr, stringPtr, len); /* * Don't need to fiddle with refcount... @@ -1054,7 +1054,7 @@ Tcl_SplitObjCmd( Tcl_ListObjAppendElement(NULL, listPtr, objPtr); stringPtr = p + 1; } - objPtr = Tcl_NewStringObj(stringPtr, end - stringPtr); + TclNewStringObj(objPtr, stringPtr, end - stringPtr); Tcl_ListObjAppendElement(NULL, listPtr, objPtr); } else { char *element, *p, *splitEnd; @@ -1073,7 +1073,7 @@ Tcl_SplitObjCmd( for (p = splitChars; p < splitEnd; p += splitLen) { splitLen = TclUtfToUniChar(p, &splitChar); if (ch == splitChar) { - objPtr = Tcl_NewStringObj(element, stringPtr - element); + TclNewStringObj(objPtr, element, stringPtr - element); Tcl_ListObjAppendElement(NULL, listPtr, objPtr); element = stringPtr + len; break; @@ -1081,7 +1081,7 @@ Tcl_SplitObjCmd( } } - objPtr = Tcl_NewStringObj(element, stringPtr - element); + TclNewStringObj(objPtr, element, stringPtr - element); Tcl_ListObjAppendElement(NULL, listPtr, objPtr); } Tcl_SetObjResult(interp, listPtr); diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index c6bdf15..585224d 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.4 2007/07/12 14:29:53 dgp Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.109.2.5 2007/09/04 17:43:49 dgp Exp $ */ #include "tclInt.h" @@ -163,6 +163,9 @@ static int CompileStrictlyBinaryOpCmd(Tcl_Interp *interp, static int CompileUnaryOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, int instruction, CompileEnv *envPtr); +static void CompileReturnInternal(CompileEnv *envPtr, + unsigned char op, int code, int level, + Tcl_Obj *returnOpts); /* * Flags bits used by PushVarName. @@ -403,8 +406,7 @@ TclCompileCatchCmd( return TCL_ERROR; } resultIndex = TclFindCompiledLocal(resultNameTokenPtr[1].start, - resultNameTokenPtr[1].size, /*create*/ 1, VAR_SCALAR, - envPtr->procPtr); + resultNameTokenPtr[1].size, /*create*/ 1, envPtr->procPtr); /* DKF */ if (parsePtr->numWords == 4) { @@ -418,8 +420,7 @@ TclCompileCatchCmd( return TCL_ERROR; } optsIndex = TclFindCompiledLocal(optsNameTokenPtr[1].start, - optsNameTokenPtr[1].size, /*create*/ 1, VAR_SCALAR, - envPtr->procPtr); + optsNameTokenPtr[1].size, /*create*/ 1, envPtr->procPtr); } } @@ -658,8 +659,7 @@ TclCompileDictCmd( if (!TclIsLocalScalar(name, nameChars)) { return TCL_ERROR; } - dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, VAR_SCALAR, - procPtr); + dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr); for (i=1 ; ivarIndices[i] = TclFindCompiledLocal(name, nameChars, 1, - VAR_SCALAR, procPtr); + duiPtr->varIndices[i] = + TclFindCompiledLocal(name, nameChars, 1, procPtr); tokenPtr = TokenAfter(tokenPtr); } if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { @@ -969,7 +965,7 @@ TclCompileDictCmd( } bodyTokenPtr = tokenPtr; - keyTmpIndex = TclFindCompiledLocal(NULL, 0, 1, VAR_SCALAR, procPtr); + keyTmpIndex = TclFindCompiledLocal(NULL, 0, 1, procPtr); /* * The list of variables to bind is stored in auxiliary data so that @@ -1040,8 +1036,7 @@ TclCompileDictCmd( if (!TclIsLocalScalar(name, nameChars)) { return TCL_ERROR; } - dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, VAR_SCALAR, - procPtr); + dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr); for (i=1 ; ivarIndexes[j] = TclFindCompiledLocal(varName, - nameChars, /*create*/ 1, VAR_SCALAR, procPtr); + nameChars, /*create*/ 1, procPtr); } infoPtr->varLists[loopIndex] = varListPtr; } @@ -3146,7 +3140,7 @@ TclCompileReturnCmd( */ if (explicitResult) { - CompileWord(envPtr, wordTokenPtr, interp, numWords-1); + CompileWord(envPtr, wordTokenPtr, interp, numWords-1); } else { /* * No explict result argument, so default result is empty string. @@ -3195,10 +3189,35 @@ TclCompileReturnCmd( * emit the INST_RETURN_IMM instruction with code and level as operands. */ + CompileReturnInternal(envPtr, INST_RETURN_IMM, code, level, returnOpts); + return TCL_OK; +} + +static void +CompileReturnInternal( + CompileEnv *envPtr, + unsigned char op, + int code, + int level, + Tcl_Obj *returnOpts) +{ TclEmitPush(TclAddLiteralObj(envPtr, returnOpts, NULL), envPtr); - TclEmitInstInt4(INST_RETURN_IMM, code, envPtr); + TclEmitInstInt4(op, code, envPtr); TclEmitInt4(level, envPtr); - return TCL_OK; +} + +void +TclCompileSyntaxError( + Tcl_Interp *interp, + CompileEnv *envPtr) +{ + Tcl_Obj *msg = Tcl_GetObjResult(interp); + int numBytes; + const char *bytes = Tcl_GetStringFromObj(msg, &numBytes); + + TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, numBytes), envPtr); + CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0, + Tcl_GetReturnOptions(interp, TCL_ERROR)); } /* @@ -4663,7 +4682,6 @@ PushVarName( if ((envPtr->procPtr != NULL) && !hasNsQualifiers) { localIndex = TclFindCompiledLocal(name, nameChars, /*create*/ flags & TCL_CREATE_VAR, - /*flags*/ ((elName==NULL)? VAR_SCALAR : VAR_ARRAY), envPtr->procPtr); if ((flags & TCL_NO_LARGE_INDEX) && (localIndex > 255)) { /* @@ -4879,8 +4897,7 @@ CompileComparisonOpCmd( return TCL_ERROR; } else { - int tmpIndex = TclFindCompiledLocal(NULL, 0, 1, VAR_SCALAR, - envPtr->procPtr); + int tmpIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr->procPtr); int words; tokenPtr = TokenAfter(parsePtr->tokenPtr); @@ -5334,7 +5351,6 @@ IndexTailVarIfKnown( localIndex = TclFindCompiledLocal(tailName, len, /*create*/ TCL_CREATE_VAR, - /*flags*/ 0, envPtr->procPtr); Tcl_DecrRefCount(tailPtr); return localIndex; diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 7bab21a..5ce9c8d 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -5,14 +5,12 @@ * and implementations of the Tcl commands corresponding to expression * operators, such as the command ::tcl::mathop::+ . * - * Copyright (c) 1997 Sun Microsystems, Inc. - * Copyright (c) 1998-2000 by Scriptics Corporation. - * Contributions from Don Porter, NIST, 2006. (not subject to US copyright) + * Contributions from Don Porter, NIST, 2006-2007. (not subject to US copyright) * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompExpr.c,v 1.53.2.8 2007/07/19 22:52:57 dgp Exp $ + * RCS: @(#) $Id: tclCompExpr.c,v 1.53.2.9 2007/09/04 17:43:49 dgp Exp $ */ #include "tclInt.h" @@ -35,6 +33,8 @@ typedef struct OpNode { } p; unsigned char lexeme; /* Code that identifies the operator. */ unsigned char precedence; /* Precedence of the operator */ + unsigned char mark; /* Mark used to control traversal. */ + unsigned char constant; /* Flag marking constant subexpressions. */ } OpNode; /* @@ -63,7 +63,6 @@ typedef struct OpNode { */ enum OperandTypes { - OT_NONE = -4, /* Operand not yet (or no longer) known */ OT_LITERAL = -3, /* Operand is a literal in the literal list */ OT_TOKENS = -2, /* Operand is sequence of Tcl_Tokens */ OT_EMPTY = -1 /* "Operand" is an empty string. This is a @@ -83,16 +82,15 @@ enum OperandTypes { /* * Note that it is sufficient to store in the tree just the type of leaf * operand, without any explicit pointer to which leaf. This is true because - * the inorder traversals of the completed tree we perform are known to visit + * the traversals of the completed tree we perform are known to visit * the leaves in the same order as the original parse. * * In a completed parse tree, those OpNodes that are themselves (roots of * subexpression trees that are) operands of some operator store in their * p.parent field a "pointer" to the OpNode of that operator. The p.parent - * field permits a destructive inorder traversal of the tree within a - * non-recursive routine (ConvertTreeToTokens() and CompileExprTree()). This - * means that even expression trees of great depth pose no risk of blowing - * the C stack. + * field permits a traversal of the tree within a * non-recursive routine + * (ConvertTreeToTokens() and CompileExprTree()). This means that even + * expression trees of great depth pose no risk of blowing the C stack. * * While the parse tree is being constructed, the same memory space is used * to hold the p.prev field which chains together a stack of incomplete @@ -103,6 +101,26 @@ enum OperandTypes { * binary operators get stored in an OpNode. Other lexmes get different * treatement. * + * The precedence field provides a place to store the precedence of the + * operator, so it need not be looked up again and again. + * + * The mark field is use to control the traversal of the tree, so + * that it can be done non-recursively. The mark values are: + */ + +enum Marks { + MARK_LEFT, /* Next step of traversal is to visit left subtree */ + MARK_RIGHT, /* Next step of traversal is to visit right subtree */ + MARK_PARENT, /* Next step of traversal is to return to parent */ +}; + +/* + * The constant field is a boolean flag marking which subexpressions are + * completely known at compile time, and are eligible for computing then + * rather than waiting until run time. + */ + +/* * Each lexeme belongs to one of four categories, which determine * its place in the parse tree. We use the two high bits of the * (unsigned char) value to store a NODE_TYPE code. @@ -363,6 +381,109 @@ static const unsigned char prec[] = { }; /* + * A table mapping lexemes to bytecode instructions, used by CompileExprTree(). + */ + +static const unsigned char instruction[] = { + /* Non-operator lexemes */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, + /* Binary operator lexemes */ + INST_ADD, /* BINARY_PLUS */ + INST_SUB, /* BINARY_MINUS */ + 0, /* COMMA */ + INST_MULT, /* MULT */ + INST_DIV, /* DIVIDE */ + INST_MOD, /* MOD */ + INST_LT, /* LESS */ + INST_GT, /* GREATER */ + INST_BITAND, /* BIT_AND */ + INST_BITXOR, /* BIT_XOR */ + INST_BITOR, /* BIT_OR */ + 0, /* QUESTION */ + 0, /* COLON */ + INST_LSHIFT, /* LEFT_SHIFT */ + INST_RSHIFT, /* RIGHT_SHIFT */ + INST_LE, /* LEQ */ + INST_GE, /* GEQ */ + INST_EQ, /* EQUAL */ + INST_NEQ, /* NEQ */ + 0, /* AND */ + 0, /* OR */ + INST_STR_EQ, /* STREQ */ + INST_STR_NEQ, /* STRNEQ */ + INST_EXPON, /* EXPON */ + INST_LIST_IN, /* IN_LIST */ + INST_LIST_NOT_IN, /* NOT_IN_LIST */ + 0, /* CLOSE_PAREN */ + 0, /* END */ + /* Expansion room for more binary operators */ + 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, + /* Unary operator lexemes */ + INST_UPLUS, /* UNARY_PLUS */ + INST_UMINUS, /* UNARY_MINUS */ + 0, /* FUNCTION */ + 0, /* START */ + 0, /* OPEN_PAREN */ + INST_LNOT, /* NOT*/ + INST_BITNOT, /* BIT_NOT*/ +}; + +/* + * A table mapping a byte value to the corresponding lexeme for use by + * ParseLexeme(). + */ + +static unsigned char Lexeme[] = { + INVALID /* NUL */, INVALID /* SOH */, + INVALID /* STX */, INVALID /* ETX */, + INVALID /* EOT */, INVALID /* ENQ */, + INVALID /* ACK */, INVALID /* BEL */, + INVALID /* BS */, INVALID /* HT */, + INVALID /* LF */, INVALID /* VT */, + INVALID /* FF */, INVALID /* CR */, + INVALID /* SO */, INVALID /* SI */, + INVALID /* DLE */, INVALID /* DC1 */, + INVALID /* DC2 */, INVALID /* DC3 */, + INVALID /* DC4 */, INVALID /* NAK */, + INVALID /* SYN */, INVALID /* ETB */, + INVALID /* CAN */, INVALID /* EM */, + INVALID /* SUB */, INVALID /* ESC */, + INVALID /* FS */, INVALID /* GS */, + INVALID /* RS */, INVALID /* US */, + INVALID /* SPACE */, 0 /* ! or != */, + QUOTED /* " */, INVALID /* # */, + VARIABLE /* $ */, MOD /* % */, + 0 /* & or && */, INVALID /* ' */, + OPEN_PAREN /* ( */, CLOSE_PAREN /* ) */, + 0 /* * or ** */, PLUS /* + */, + COMMA /* , */, MINUS /* - */, + 0 /* . */, DIVIDE /* / */, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0-9 */ + COLON /* : */, INVALID /* ; */, + 0 /* < or << or <= */, + 0 /* == or INVALID */, + 0 /* > or >> or >= */, + QUESTION /* ? */, INVALID /* @ */, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* A-M */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* N-Z */ + SCRIPT /* [ */, INVALID /* \ */, + INVALID /* ] */, BIT_XOR /* ^ */, + INVALID /* _ */, INVALID /* ` */, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* a-m */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* n-z */ + BRACED /* { */, 0 /* | or || */, + INVALID /* } */, BIT_NOT /* ~ */, + INVALID /* DEL */ +}; + +/* * The JumpList struct is used to create a stack of data needed for the * TclEmitForwardJump() and TclFixupForwardJump() calls that are performed * when compiling the short-circuiting operators QUESTION/COLON, AND, and OR. @@ -388,15 +509,14 @@ typedef struct JumpList { */ static void CompileExprTree(Tcl_Interp *interp, OpNode *nodes, - Tcl_Obj *const litObjv[], Tcl_Obj *funcList, - Tcl_Token *tokenPtr, int *convertPtr, - CompileEnv *envPtr); + int index, Tcl_Obj *const **litObjvPtr, + Tcl_Obj *const *funcObjv, Tcl_Token *tokenPtr, + CompileEnv *envPtr, int optimize); static void ConvertTreeToTokens(const char *start, int numBytes, OpNode *nodes, Tcl_Token *tokenPtr, Tcl_Parse *parsePtr); -static int CopyTokens(Tcl_Token *sourcePtr, Tcl_Parse *parsePtr); -static int GenerateTokensForLiteral(const char *script, - int numBytes, Tcl_Parse *parsePtr); +static int ExecConstantExprTree(Tcl_Interp *interp, OpNode *nodes, + int index, Tcl_Obj * const **litObjvPtr); static int ParseExpr(Tcl_Interp *interp, const char *start, int numBytes, OpNode **opTreePtr, Tcl_Obj *litList, Tcl_Obj *funcList, @@ -474,9 +594,9 @@ ParseExpr( int incomplete; /* Index of the most recent incomplete tree * in the OpNode array. Heads a stack of * incomplete trees linked by p.prev. */ - int complete = OT_NONE; /* "Index" of the complete tree (that is, a + int complete = OT_EMPTY; /* "Index" of the complete tree (that is, a * complete subexpression) determined at the - * moment. OT_NONE is a nonsense value + * moment. OT_EMPTY is a nonsense value * used only to silence compiler warnings. * During a parse, complete will always hold * an index or an OperandTypes value pointing @@ -514,8 +634,8 @@ ParseExpr( /* Initialize the parse tree with the special "START" node. */ nodes->lexeme = START; nodes->precedence = prec[START]; - nodes->left = OT_NONE; - nodes->right = OT_NONE; + nodes->mark = MARK_RIGHT; + nodes->constant = 1; incomplete = lastParsed = nodesUsed; nodesUsed++; @@ -590,8 +710,8 @@ ParseExpr( * an open paren, it might be a function call, and when the * bareword is a legal literal boolean value, we accept that * as well. - */ + if (start[scanned+TclParseAllWhiteSpace( start+scanned, numBytes-scanned)] == '(') { lexeme = FUNCTION; @@ -689,12 +809,47 @@ ParseExpr( switch (lexeme) { case NUMBER: - case BOOLEAN: + case BOOLEAN: { + if (interp) { + int new; + /* LiteralEntry *lePtr; */ + Tcl_Obj *objPtr = TclCreateLiteral((Interp *)interp, + (char *)start, scanned, + /* hash */ (unsigned int) -1, &new, + /* nsPtr */ NULL, /* flags */ 0, + NULL /* &lePtr */); + if (objPtr->typePtr != literal->typePtr) { + /* + * What we would like to do is this: + * + * lePtr->objPtr = literal; + * Tcl_IncrRefCount(literal); + * Tcl_DecrRefCount(objPtr); + * + * However, the design of the "global" and "local" + * LiteralTable does not permit the value of + * lePtr->objPtr to be changed. So rather than + * replace lePtr->objPtr, we do surgery to transfer + * the intrep of literal into it. Ugly stuff here + * that's generally unsafe, but ok here since we know + * the Tcl_ObjTypes literal might possibly have. + */ + Tcl_Obj *toFree = literal; + literal = objPtr; + TclFreeIntRep(literal); + literal->typePtr = toFree->typePtr; + literal->internalRep = toFree->internalRep; + toFree->typePtr = NULL; + Tcl_DecrRefCount(toFree); + } + } + Tcl_ListObjAppendElement(NULL, litList, literal); complete = lastParsed = OT_LITERAL; start += scanned; numBytes -= scanned; continue; + } default: break; } @@ -715,19 +870,19 @@ ParseExpr( switch (lexeme) { case QUOTED: - code = Tcl_ParseQuotedString(interp, start, numBytes, + code = Tcl_ParseQuotedString(NULL, start, numBytes, parsePtr, 1, &end); scanned = end - start; break; case BRACED: - code = Tcl_ParseBraces(interp, start, numBytes, + code = Tcl_ParseBraces(NULL, start, numBytes, parsePtr, 1, &end); scanned = end - start; break; case VARIABLE: - code = Tcl_ParseVarName(interp, start, numBytes, parsePtr, 1); + code = Tcl_ParseVarName(NULL, start, numBytes, parsePtr, 1); /* * Handle the quirk that Tcl_ParseVarName reports a successful @@ -861,11 +1016,18 @@ ParseExpr( } /* Create an OpNode for the unary operator */ - nodePtr->lexeme = lexeme; /* Remember the operator... */ - nodePtr->precedence = prec[lexeme]; /* ... and its precedence. */ - nodePtr->left = OT_NONE; /* No left operand */ - nodePtr->right = OT_NONE; /* Right operand not - * yet known. */ + nodePtr->lexeme = lexeme; + nodePtr->precedence = prec[lexeme]; + nodePtr->mark = MARK_RIGHT; + + /* + * A FUNCTION cannot be a constant expression, because Tcl allows + * functions to return variable results with the same arguments; + * for example, rand(). Other unary operators can root a constant + * expression, so long as the argument is a constant expression. + */ + + nodePtr->constant = (lexeme != FUNCTION); /* * This unary operator is a new incomplete tree, so push it @@ -904,9 +1066,6 @@ ParseExpr( scanned = 0; complete = lastParsed = OT_EMPTY; - - /* TODO: explain */ - nodePtr[-1].left--; break; } msg = Tcl_ObjPrintf("empty subexpression at %s", mark); @@ -1048,6 +1207,22 @@ ParseExpr( incompletePtr->right = complete; if (IsOperator(complete)) { nodes[complete].p.parent = incomplete; + incompletePtr->constant = incompletePtr->constant + && nodes[complete].constant; + } else { + incompletePtr->constant = incompletePtr->constant + && (complete == OT_LITERAL); + } + + /* + * The QUESTION/COLON and FUNCTION/OPEN_PAREN combinations each + * make up a single operator. Force them to agree whether they + * have a constant expression. + */ + + if ((incompletePtr->lexeme == QUESTION) + || (incompletePtr->lexeme == FUNCTION)) { + nodes[complete].constant = incompletePtr->constant; } if (incompletePtr->lexeme == START) { @@ -1066,6 +1241,7 @@ ParseExpr( * become the complete tree. Pop it from the incomplete * tree stack. */ + complete = incomplete; incomplete = incompletePtr->p.prev; @@ -1093,9 +1269,6 @@ ParseExpr( "unexpected \",\" outside function argument list"); goto error; } - - /* TODO: explain */ - incompletePtr->left++; } /* Operator ":" may only be right operand of "?" */ @@ -1107,19 +1280,31 @@ ParseExpr( /* Create no node for a CLOSE_PAREN lexeme. */ if (lexeme == CLOSE_PAREN) { - - /* TODO: explain */ - incompletePtr->left++; break; } /* Link complete tree as left operand of new node. */ nodePtr->lexeme = lexeme; nodePtr->precedence = precedence; - nodePtr->right = OT_NONE; + nodePtr->mark = MARK_LEFT; nodePtr->left = complete; + + /* + * The COMMA operator cannot be optimized, since the function + * needs all of its arguments, and optimization would reduce + * the number. Other binary operators root constant expressions + * when both arguments are constant expressions. + */ + + nodePtr->constant = (lexeme != COMMA); + if (IsOperator(complete)) { nodes[complete].p.parent = nodesUsed; + nodePtr->constant = nodePtr->constant + && nodes[complete].constant; + } else { + nodePtr->constant = nodePtr->constant + && (complete == OT_LITERAL); } /* @@ -1158,6 +1343,7 @@ ParseExpr( } if (interp == NULL) { + /* Nowhere to report an error message, so just free it */ if (msg) { Tcl_DecrRefCount(msg); @@ -1213,103 +1399,16 @@ ParseExpr( /* *---------------------------------------------------------------------- * - * GenerateTokensForLiteral -- - * - * Results: - * Number of bytes scanned. - * - * Side effects: - * The Tcl_Parse *parsePtr is filled with Tcl_Tokens representing the - * literal. - * - *---------------------------------------------------------------------- - */ - -static int -GenerateTokensForLiteral( - const char *script, - int numBytes, - Tcl_Parse *parsePtr) -{ - int scanned; - const char *start = script; - Tcl_Token *destPtr; - unsigned char lexeme; - - /* Have to reparse to get pointers into source string. */ - scanned = TclParseAllWhiteSpace(start, numBytes); - start +=scanned; - scanned = ParseLexeme(start, numBytes-scanned, &lexeme, NULL); - - if (parsePtr->numTokens + 1 >= parsePtr->tokensAvailable) { - TclExpandTokenArray(parsePtr); - } - destPtr = parsePtr->tokenPtr + parsePtr->numTokens; - destPtr->type = TCL_TOKEN_SUB_EXPR; - destPtr->start = start; - destPtr->size = scanned; - destPtr->numComponents = 1; - destPtr++; - destPtr->type = TCL_TOKEN_TEXT; - destPtr->start = start; - destPtr->size = scanned; - destPtr->numComponents = 0; - parsePtr->numTokens += 2; - - return (start + scanned - script); -} - -/* - *---------------------------------------------------------------------- - * - * CopyTokens -- - * - * Results: - * Number of bytes scanned. - * - * Side effects: - * The Tcl_Parse *parsePtr is filled with Tcl_Tokens representing the - * literal. - * - *---------------------------------------------------------------------- - */ - -static int -CopyTokens( - Tcl_Token *sourcePtr, - Tcl_Parse *parsePtr) -{ - int toCopy = sourcePtr->numComponents + 1; - Tcl_Token *destPtr; - - if (sourcePtr->numComponents == sourcePtr[1].numComponents + 1) { - while (parsePtr->numTokens + toCopy - 1 >= parsePtr->tokensAvailable) { - TclExpandTokenArray(parsePtr); - } - destPtr = parsePtr->tokenPtr + parsePtr->numTokens; - memcpy(destPtr, sourcePtr, (size_t) toCopy * sizeof(Tcl_Token)); - destPtr->type = TCL_TOKEN_SUB_EXPR; - parsePtr->numTokens += toCopy; - } else { - while (parsePtr->numTokens + toCopy >= parsePtr->tokensAvailable) { - TclExpandTokenArray(parsePtr); - } - destPtr = parsePtr->tokenPtr + parsePtr->numTokens; - *destPtr = *sourcePtr; - destPtr->type = TCL_TOKEN_SUB_EXPR; - destPtr->numComponents++; - destPtr++; - memcpy(destPtr, sourcePtr, (size_t) toCopy * sizeof(Tcl_Token)); - parsePtr->numTokens += toCopy + 1; - } - return toCopy; -} - -/* - *---------------------------------------------------------------------- - * * ConvertTreeToTokens -- * + * Given a string, the numBytes bytes starting at start, and an OpNode + * tree and Tcl_Token array created by passing that same string to + * ParseExpr(), this function writes into *parsePtr the sequence of + * Tcl_Tokens needed so to satisfy the historical interface provided + * by Tcl_ParseExpr(). Note that this routine exists only for the sake + * of the public Tcl_ParseExpr() routine. It is not used by Tcl itself + * at all. + * * Results: * None. * @@ -1328,187 +1427,299 @@ ConvertTreeToTokens( Tcl_Token *tokenPtr, Tcl_Parse *parsePtr) { + int subExprTokenIdx = 0; OpNode *nodePtr = nodes; - int scanned, copied, tokenIdx; - unsigned char lexeme; - Tcl_Token *destPtr; + int next = nodePtr->right; while (1) { - switch (NODE_TYPE & nodePtr->lexeme) { - case UNARY: - if (nodePtr->right > OT_NONE) { - int right = nodePtr->right; + Tcl_Token *subExprTokenPtr; + int scanned, parentIdx; + unsigned char lexeme; - nodePtr->right = OT_NONE; - if (nodePtr->lexeme != START) { - /* - * Find operator in string. - */ + /* + * Advance the mark so the next exit from this node won't retrace + * steps over ground already covered. + */ - scanned = TclParseAllWhiteSpace(start, numBytes); - start +=scanned; - numBytes -= scanned; - scanned = ParseLexeme(start, numBytes, &lexeme, NULL); - if (lexeme != nodePtr->lexeme) { - if (lexeme != (nodePtr->lexeme & ~NODE_TYPE)) { - Tcl_Panic("lexeme mismatch"); - } - } - if (nodePtr->lexeme != OPEN_PAREN) { - if (parsePtr->numTokens + 1 - >= parsePtr->tokensAvailable) { - TclExpandTokenArray(parsePtr); - } - nodePtr->right = OT_NONE - parsePtr->numTokens; - destPtr = parsePtr->tokenPtr + parsePtr->numTokens; - destPtr->type = TCL_TOKEN_SUB_EXPR; - destPtr->start = start; - destPtr++; - destPtr->type = TCL_TOKEN_OPERATOR; - destPtr->start = start; - destPtr->size = scanned; - destPtr->numComponents = 0; - parsePtr->numTokens += 2; - } - start += scanned; - numBytes -= scanned; - } - switch (right) { - case OT_EMPTY: - break; - case OT_LITERAL: - scanned = GenerateTokensForLiteral(start, numBytes, - parsePtr); - start +=scanned; - numBytes -= scanned; - break; - case OT_TOKENS: - copied = CopyTokens(tokenPtr, parsePtr); - scanned = tokenPtr->start + tokenPtr->size - start; - start +=scanned; - numBytes -= scanned; - tokenPtr += copied; - break; - default: - nodePtr = nodes + right; + nodePtr->mark++; + + /* Handle next child node or leaf */ + switch (next) { + case OT_EMPTY: + + /* No tokens and no characters for the OT_EMPTY leaf. */ + break; + + case OT_LITERAL: + + /* Skip any white space that comes before the literal */ + scanned = TclParseAllWhiteSpace(start, numBytes); + start +=scanned; + numBytes -= scanned; + + /* Reparse the literal to get pointers into source string */ + scanned = ParseLexeme(start, numBytes, &lexeme, NULL); + + if (parsePtr->numTokens + 1 >= parsePtr->tokensAvailable) { + TclExpandTokenArray(parsePtr); + } + subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens; + subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR; + subExprTokenPtr->start = start; + subExprTokenPtr->size = scanned; + subExprTokenPtr->numComponents = 1; + subExprTokenPtr[1].type = TCL_TOKEN_TEXT; + subExprTokenPtr[1].start = start; + subExprTokenPtr[1].size = scanned; + subExprTokenPtr[1].numComponents = 0; + + parsePtr->numTokens += 2; + start +=scanned; + numBytes -= scanned; + break; + + case OT_TOKENS: { + + /* + * tokenPtr points to a token sequence that came from parsing + * a Tcl word. A Tcl word is made up of a sequence of one or + * more elements. When the word is only a single element, it's + * been the historical practice to replace the TCL_TOKEN_WORD + * token directly with a TCL_TOKEN_SUB_EXPR token. However, + * when the word has multiple elements, a TCL_TOKEN_WORD token + * is kept as a grouping device so that TCL_TOKEN_SUB_EXPR + * always has only one element. Wise or not, these are the + * rules the Tcl expr parser has followed, and for the sake + * of those few callers of Tcl_ParseExpr() we do not change + * them now. Internally, we can do better. + */ + + int toCopy = tokenPtr->numComponents + 1; + + if (tokenPtr->numComponents == tokenPtr[1].numComponents + 1) { + + /* + * Single element word. Copy tokens and convert the leading + * token to TCL_TOKEN_SUB_EXPR. + */ + + while (parsePtr->numTokens + toCopy - 1 + >= parsePtr->tokensAvailable) { + TclExpandTokenArray(parsePtr); } + subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens; + memcpy(subExprTokenPtr, tokenPtr, + (size_t) toCopy * sizeof(Tcl_Token)); + subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR; + parsePtr->numTokens += toCopy; } else { - if (nodePtr->lexeme == START) { - /* - * We're done. - */ - return; - } - if (nodePtr->lexeme == OPEN_PAREN) { - /* - * Skip past matching close paren. - */ + /* + * Multiple element word. Create a TCL_TOKEN_SUB_EXPR + * token to lead, with fields initialized from the leading + * token, then copy entire set of word tokens. + */ - scanned = TclParseAllWhiteSpace(start, numBytes); - start +=scanned; - numBytes -= scanned; - scanned = ParseLexeme(start, numBytes, &lexeme, NULL); - start +=scanned; - numBytes -= scanned; - } else { - tokenIdx = OT_NONE - nodePtr->right; - nodePtr->right = OT_NONE; - destPtr = parsePtr->tokenPtr + tokenIdx; - destPtr->size = start - destPtr->start; - destPtr->numComponents = parsePtr->numTokens - tokenIdx - 1; + while (parsePtr->numTokens + toCopy + >= parsePtr->tokensAvailable) { + TclExpandTokenArray(parsePtr); } - nodePtr = nodes + nodePtr->p.parent; + subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens; + *subExprTokenPtr = *tokenPtr; + subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR; + subExprTokenPtr->numComponents++; + subExprTokenPtr++; + memcpy(subExprTokenPtr, tokenPtr, + (size_t) toCopy * sizeof(Tcl_Token)); + parsePtr->numTokens += toCopy + 1; } + + scanned = tokenPtr->start + tokenPtr->size - start; + start +=scanned; + numBytes -= scanned; + tokenPtr += toCopy; break; - case BINARY: - if (nodePtr->left > OT_NONE) { - int left = nodePtr->left; + } - nodePtr->left = OT_NONE; - scanned = TclParseAllWhiteSpace(start, numBytes); - start +=scanned; - numBytes -= scanned; - if ((nodePtr->lexeme != COMMA) && (nodePtr->lexeme != COLON)) { - if (parsePtr->numTokens + 1 >= parsePtr->tokensAvailable) { - TclExpandTokenArray(parsePtr); - } - nodePtr->left = OT_NONE - parsePtr->numTokens; - destPtr = parsePtr->tokenPtr + parsePtr->numTokens; - destPtr->type = TCL_TOKEN_SUB_EXPR; - destPtr->start = start; - destPtr++; - destPtr->type = TCL_TOKEN_OPERATOR; - parsePtr->numTokens += 2; - } - switch (left) { - case OT_LITERAL: - scanned = GenerateTokensForLiteral(start, numBytes, - parsePtr); - start +=scanned; - numBytes -= scanned; - break; - case OT_TOKENS: - copied = CopyTokens(tokenPtr, parsePtr); - scanned = tokenPtr->start + tokenPtr->size - start; - start +=scanned; - numBytes -= scanned; - tokenPtr += copied; - break; - default: - nodePtr = nodes + left; + default: + + /* Advance to the child node, which is an operator. */ + nodePtr = nodes + next; + + /* Skip any white space that comes before the subexpression */ + scanned = TclParseAllWhiteSpace(start, numBytes); + start +=scanned; + numBytes -= scanned; + + /* Generate tokens for the operator / subexpression... */ + switch (nodePtr->lexeme) { + case OPEN_PAREN: + case COMMA: + case COLON: + + /* + * Historical practice has been to have no Tcl_Tokens for + * these operators. + */ + + break; + + default: { + + /* + * Remember the index of the last subexpression we were + * working on -- that of our parent. We'll stack it later. + */ + + parentIdx = subExprTokenIdx; + + /* + * Verify space for the two leading Tcl_Tokens representing + * the subexpression rooted by this operator. The first + * Tcl_Token will be of type TCL_TOKEN_SUB_EXPR; the second + * of type TCL_TOKEN_OPERATOR. + */ + + if (parsePtr->numTokens + 1 >= parsePtr->tokensAvailable) { + TclExpandTokenArray(parsePtr); } - } else if (nodePtr->right > OT_NONE) { - int right = nodePtr->right; + subExprTokenIdx = parsePtr->numTokens; + subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx; + parsePtr->numTokens += 2; + subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR; + subExprTokenPtr[1].type = TCL_TOKEN_OPERATOR; + + /* + * Our current position scanning the string is the starting + * point for this subexpression. + */ + + subExprTokenPtr->start = start; + + /* + * Eventually, we know that the numComponents field of the + * Tcl_Token of type TCL_TOKEN_OPERATOR will be 0. This means + * we can make other use of this field for now to track the + * stack of subexpressions we have pending. + */ + + subExprTokenPtr[1].numComponents = parentIdx; + break; + } + } + break; + } + + /* Determine which way to exit the node on this pass. */ + router: + switch (nodePtr->mark) { + case MARK_LEFT: + next = nodePtr->left; + break; + + case MARK_RIGHT: + next = nodePtr->right; - nodePtr->right = OT_NONE; + /* Skip any white space that comes before the operator */ + scanned = TclParseAllWhiteSpace(start, numBytes); + start +=scanned; + numBytes -= scanned; + + /* + * Here we scan from the string the operator corresponding to + * nodePtr->lexeme. + */ + + scanned = ParseLexeme(start, numBytes, &lexeme, NULL); + + switch(nodePtr->lexeme) { + case OPEN_PAREN: + case COMMA: + case COLON: + + /* No tokens for these lexemes -> nothing to do. */ + break; + + default: + + /* + * Record in the TCL_TOKEN_OPERATOR token the pointers into + * the string marking where the operator is. + */ + + subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx; + subExprTokenPtr[1].start = start; + subExprTokenPtr[1].size = scanned; + break; + } + + start +=scanned; + numBytes -= scanned; + break; + + case MARK_PARENT: + switch (nodePtr->lexeme) { + case START: + + /* When we get back to the START node, we're done. */ + return; + + case COMMA: + case COLON: + + /* No tokens for these lexemes -> nothing to do. */ + break; + + case OPEN_PAREN: + + /* Skip past matching close paren. */ scanned = TclParseAllWhiteSpace(start, numBytes); start +=scanned; numBytes -= scanned; scanned = ParseLexeme(start, numBytes, &lexeme, NULL); - if (lexeme != nodePtr->lexeme) { - if (lexeme != (nodePtr->lexeme & ~NODE_TYPE)) { - Tcl_Panic("lexeme mismatch"); - } - } - - if ((nodePtr->lexeme != COMMA) && (nodePtr->lexeme != COLON)) { - tokenIdx = OT_NONE - nodePtr->left; - destPtr = parsePtr->tokenPtr + tokenIdx + 1; - destPtr->start = start; - destPtr->size = scanned; - destPtr->numComponents = 0; - } start +=scanned; numBytes -= scanned; - switch (right) { - case OT_LITERAL: - scanned = GenerateTokensForLiteral(start, numBytes, - parsePtr); - start +=scanned; - numBytes -= scanned; - break; - case OT_TOKENS: - copied = CopyTokens(tokenPtr, parsePtr); - scanned = tokenPtr->start + tokenPtr->size - start; - start +=scanned; - numBytes -= scanned; - tokenPtr += copied; - break; - default: - nodePtr = nodes + right; - } - } else { - if ((nodePtr->lexeme != COMMA) && (nodePtr->lexeme != COLON)) { - tokenIdx = OT_NONE - nodePtr->left; - nodePtr->left = OT_NONE; - destPtr = parsePtr->tokenPtr + tokenIdx; - destPtr->size = start - destPtr->start; - destPtr->numComponents = parsePtr->numTokens-tokenIdx-1; - } - nodePtr = nodes + nodePtr->p.parent; + break; + + default: { + + /* + * Before we leave this node/operator/subexpression for the + * last time, finish up its tokens.... + * + * Our current position scanning the string is where the + * substring for the subexpression ends. + */ + + subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx; + subExprTokenPtr->size = start - subExprTokenPtr->start; + + /* + * All the Tcl_Tokens allocated and filled belong to + * this subexpresion. The first token is the leading + * TCL_TOKEN_SUB_EXPR token, and all the rest (one fewer) + * are its components. + */ + + subExprTokenPtr->numComponents = + (parsePtr->numTokens - subExprTokenIdx) - 1; + + /* + * Finally, as we return up the tree to our parent, pop the + * parent subexpression off our subexpression stack, and + * fill in the zero numComponents for the operator Tcl_Token. + */ + + parentIdx = subExprTokenPtr[1].numComponents; + subExprTokenPtr[1].numComponents = 0; + subExprTokenIdx = parentIdx; + break; } - break; + } + + /* Since we're returning to parent, skip child handling code. */ + nodePtr = nodes + nodePtr->p.parent; + goto router; } } } @@ -1612,72 +1823,18 @@ ParseLexeme( int scanned; Tcl_UniChar ch; Tcl_Obj *literal = NULL; + unsigned char byte; if (numBytes == 0) { *lexemePtr = END; return 0; } - switch (*start) { - case '[': - *lexemePtr = SCRIPT; - return 1; - - case '{': - *lexemePtr = BRACED; - return 1; - - case '(': - *lexemePtr = OPEN_PAREN; - return 1; - - case ')': - *lexemePtr = CLOSE_PAREN; - return 1; - - case '$': - *lexemePtr = VARIABLE; - return 1; - - case '\"': - *lexemePtr = QUOTED; - return 1; - - case ',': - *lexemePtr = COMMA; - return 1; - - case '/': - *lexemePtr = DIVIDE; - return 1; - - case '%': - *lexemePtr = MOD; - return 1; - - case '+': - *lexemePtr = PLUS; - return 1; - - case '-': - *lexemePtr = MINUS; - return 1; - - case '?': - *lexemePtr = QUESTION; - return 1; - - case ':': - *lexemePtr = COLON; - return 1; - - case '^': - *lexemePtr = BIT_XOR; - return 1; - - case '~': - *lexemePtr = BIT_NOT; + byte = (unsigned char)(*start); + if (byte < sizeof(Lexeme) && Lexeme[byte] != 0) { + *lexemePtr = Lexeme[byte]; return 1; - + } + switch (byte) { case '*': if ((numBytes > 1) && (start[1] == '*')) { *lexemePtr = EXPON; @@ -1749,11 +1906,13 @@ ParseLexeme( case 'i': if ((numBytes > 1) && (start[1] == 'n') && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) { + /* * Must make this check so we can tell the difference between * the "in" operator and the "int" function name and the * "infinity" numeric value. */ + *lexemePtr = IN_LIST; return 2; } @@ -1835,15 +1994,10 @@ ParseLexeme( * TclCompileExpr -- * * This procedure compiles a string containing a Tcl expression into Tcl - * bytecodes. This procedure is the top-level interface to the the - * expression compilation module, and is used by such public procedures - * as Tcl_ExprString, Tcl_ExprStringObj, Tcl_ExprLong, Tcl_ExprDouble, - * Tcl_ExprBoolean, and Tcl_ExprBooleanObj. + * bytecodes. * * Results: - * The return value is TCL_OK on a successful compilation and TCL_ERROR - * on failure. If TCL_ERROR is returned, then the interpreter's result - * contains an error message. + * None. * * Side effects: * Adds instructions to envPtr to evaluate the expression at runtime. @@ -1851,7 +2005,7 @@ ParseLexeme( *---------------------------------------------------------------------- */ -int +void TclCompileExpr( Tcl_Interp *interp, /* Used for error reporting. */ const char *script, /* The source script to compile. */ @@ -1869,30 +2023,22 @@ TclCompileExpr( funcList, parsePtr, 0 /* parseOnly */); if (code == TCL_OK) { - int litObjc, needsNumConversion = 1; - Tcl_Obj **litObjv; + + /* Valid parse; compile the tree. */ + int objc; + Tcl_Obj *const *litObjv; + Tcl_Obj **funcObjv; /* TIP #280 : Track Lines within the expression */ TclAdvanceLines(&envPtr->line, script, script + TclParseAllWhiteSpace(script, numBytes)); - /* - * Valid parse; compile the tree. - */ - - Tcl_ListObjGetElements(NULL, litList, &litObjc, &litObjv); - CompileExprTree(interp, opTree, litObjv, funcList, parsePtr->tokenPtr, - &needsNumConversion, envPtr); - if (needsNumConversion) { - /* - * Attempt to convert the expression result to an int or double. - * This is done in order to support Tcl's policy of interpreting - * operands if at all possible as first integers, else - * floating-point numbers. - */ - - TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr); - } + Tcl_ListObjGetElements(NULL, litList, &objc, (Tcl_Obj ***)&litObjv); + Tcl_ListObjGetElements(NULL, funcList, &objc, &funcObjv); + CompileExprTree(interp, opTree, 0, &litObjv, funcObjv, + parsePtr->tokenPtr, envPtr, 1 /* optimize */); + } else { + TclCompileSyntaxError(interp, envPtr); } Tcl_FreeParse(parsePtr); @@ -1900,6 +2046,56 @@ TclCompileExpr( Tcl_DecrRefCount(funcList); Tcl_DecrRefCount(litList); ckfree((char *) opTree); +} + +/* + *---------------------------------------------------------------------- + * + * ExecConstantExprTree -- + * Compiles and executes bytecode for the subexpression tree at index + * in the nodes array. This subexpression must be constant, made up + * of only constant operators (not functions) and literals. + * + * Results: + * A standard Tcl return code and result left in interp. + * + * Side effects: + * Consumes subtree of nodes rooted at index. Advances the pointer + * *litObjvPtr. + * + *---------------------------------------------------------------------- + */ + +static int +ExecConstantExprTree( + Tcl_Interp *interp, + OpNode *nodes, + int index, + Tcl_Obj *const **litObjvPtr) +{ + CompileEnv *envPtr; + ByteCode *byteCodePtr; + int code; + Tcl_Obj *byteCodeObj = Tcl_NewObj(); + + /* + * Note we are compiling an expression with literal arguments. This means + * there can be no [info frame] calls when we execute the resulting + * bytecode, so there's no need to tend to TIP 280 issues. + */ + + envPtr = (CompileEnv *) TclStackAlloc(interp, sizeof(CompileEnv)); + TclInitCompileEnv(interp, envPtr, NULL, 0, NULL, 0); + CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr, + 0 /* optimize */); + TclEmitOpcode(INST_DONE, envPtr); + Tcl_IncrRefCount(byteCodeObj); + TclInitByteCodeObj(byteCodeObj, envPtr); + TclFreeCompileEnv(envPtr); + TclStackFree(interp, envPtr); + byteCodePtr = (ByteCode *) byteCodeObj->internalRep.otherValuePtr; + code = TclExecuteByteCode(interp, byteCodePtr); + Tcl_DecrRefCount(byteCodeObj); return code; } @@ -1907,13 +2103,21 @@ TclCompileExpr( *---------------------------------------------------------------------- * * CompileExprTree -- - * [???] + * Compiles and writes to envPtr instructions for the subexpression + * tree at index in the nodes array. (*litObjvPtr) must point to the + * proper location in a corresponding literals list. Likewise, when + * non-NULL, funcObjv and tokenPtr must point into matching arrays of + * function names and Tcl_Token's derived from earlier call to + * ParseExpr(). When optimize is true, any constant subexpressions + * will be precomputed. * * Results: * None. * * Side effects: * Adds instructions to envPtr to evaluate the expression at runtime. + * Consumes subtree of nodes rooted at index. Advances the pointer + * *litObjvPtr. * *---------------------------------------------------------------------- */ @@ -1922,280 +2126,248 @@ static void CompileExprTree( Tcl_Interp *interp, OpNode *nodes, - Tcl_Obj *const litObjv[], - Tcl_Obj *funcList, + int index, + Tcl_Obj *const **litObjvPtr, + Tcl_Obj *const *funcObjv, Tcl_Token *tokenPtr, - int *convertPtr, - CompileEnv *envPtr) + CompileEnv *envPtr, + int optimize) { - OpNode *nodePtr = nodes; - int nextFunc = 0; - JumpList *freePtr, *jumpPtr = NULL; - static const int instruction[] = { - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, INST_ADD, INST_SUB, 0, /* COMMA */ - INST_MULT, INST_DIV, INST_MOD, INST_LT, - INST_GT, INST_BITAND, INST_BITXOR, INST_BITOR, - 0, /* QUESTION */ 0, /* COLON */ - INST_LSHIFT, INST_RSHIFT, INST_LE, INST_GE, - INST_EQ, INST_NEQ, 0, /* AND */ 0, /* OR */ - INST_STR_EQ, INST_STR_NEQ, INST_EXPON, INST_LIST_IN, - INST_LIST_NOT_IN, 0, /* CLOSE_PAREN */ 0, /* END */ - 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, INST_UPLUS, INST_UMINUS, 0, /* FUNCTION */ - 0, /* START */ 0, /* OPEN_PAREN */ - INST_LNOT, INST_BITNOT - }; + OpNode *nodePtr = nodes + index; + OpNode *rootPtr = nodePtr; + int numWords = 0; + JumpList *jumpPtr = NULL; + int convert = 1; while (1) { - switch (NODE_TYPE & nodePtr->lexeme) { - case UNARY: - if (nodePtr->right > OT_NONE) { - int right = nodePtr->right; - - nodePtr->right = OT_NONE; - if (nodePtr->lexeme == FUNCTION) { - Tcl_DString cmdName; - Tcl_Obj *funcName; - const char *p; - int length; - - Tcl_DStringInit(&cmdName); - Tcl_DStringAppend(&cmdName, "tcl::mathfunc::", -1); - Tcl_ListObjIndex(NULL, funcList, nextFunc++, &funcName); - p = Tcl_GetStringFromObj(funcName, &length); - Tcl_DStringAppend(&cmdName, p, length); - TclEmitPush(TclRegisterNewNSLiteral(envPtr, - Tcl_DStringValue(&cmdName), - Tcl_DStringLength(&cmdName)), envPtr); - Tcl_DStringFree(&cmdName); + int next; + JumpList *freePtr, *newJump; + + if (nodePtr->mark == MARK_LEFT) { + next = nodePtr->left; + + switch (nodePtr->lexeme) { + case QUESTION: + newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList)); + newJump->next = jumpPtr; + jumpPtr = newJump; + newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList)); + newJump->next = jumpPtr; + jumpPtr = newJump; + jumpPtr->depth = envPtr->currStackDepth; + convert = 1; + break; + case AND: + case OR: + newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList)); + newJump->next = jumpPtr; + jumpPtr = newJump; + newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList)); + newJump->next = jumpPtr; + jumpPtr = newJump; + newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList)); + newJump->next = jumpPtr; + jumpPtr = newJump; + jumpPtr->depth = envPtr->currStackDepth; + break; + } + } else if (nodePtr->mark == MARK_RIGHT) { + next = nodePtr->right; + + switch (nodePtr->lexeme) { + case FUNCTION: { + Tcl_DString cmdName; + const char *p; + int length; + + Tcl_DStringInit(&cmdName); + Tcl_DStringAppend(&cmdName, "tcl::mathfunc::", -1); + p = Tcl_GetStringFromObj(*funcObjv++, &length); + Tcl_DStringAppend(&cmdName, p, length); + TclEmitPush(TclRegisterNewNSLiteral(envPtr, + Tcl_DStringValue(&cmdName), + Tcl_DStringLength(&cmdName)), envPtr); + Tcl_DStringFree(&cmdName); + + /* + * Start a count of the number of words in this function + * command invocation. In case there's already a count + * in progress (nested functions), save it in our unused + * "left" field for restoring later. + */ + + nodePtr->left = numWords; + numWords = 2; /* Command plus one argument */ + break; + } + case QUESTION: + TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &(jumpPtr->jump)); + break; + case COLON: + TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, + &(jumpPtr->next->jump)); + envPtr->currStackDepth = jumpPtr->depth; + jumpPtr->offset = (envPtr->codeNext - envPtr->codeStart); + jumpPtr->convert = convert; + convert = 1; + break; + case AND: + TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &(jumpPtr->jump)); + break; + case OR: + TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &(jumpPtr->jump)); + break; + } + } else { + switch (nodePtr->lexeme) { + case START: + case QUESTION: + if (convert && (nodePtr == rootPtr)) { + TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr); } - switch (right) { - case OT_EMPTY: - break; - case OT_LITERAL: - /* TODO: reduce constant expressions */ - TclEmitPush( TclAddLiteralObj( - envPtr, *litObjv++, NULL), envPtr); - break; - case OT_TOKENS: - if (tokenPtr->type != TCL_TOKEN_WORD) { - Tcl_Panic("unexpected token type %d\n", - tokenPtr->type); - } - TclCompileTokens(interp, tokenPtr+1, - tokenPtr->numComponents, envPtr); - tokenPtr += tokenPtr->numComponents + 1; - break; - default: - nodePtr = nodes + right; + break; + case OPEN_PAREN: + + /* do nothing */ + break; + case FUNCTION: + + /* + * Use the numWords count we've kept to invoke the + * function command with the correct number of arguments. + */ + + if (numWords < 255) { + TclEmitInstInt1(INST_INVOKE_STK1, numWords, envPtr); + } else { + TclEmitInstInt4(INST_INVOKE_STK4, numWords, envPtr); } - } else { - if (nodePtr->lexeme == START) { - /* We're done */ - return; + + /* Restore any saved numWords value. */ + numWords = nodePtr->left; + convert = 1; + break; + case COMMA: + + /* Each comma implies another function argument. */ + numWords++; + break; + case COLON: + if (TclFixupForwardJump(envPtr, &(jumpPtr->next->jump), + (envPtr->codeNext - envPtr->codeStart) + - jumpPtr->next->jump.codeOffset, 127)) { + jumpPtr->offset += 3; } - if (nodePtr->lexeme == OPEN_PAREN) { - /* do nothing */ - } else if (nodePtr->lexeme == FUNCTION) { - int numWords = (nodePtr[1].left - OT_NONE) + 1; - if (numWords < 255) { - TclEmitInstInt1(INST_INVOKE_STK1, numWords, envPtr); - } else { - TclEmitInstInt4(INST_INVOKE_STK4, numWords, envPtr); - } - *convertPtr = 1; - } else { - TclEmitOpcode(instruction[nodePtr->lexeme], envPtr); - *convertPtr = 0; + TclFixupForwardJump(envPtr, &(jumpPtr->jump), + jumpPtr->offset - jumpPtr->jump.codeOffset, 127); + convert |= jumpPtr->convert; + envPtr->currStackDepth = jumpPtr->depth + 1; + freePtr = jumpPtr; + jumpPtr = jumpPtr->next; + TclStackFree(interp, freePtr); + freePtr = jumpPtr; + jumpPtr = jumpPtr->next; + TclStackFree(interp, freePtr); + break; + case AND: + case OR: + TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND) + ? TCL_FALSE_JUMP : TCL_TRUE_JUMP, + &(jumpPtr->next->jump)); + TclEmitPush(TclRegisterNewLiteral(envPtr, + (nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr); + TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, + &(jumpPtr->next->next->jump)); + TclFixupForwardJumpToHere(envPtr, &(jumpPtr->next->jump), 127); + if (TclFixupForwardJumpToHere(envPtr, &(jumpPtr->jump), 127)) { + jumpPtr->next->next->jump.codeOffset += 3; } - nodePtr = nodes + nodePtr->p.parent; + TclEmitPush(TclRegisterNewLiteral(envPtr, + (nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr); + TclFixupForwardJumpToHere(envPtr, &(jumpPtr->next->next->jump), + 127); + convert = 0; + envPtr->currStackDepth = jumpPtr->depth + 1; + freePtr = jumpPtr; + jumpPtr = jumpPtr->next; + TclStackFree(interp, freePtr); + freePtr = jumpPtr; + jumpPtr = jumpPtr->next; + TclStackFree(interp, freePtr); + freePtr = jumpPtr; + jumpPtr = jumpPtr->next; + TclStackFree(interp, freePtr); + break; + default: + TclEmitOpcode(instruction[nodePtr->lexeme], envPtr); + convert = 0; + break; + } + if (nodePtr == rootPtr) { + + /* We're done */ + return; } + nodePtr = nodes + nodePtr->p.parent; + continue; + } + + nodePtr->mark++; + switch (next) { + case OT_EMPTY: + numWords = 1; /* No arguments, so just the command */ break; - case BINARY: - if (nodePtr->left > OT_NONE) { - int left = nodePtr->left; - nodePtr->left = OT_NONE; - /* TODO: reduce constant expressions */ - if (nodePtr->lexeme == QUESTION) { - JumpList *newJump = (JumpList *) - TclStackAlloc(interp, sizeof(JumpList)); - newJump->next = jumpPtr; - jumpPtr = newJump; - newJump = (JumpList *) - TclStackAlloc(interp, sizeof(JumpList)); - newJump->next = jumpPtr; - jumpPtr = newJump; - jumpPtr->depth = envPtr->currStackDepth; - *convertPtr = 1; - } else if (nodePtr->lexeme == AND || nodePtr->lexeme == OR) { - JumpList *newJump = (JumpList *) - TclStackAlloc(interp, sizeof(JumpList)); - newJump->next = jumpPtr; - jumpPtr = newJump; - newJump = (JumpList *) - TclStackAlloc(interp, sizeof(JumpList)); - newJump->next = jumpPtr; - jumpPtr = newJump; - newJump = (JumpList *) - TclStackAlloc(interp, sizeof(JumpList)); - newJump->next = jumpPtr; - jumpPtr = newJump; - jumpPtr->depth = envPtr->currStackDepth; - } - switch (left) { - case OT_LITERAL: - TclEmitPush(TclAddLiteralObj(envPtr, *litObjv++, NULL), - envPtr); - break; - case OT_TOKENS: - if (tokenPtr->type != TCL_TOKEN_WORD) { - Tcl_Panic("unexpected token type %d\n", - tokenPtr->type); - } - TclCompileTokens(interp, tokenPtr+1, - tokenPtr->numComponents, envPtr); - tokenPtr += tokenPtr->numComponents + 1; - break; - default: - nodePtr = nodes + left; - } - } else if (nodePtr->right > OT_NONE) { - int right = nodePtr->right; - - nodePtr->right = OT_NONE; - if (nodePtr->lexeme == QUESTION) { - TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, - &(jumpPtr->jump)); - } else if (nodePtr->lexeme == COLON) { - TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, - &(jumpPtr->next->jump)); - envPtr->currStackDepth = jumpPtr->depth; - jumpPtr->offset = (envPtr->codeNext - envPtr->codeStart); - jumpPtr->convert = *convertPtr; - *convertPtr = 1; - } else if (nodePtr->lexeme == AND) { - TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, - &(jumpPtr->jump)); - } else if (nodePtr->lexeme == OR) { - TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, - &(jumpPtr->jump)); - } - switch (right) { - case OT_LITERAL: - TclEmitPush(TclAddLiteralObj(envPtr, *litObjv++, NULL), - envPtr); - break; - case OT_TOKENS: - if (tokenPtr->type != TCL_TOKEN_WORD) { - Tcl_Panic("unexpected token type %d\n", - tokenPtr->type); - } - TclCompileTokens(interp, tokenPtr+1, - tokenPtr->numComponents, envPtr); - tokenPtr += tokenPtr->numComponents + 1; - break; - default: - nodePtr = nodes + right; - } - } else { - if (nodePtr->lexeme == COMMA || nodePtr->lexeme == QUESTION) { - /* do nothing */ - } else if (nodePtr->lexeme == COLON) { - if (TclFixupForwardJump(envPtr, &(jumpPtr->next->jump), - (envPtr->codeNext - envPtr->codeStart) - - jumpPtr->next->jump.codeOffset, 127)) { - jumpPtr->offset += 3; - } - TclFixupForwardJump(envPtr, &(jumpPtr->jump), - jumpPtr->offset - jumpPtr->jump.codeOffset, 127); - *convertPtr |= jumpPtr->convert; - envPtr->currStackDepth = jumpPtr->depth + 1; - freePtr = jumpPtr; - jumpPtr = jumpPtr->next; - TclStackFree(interp, freePtr); - freePtr = jumpPtr; - jumpPtr = jumpPtr->next; - TclStackFree(interp, freePtr); - } else if (nodePtr->lexeme == AND) { - TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, - &(jumpPtr->next->jump)); - TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr); - } else if (nodePtr->lexeme == OR) { - TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, - &(jumpPtr->next->jump)); - TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr); + case OT_LITERAL: { + Tcl_Obj *const *litObjv = *litObjvPtr; + Tcl_Obj *literal = *litObjv; + int length; + const char *bytes = Tcl_GetStringFromObj(literal, &length); + + TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, length), envPtr); + (*litObjvPtr)++; + break; + } + case OT_TOKENS: + TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents, + envPtr); + tokenPtr += tokenPtr->numComponents + 1; + break; + default: + if (optimize && nodes[next].constant) { + Tcl_InterpState save = Tcl_SaveInterpState(interp, TCL_OK); + if (ExecConstantExprTree(interp, nodes, next, litObjvPtr) + == TCL_OK) { + TclEmitPush(TclAddLiteralObj(envPtr, + Tcl_GetObjResult(interp), NULL), envPtr); } else { - TclEmitOpcode(instruction[nodePtr->lexeme], envPtr); - *convertPtr = 0; + TclCompileSyntaxError(interp, envPtr); } - if ((nodePtr->lexeme == AND) || (nodePtr->lexeme == OR)) { - TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, - &(jumpPtr->next->next->jump)); - TclFixupForwardJumpToHere(envPtr, - &(jumpPtr->next->jump), 127); - if (TclFixupForwardJumpToHere(envPtr, - &(jumpPtr->jump), 127)) { - jumpPtr->next->next->jump.codeOffset += 3; - } - TclEmitPush(TclRegisterNewLiteral(envPtr, - (nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr); - TclFixupForwardJumpToHere(envPtr, - &(jumpPtr->next->next->jump), 127); - *convertPtr = 0; - envPtr->currStackDepth = jumpPtr->depth + 1; - freePtr = jumpPtr; - jumpPtr = jumpPtr->next; - TclStackFree(interp, freePtr); - freePtr = jumpPtr; - jumpPtr = jumpPtr->next; - TclStackFree(interp, freePtr); - freePtr = jumpPtr; - jumpPtr = jumpPtr->next; - TclStackFree(interp, freePtr); - } - nodePtr = nodes + nodePtr->p.parent; + Tcl_RestoreInterpState(interp, save); + convert = 0; + } else { + nodePtr = nodes + next; } - break; } } } - -static int -OpCmd( - Tcl_Interp *interp, - OpNode *nodes, - Tcl_Obj * const litObjv[]) -{ - CompileEnv *compEnvPtr; - ByteCode *byteCodePtr; - int code, tmp=1; - Tcl_Obj *byteCodeObj = Tcl_NewObj(); - - /* - * Note we are compiling an expression with literal arguments. This means - * there can be no [info frame] calls when we execute the resulting - * bytecode, so there's no need to tend to TIP 280 issues. - */ - - compEnvPtr = (CompileEnv *) TclStackAlloc(interp, sizeof(CompileEnv)); - TclInitCompileEnv(interp, compEnvPtr, NULL, 0, NULL, 0); - CompileExprTree(interp, nodes, litObjv, NULL, NULL, &tmp, compEnvPtr); - TclEmitOpcode(INST_DONE, compEnvPtr); - Tcl_IncrRefCount(byteCodeObj); - TclInitByteCodeObj(byteCodeObj, compEnvPtr); - TclFreeCompileEnv(compEnvPtr); - TclStackFree(interp, compEnvPtr); - byteCodePtr = (ByteCode *) byteCodeObj->internalRep.otherValuePtr; - code = TclExecuteByteCode(interp, byteCodePtr); - Tcl_DecrRefCount(byteCodeObj); - return code; -} + +/* + *---------------------------------------------------------------------- + * + * TclSingleOpCmd -- + * Implements the commands: ~, !, <<, >>, %, !=, ne, in, ni + * in the ::tcl::mathop namespace. These commands have no + * extension to arbitrary arguments; they accept only exactly one + * or exactly two arguments as suitable for the operator. + * + * Results: + * A standard Tcl return code and result left in interp. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ int TclSingleOpCmd( @@ -2207,22 +2379,47 @@ TclSingleOpCmd( TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData; unsigned char lexeme; OpNode nodes[2]; + Tcl_Obj *const *litObjv = objv + 1; - if (objc != 1+occdPtr->numArgs) { + if (objc != 1+occdPtr->i.numArgs) { Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected); return TCL_ERROR; } ParseLexeme(occdPtr->operator, strlen(occdPtr->operator), &lexeme, NULL); nodes[0].lexeme = START; + nodes[0].mark = MARK_RIGHT; nodes[0].right = 1; nodes[1].lexeme = lexeme; - nodes[1].left = OT_LITERAL; + if (objc == 2) { + nodes[1].mark = MARK_RIGHT; + } else { + nodes[1].mark = MARK_LEFT; + nodes[1].left = OT_LITERAL; + } nodes[1].right = OT_LITERAL; nodes[1].p.parent = 0; - return OpCmd(interp, nodes, objv+1); + return ExecConstantExprTree(interp, nodes, 0, &litObjv); } + +/* + *---------------------------------------------------------------------- + * + * TclSortingOpCmd -- + * Implements the commands: <, <=, >, >=, ==, eq + * in the ::tcl::mathop namespace. These commands are defined for + * arbitrary number of arguments by computing the AND of the base + * operator applied to all neighbor argument pairs. + * + * Results: + * A standard Tcl return code and result left in interp. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ int TclSortingOpCmd( @@ -2243,20 +2440,24 @@ TclSortingOpCmd( 2*(objc-2)*sizeof(OpNode)); unsigned char lexeme; int i, lastAnd = 1; + Tcl_Obj *const *litObjPtrPtr = litObjv; ParseLexeme(occdPtr->operator, strlen(occdPtr->operator), &lexeme, NULL); litObjv[0] = objv[1]; nodes[0].lexeme = START; + nodes[0].mark = MARK_RIGHT; for (i=2; inumArgs)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(occdPtr->i.identity)); return TCL_OK; } @@ -2305,15 +2526,18 @@ TclVariadicOpCmd( Tcl_Obj *litObjv[2]; OpNode nodes[2]; int decrMe = 0; + Tcl_Obj *const *litObjPtrPtr = litObjv; if (lexeme == EXPON) { - litObjv[1] = Tcl_NewIntObj(occdPtr->numArgs); + litObjv[1] = Tcl_NewIntObj(occdPtr->i.identity); Tcl_IncrRefCount(litObjv[1]); decrMe = 1; litObjv[0] = objv[1]; nodes[0].lexeme = START; + nodes[0].mark = MARK_RIGHT; nodes[0].right = 1; nodes[1].lexeme = lexeme; + nodes[1].mark = MARK_LEFT; nodes[1].left = OT_LITERAL; nodes[1].right = OT_LITERAL; nodes[1].p.parent = 0; @@ -2321,31 +2545,36 @@ TclVariadicOpCmd( if (lexeme == DIVIDE) { litObjv[0] = Tcl_NewDoubleObj(1.0); } else { - litObjv[0] = Tcl_NewIntObj(occdPtr->numArgs); + litObjv[0] = Tcl_NewIntObj(occdPtr->i.identity); } Tcl_IncrRefCount(litObjv[0]); litObjv[1] = objv[1]; nodes[0].lexeme = START; + nodes[0].mark = MARK_RIGHT; nodes[0].right = 1; nodes[1].lexeme = lexeme; + nodes[1].mark = MARK_LEFT; nodes[1].left = OT_LITERAL; nodes[1].right = OT_LITERAL; nodes[1].p.parent = 0; } - code = OpCmd(interp, nodes, litObjv); + code = ExecConstantExprTree(interp, nodes, 0, &litObjPtrPtr); Tcl_DecrRefCount(litObjv[decrMe]); return code; } else { + Tcl_Obj *const *litObjv = objv + 1; OpNode *nodes = (OpNode *) TclStackAlloc(interp, (objc-1)*sizeof(OpNode)); int i, lastOp = OT_LITERAL; nodes[0].lexeme = START; + nodes[0].mark = MARK_RIGHT; if (lexeme == EXPON) { for (i=objc-2; i>0; i-- ) { nodes[i].lexeme = lexeme; + nodes[i].mark = MARK_LEFT; nodes[i].left = OT_LITERAL; nodes[i].right = lastOp; if (lastOp >= 0) { @@ -2356,6 +2585,7 @@ TclVariadicOpCmd( } else { for (i=1; i= 0) { nodes[lastOp].p.parent = i; @@ -2367,13 +2597,32 @@ TclVariadicOpCmd( nodes[0].right = lastOp; nodes[lastOp].p.parent = 0; - code = OpCmd(interp, nodes, objv+1); + code = ExecConstantExprTree(interp, nodes, 0, &litObjv); TclStackFree(interp, nodes); return code; } } + +/* + *---------------------------------------------------------------------- + * + * TclNoIdentOpCmd -- + * Implements the commands: -, / + * in the ::tcl::mathop namespace. These commands are defined for + * arbitrary non-zero number of arguments by repeatedly applying + * the base operator with suitable associative rules. When no + * arguments are provided, an error is raised. + * + * Results: + * A standard Tcl return code and result left in interp. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ int TclNoIdentOpCmd( diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 822efd3..45b534d 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.6 2007/07/12 14:29:54 dgp Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.117.2.7 2007/09/04 17:43:49 dgp Exp $ */ #include "tclInt.h" @@ -381,9 +381,8 @@ InstructionDesc tclInstructionTable[] = { {"variable", 5, 0, 1, {OPERAND_LVT4}}, /* finds namespace and otherName in stack, links to local variable at * index op1. Leaves the namespace on stack. */ - {"noop", 1, 0, 0, {OPERAND_NONE}}, - /* finds namespace and otherName in stack, links to local variable at - * index op1. Leaves the namespace on stack. */ + {"syntax", 9, -1, 2, {OPERAND_INT4, OPERAND_UINT4}}, + /* Compiled bytecodes to signal syntax error. */ {0} }; @@ -463,12 +462,11 @@ TclSetByteCodeFromAny( Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated * in frame. */ - LiteralTable *localTablePtr = &(compEnv.localLitTable); register AuxData *auxDataPtr; LiteralEntry *entryPtr; register int i; int length, result = TCL_OK; - char *stringPtr; + const char *stringPtr; #ifdef TCL_COMPILE_DEBUG if (!traceInitialized) { @@ -519,6 +517,7 @@ TclSetByteCodeFromAny( #ifdef TCL_COMPILE_DEBUG if (tclTraceCompile >= 2) { TclPrintByteCodeObj(interp, objPtr); + fflush(stdout); } #endif /* TCL_COMPILE_DEBUG */ @@ -545,13 +544,6 @@ TclSetByteCodeFromAny( } } - /* - * Free storage allocated during compilation. - */ - - if (localTablePtr->buckets != localTablePtr->staticBuckets) { - ckfree((char *) localTablePtr->buckets); - } TclFreeCompileEnv(&compEnv); return result; } @@ -724,8 +716,9 @@ TclCleanupByteCode( * A single heap object holds the ByteCode structure and its code, object, * command location, and auxiliary data arrays. This means we only need to * 1) decrement the ref counts of the LiteralEntry's in its literal array, - * 2) call the free procs for the auxiliary data items, and 3) free the - * ByteCode structure's heap object. + * 2) call the free procs for the auxiliary data items, 3) free the + * localCache if it is unused, and finally 4) free the ByteCode + * structure's heap object. * * The case for TCL_BYTECODE_PRECOMPILED (precompiled ByteCodes, like * those generated from tbcload) is special, as they doesn't make use of @@ -806,6 +799,10 @@ TclCleanupByteCode( } } + if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) { + TclFreeLocalCache(interp, codePtr->localCachePtr); + } + TclHandleRelease(codePtr->interpHandle); ckfree((char *) codePtr); } @@ -833,7 +830,7 @@ TclInitCompileEnv( * structure is initialized. */ register CompileEnv *envPtr,/* Points to the CompileEnv structure to * initialize. */ - char *stringPtr, /* The source string to be compiled. */ + const char *stringPtr, /* The source string to be compiled. */ int numBytes, /* Number of bytes in source string. */ const CmdFrame *invoker, /* Location context invoking the bcc */ int word) /* Index of the word in that context getting @@ -984,6 +981,10 @@ void TclFreeCompileEnv( register CompileEnv *envPtr)/* Points to the CompileEnv structure. */ { + if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets) { + ckfree((char *) envPtr->localLitTable.buckets); + envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets; + } if (envPtr->mallocedCodeArray) { ckfree((char *) envPtr->codeStart); } @@ -1157,52 +1158,14 @@ TclCompileScript( cmdLine = envPtr->line; do { if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) { - /* - * Compile bytecodes to report the parse error at runtime. - */ - Tcl_Obj *returnCmd; - Tcl_Obj *errMsg = Tcl_GetObjResult(interp); - Tcl_Obj *errInfo = Tcl_DuplicateObj(errMsg); - char *cmdString; - int cmdLength; - Tcl_Parse *subParsePtr = - (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse)); - int errorLine = 1; - - TclNewLiteralStringObj(returnCmd, - "return -code 1 -level 0 -errorinfo"); - Tcl_IncrRefCount(returnCmd); - Tcl_IncrRefCount(errInfo); - Tcl_AppendToObj(errInfo, "\n while executing\n\"", -1); - Tcl_AppendLimitedToObj(errInfo, parsePtr->commandStart, + /* Compile bytecodes to report the parse error at runtime. */ + Tcl_LogCommandInfo(interp, script, parsePtr->commandStart, /* Drop the command terminator (";","]") if appropriate */ (parsePtr->term == parsePtr->commandStart + parsePtr->commandSize - 1)? - parsePtr->commandSize - 1 : parsePtr->commandSize, 153, NULL); - Tcl_AppendToObj(errInfo, "\"", -1); - - Tcl_ListObjAppendElement(NULL, returnCmd, errInfo); - - for (p = envPtr->source; p != parsePtr->commandStart; p++) { - if (*p == '\n') { - errorLine++; - } - } - Tcl_ListObjAppendElement(NULL, returnCmd, - Tcl_NewStringObj("-errorline", -1)); - Tcl_ListObjAppendElement(NULL, returnCmd, - Tcl_NewIntObj(errorLine)); - - Tcl_ListObjAppendElement(NULL, returnCmd, errMsg); - Tcl_DecrRefCount(errInfo); - - cmdString = Tcl_GetStringFromObj(returnCmd, &cmdLength); - Tcl_ParseCommand(interp, cmdString, cmdLength, 0, subParsePtr); - TclCompileReturnCmd(interp, subParsePtr, envPtr); - Tcl_DecrRefCount(returnCmd); - Tcl_FreeParse(subParsePtr); - TclStackFree(interp, subParsePtr); + parsePtr->commandSize - 1 : parsePtr->commandSize); + TclCompileSyntaxError(interp, envPtr); break; } gotParse = 1; @@ -1657,7 +1620,7 @@ TclCompileTokens( localVar = -1; if (localVarName != -1) { localVar = TclFindCompiledLocal(name, nameBytes, localVarName, - /*flags*/ 0, envPtr->procPtr); + envPtr->procPtr); } if (localVar < 0) { TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameBytes), @@ -1822,17 +1785,8 @@ TclCompileExprWords( */ if ((numWords == 1) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) { - const char *script = tokenPtr[1].start; - int numBytes = tokenPtr[1].size; - int savedNumCmds = envPtr->numCommands; - unsigned int savedCodeNext = envPtr->codeNext - envPtr->codeStart; - - if (TclCompileExpr(interp, script, numBytes, envPtr) == TCL_OK) { - return; - } - Tcl_ResetResult(interp); - envPtr->numCommands = savedNumCmds; - envPtr->codeNext = envPtr->codeStart + savedCodeNext; + TclCompileExpr(interp, tokenPtr[1].start, tokenPtr[1].size, envPtr); + return; } /* @@ -2066,6 +2020,8 @@ TclInitByteCodeObj( Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->lineBCPtr, (char *) codePtr, &new), envPtr->extCmdMapPtr); envPtr->extCmdMapPtr = NULL; + + codePtr->localCachePtr = NULL; } /* @@ -2101,9 +2057,6 @@ TclFindCompiledLocal( int nameBytes, /* Number of bytes in the name. */ int create, /* If 1, allocate a local frame entry for the * variable if it is new. */ - int flags, /* Flag bits for the compiled local if - * created. Only VAR_SCALAR, VAR_ARRAY, and - * VAR_LINK make sense. */ register Proc *procPtr) /* Points to structure describing procedure * containing the variable reference. */ { @@ -2151,7 +2104,7 @@ TclFindCompiledLocal( localPtr->nextPtr = NULL; localPtr->nameLength = nameBytes; localPtr->frameIndex = localVar; - localPtr->flags = flags | VAR_UNDEFINED; + localPtr->flags = 0; if (name == NULL) { localPtr->flags |= VAR_TEMPORARY; } @@ -2793,10 +2746,10 @@ TclFixupForwardJump( TclExpandCodeArray(envPtr); } jumpPc = (envPtr->codeStart + jumpFixupPtr->codeOffset); - for (numBytes = envPtr->codeNext-jumpPc-2, p = jumpPc+2+numBytes-1; - numBytes > 0; numBytes--, p--) { - p[3] = p[0]; - } + numBytes = envPtr->codeNext-jumpPc-2; + p = jumpPc+2; + memmove(p+3, p, numBytes); + envPtr->codeNext += 3; jumpDist += 3; switch (jumpFixupPtr->jumpType) { @@ -3317,7 +3270,7 @@ TclPrintByteCodeObj( CompiledLocal *localPtr = procPtr->firstLocalPtr; for (i = 0; i < numCompiledLocals; i++) { fprintf(stdout, " slot %d%s%s%s%s%s%s", i, - (localPtr->flags & VAR_SCALAR) ? ", scalar" : "", + (localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar", (localPtr->flags & VAR_ARRAY) ? ", array" : "", (localPtr->flags & VAR_LINK) ? ", link" : "", (localPtr->flags & VAR_ARGUMENT) ? ", arg" : "", diff --git a/generic/tclCompile.h b/generic/tclCompile.h index f2f7814..9e65d45 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -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: tclCompile.h,v 1.70.2.4 2007/06/21 16:04:56 dgp Exp $ + * RCS: @(#) $Id: tclCompile.h,v 1.70.2.5 2007/09/04 17:43:50 dgp Exp $ */ #ifndef _TCLCOMPILATION @@ -215,7 +215,7 @@ typedef struct CompileEnv { * compiled. Commands and their compile procs * are specific to an interpreter so the code * emitted will depend on the interpreter. */ - char *source; /* The source string being compiled by + const char *source; /* The source string being compiled by * SetByteCodeFromAny. This pointer is not * owned by the CompileEnv and must not be * freed or changed by it. */ @@ -346,7 +346,7 @@ typedef struct ByteCode { unsigned int flags; /* flags describing state for the codebyte. * this variable holds ORed values from the * TCL_BYTECODE_ masks defined above */ - char *source; /* The source string from which this ByteCode + const char *source; /* The source string from which this ByteCode * was compiled. Note that this pointer is not * owned by the ByteCode and must not be freed * or modified by it. */ @@ -416,6 +416,9 @@ typedef struct ByteCode { * code deltas. Source lengths are always * positive. This sequence is just after the * last byte in the source delta sequence. */ + LocalCache *localCachePtr; /* Pointer to the start of the cached variable + * names and initialisation data for local + * variables. */ #ifdef TCL_COMPILE_STATS Tcl_Time createTime; /* Absolute time when the ByteCode was * created. */ @@ -623,8 +626,12 @@ typedef struct ByteCode { #define INST_NSUPVAR 123 #define INST_VARIABLE 124 +/* Instruction to support compiling syntax error to bytecode */ + +#define INST_SYNTAX 125 + /* The last opcode */ -#define LAST_INST_OPCODE 124 +#define LAST_INST_OPCODE 125 /* * Table describing the Tcl bytecode instructions: their name (for displaying @@ -796,7 +803,10 @@ MODULE_SCOPE AuxDataType tclDictUpdateInfoType; typedef struct { const char *operator; const char *expected; - int numArgs; + union { + int numArgs; + int identity; + } i; } TclOpCmdClientData; /* @@ -831,7 +841,7 @@ MODULE_SCOPE void TclCleanupByteCode(ByteCode *codePtr); MODULE_SCOPE void TclCompileCmdWord(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, CompileEnv *envPtr); -MODULE_SCOPE int TclCompileExpr(Tcl_Interp *interp, CONST char *script, +MODULE_SCOPE void TclCompileExpr(Tcl_Interp *interp, CONST char *script, int numBytes, CompileEnv *envPtr); MODULE_SCOPE void TclCompileExprWords(Tcl_Interp *interp, Tcl_Token *tokenPtr, int numWords, @@ -839,6 +849,8 @@ MODULE_SCOPE void TclCompileExprWords(Tcl_Interp *interp, MODULE_SCOPE void TclCompileScript(Tcl_Interp *interp, CONST char *script, int numBytes, CompileEnv *envPtr); +MODULE_SCOPE void TclCompileSyntaxError(Tcl_Interp *interp, + CompileEnv *envPtr); MODULE_SCOPE void TclCompileTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, CompileEnv *envPtr); @@ -847,6 +859,10 @@ MODULE_SCOPE int TclCreateAuxData(ClientData clientData, MODULE_SCOPE int TclCreateExceptRange(ExceptionRangeType type, CompileEnv *envPtr); MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp); +MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, char *bytes, + int length, unsigned int hash, int *newPtr, + Namespace *nsPtr, int flags, + LiteralEntry **globalPtrPtr); MODULE_SCOPE void TclDeleteExecEnv(ExecEnv *eePtr); MODULE_SCOPE void TclDeleteLiteralTable(Tcl_Interp *interp, LiteralTable *tablePtr); @@ -859,7 +875,7 @@ MODULE_SCOPE int TclExecuteByteCode(Tcl_Interp *interp, ByteCode *codePtr); MODULE_SCOPE void TclFinalizeAuxDataTypeTable(void); MODULE_SCOPE int TclFindCompiledLocal(CONST char *name, int nameChars, - int create, int flags, Proc *procPtr); + int create, Proc *procPtr); MODULE_SCOPE LiteralEntry * TclLookupLiteralEntry(Tcl_Interp *interp, Tcl_Obj *objPtr); MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr, @@ -872,8 +888,8 @@ MODULE_SCOPE void TclInitByteCodeObj(Tcl_Obj *objPtr, CompileEnv *envPtr); MODULE_SCOPE void TclInitCompilation(void); MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp, - CompileEnv *envPtr, char *string, int numBytes, - CONST CmdFrame* invoker, int word); + CompileEnv *envPtr, const char *string, + int numBytes, CONST CmdFrame* invoker, int word); MODULE_SCOPE void TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr); MODULE_SCOPE void TclInitLiteralTable(LiteralTable *tablePtr); #ifdef TCL_COMPILE_STATS diff --git a/generic/tclDate.c b/generic/tclDate.c index 05f6d44..0bd48c8 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -1,7 +1,9 @@ -/* A Bison parser, made by GNU Bison 1.875e. */ +/* A Bison parser, made by GNU Bison 2.3. */ -/* Skeleton parser for Yacc-like parsing with Bison, - Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. +/* Skeleton implementation for Bison's Yacc-like parsers in C + + Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006 + Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -15,16 +17,24 @@ You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software - Foundation, Inc., 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. */ + Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + +/* As a special exception, you may create a larger work that contains + part or all of the Bison parser skeleton and distribute that work + under terms of your choice, so long as that work isn't itself a + parser generator using the skeleton or a modified version thereof + as a parser skeleton. Alternatively, if you modify or redistribute + the parser skeleton itself, you may (at your option) remove this + special exception, which will cause the skeleton and the resulting + Bison output files to be licensed under the GNU General Public + License without this special exception. -/* As a special exception, when this file is copied by Bison into a - Bison output file, you may use that output file without restriction. - This special exception was added by the Free Software Foundation - in version 1.24 of Bison. */ + This special exception was added by the Free Software Foundation in + version 2.2 of Bison. */ -/* Written by Richard Stallman by simplifying the original so called - ``semantic'' parser. */ +/* C LALR(1) parser skeleton written by Richard Stallman, by + simplifying the original so-called "semantic" parser. */ /* All symbols defined below should begin with yy or YY, to avoid infringing on user name space. This should be done even for local @@ -36,6 +46,9 @@ /* Identify Bison output. */ #define YYBISON 1 +/* Bison version. */ +#define YYBISON_VERSION "2.3" + /* Skeleton name. */ #define YYSKELETON_NAME "yacc.c" @@ -45,8 +58,7 @@ /* Using locations. */ #define YYLSP_NEEDED 0 -/* If NAME_PREFIX is specified substitute the variables and functions - names. */ +/* Substitute the variable and function names. */ #define yyparse TclDateparse #define yylex TclDatelex #define yyerror TclDateerror @@ -82,6 +94,7 @@ tNEXT = 275 }; #endif +/* Tokens. */ #define tAGO 258 #define tDAY 259 #define tDAYZONE 260 @@ -175,7 +188,7 @@ typedef struct DateInfo { #define YYLEX_PARAM info #define YYMALLOC ckalloc -#define YYFREE ckfree +#define YYFREE(x) (ckfree((void*) (x))) #define yyDSTmode (((DateInfo *) info)->dateDSTmode) #define yyDayOrdinal (((DateInfo *) info)->dateDayOrdinal) @@ -269,14 +282,21 @@ MODULE_SCOPE int yyparse(void *); # define YYERROR_VERBOSE 0 #endif -#if ! defined (YYSTYPE) && ! defined (YYSTYPE_IS_DECLARED) +/* Enabling the token table. */ +#ifndef YYTOKEN_TABLE +# define YYTOKEN_TABLE 0 +#endif + +#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED +typedef union YYSTYPE -typedef union YYSTYPE { +{ time_t Number; enum _MERIDIAN Meridian; -} YYSTYPE; -/* Line 191 of yacc.c. */ +} +/* Line 187 of yacc.c. */ + YYSTYPE; # define yystype YYSTYPE /* obsolescent; will be withdrawn */ # define YYSTYPE_IS_DECLARED 1 # define YYSTYPE_IS_TRIVIAL 1 @@ -287,56 +307,171 @@ typedef union YYSTYPE { /* Copy the second part of user declarations. */ -/* Line 214 of yacc.c. */ +/* Line 216 of yacc.c. */ -#if ! defined (yyoverflow) || YYERROR_VERBOSE +#ifdef short +# undef short +#endif + +#ifdef YYTYPE_UINT8 +typedef YYTYPE_UINT8 yytype_uint8; +#else +typedef unsigned char yytype_uint8; +#endif -# ifndef YYFREE -# define YYFREE free +#ifdef YYTYPE_INT8 +typedef YYTYPE_INT8 yytype_int8; +#elif (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +typedef signed char yytype_int8; +#else +typedef short int yytype_int8; +#endif + +#ifdef YYTYPE_UINT16 +typedef YYTYPE_UINT16 yytype_uint16; +#else +typedef unsigned short int yytype_uint16; +#endif + +#ifdef YYTYPE_INT16 +typedef YYTYPE_INT16 yytype_int16; +#else +typedef short int yytype_int16; +#endif + +#ifndef YYSIZE_T +# ifdef __SIZE_TYPE__ +# define YYSIZE_T __SIZE_TYPE__ +# elif defined size_t +# define YYSIZE_T size_t +# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +# include /* INFRINGES ON USER NAME SPACE */ +# define YYSIZE_T size_t +# else +# define YYSIZE_T unsigned int # endif -# ifndef YYMALLOC -# define YYMALLOC malloc +#endif + +#define YYSIZE_MAXIMUM ((YYSIZE_T) -1) + +#ifndef YY_ +# if YYENABLE_NLS +# if ENABLE_NLS +# include /* INFRINGES ON USER NAME SPACE */ +# define YY_(msgid) dgettext ("bison-runtime", msgid) +# endif +# endif +# ifndef YY_ +# define YY_(msgid) msgid # endif +#endif + +/* Suppress unused-variable warnings by "using" E. */ +#if ! defined lint || defined __GNUC__ +# define YYUSE(e) ((void) (e)) +#else +# define YYUSE(e) /* empty */ +#endif + +/* Identity function, used to suppress warnings about constant conditions. */ +#ifndef lint +# define YYID(n) (n) +#else +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static int +YYID (int i) +#else +static int +YYID (i) + int i; +#endif +{ + return i; +} +#endif + +#if ! defined yyoverflow || YYERROR_VERBOSE /* The parser invokes alloca or malloc; define the necessary symbols. */ # ifdef YYSTACK_USE_ALLOCA # if YYSTACK_USE_ALLOCA -# define YYSTACK_ALLOC alloca -# endif -# else -# if defined (alloca) || defined (_ALLOCA_H) -# define YYSTACK_ALLOC alloca -# else # ifdef __GNUC__ # define YYSTACK_ALLOC __builtin_alloca +# elif defined __BUILTIN_VA_ARG_INCR +# include /* INFRINGES ON USER NAME SPACE */ +# elif defined _AIX +# define YYSTACK_ALLOC __alloca +# elif defined _MSC_VER +# include /* INFRINGES ON USER NAME SPACE */ +# define alloca _alloca +# else +# define YYSTACK_ALLOC alloca +# if ! defined _ALLOCA_H && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +# include /* INFRINGES ON USER NAME SPACE */ +# ifndef _STDLIB_H +# define _STDLIB_H 1 +# endif +# endif # endif # endif # endif # ifdef YYSTACK_ALLOC - /* Pacify GCC's `empty if-body' warning. */ -# define YYSTACK_FREE(Ptr) do { /* empty */; } while (0) -# else -# if defined (__STDC__) || defined (__cplusplus) -# include /* INFRINGES ON USER NAME SPACE */ -# define YYSIZE_T size_t + /* Pacify GCC's `empty if-body' warning. */ +# define YYSTACK_FREE(Ptr) do { /* empty */; } while (YYID (0)) +# ifndef YYSTACK_ALLOC_MAXIMUM + /* The OS might guarantee only one guard page at the bottom of the stack, + and a page size can be as small as 4096 bytes. So we cannot safely + invoke alloca (N) if N exceeds 4096. Use a slightly smaller number + to allow for a few compiler-allocated temporary stack slots. */ +# define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */ # endif +# else # define YYSTACK_ALLOC YYMALLOC # define YYSTACK_FREE YYFREE +# ifndef YYSTACK_ALLOC_MAXIMUM +# define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM +# endif +# if (defined __cplusplus && ! defined _STDLIB_H \ + && ! ((defined YYMALLOC || defined malloc) \ + && (defined YYFREE || defined free))) +# include /* INFRINGES ON USER NAME SPACE */ +# ifndef _STDLIB_H +# define _STDLIB_H 1 +# endif +# endif +# ifndef YYMALLOC +# define YYMALLOC malloc +# if ! defined malloc && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */ +# endif +# endif +# ifndef YYFREE +# define YYFREE free +# if ! defined free && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +void free (void *); /* INFRINGES ON USER NAME SPACE */ +# endif +# endif # endif -#endif /* ! defined (yyoverflow) || YYERROR_VERBOSE */ +#endif /* ! defined yyoverflow || YYERROR_VERBOSE */ -#if (! defined (yyoverflow) \ - && (! defined (__cplusplus) \ - || (defined (YYSTYPE_IS_TRIVIAL) && YYSTYPE_IS_TRIVIAL))) +#if (! defined yyoverflow \ + && (! defined __cplusplus \ + || (defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL))) /* A type that is properly aligned for any stack member. */ union yyalloc { - short int yyss; + yytype_int16 yyss; YYSTYPE yyvs; }; @@ -346,24 +481,24 @@ union yyalloc /* The size of an array large to enough to hold all stacks, each with N elements. */ # define YYSTACK_BYTES(N) \ - ((N) * (sizeof (short int) + sizeof (YYSTYPE)) \ + ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE)) \ + YYSTACK_GAP_MAXIMUM) /* Copy COUNT objects from FROM to TO. The source and destination do not overlap. */ # ifndef YYCOPY -# if defined (__GNUC__) && 1 < __GNUC__ +# if defined __GNUC__ && 1 < __GNUC__ # define YYCOPY(To, From, Count) \ __builtin_memcpy (To, From, (Count) * sizeof (*(From))) # else # define YYCOPY(To, From, Count) \ do \ { \ - register YYSIZE_T yyi; \ + YYSIZE_T yyi; \ for (yyi = 0; yyi < (Count); yyi++) \ (To)[yyi] = (From)[yyi]; \ } \ - while (0) + while (YYID (0)) # endif # endif @@ -381,39 +516,33 @@ union yyalloc yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \ yyptr += yynewbytes / sizeof (*yyptr); \ } \ - while (0) + while (YYID (0)) #endif -#if defined (__STDC__) || defined (__cplusplus) - typedef signed char yysigned_char; -#else - typedef short int yysigned_char; -#endif - -/* YYFINAL -- State number of the termination state. */ +/* YYFINAL -- State number of the termination state. */ #define YYFINAL 2 /* YYLAST -- Last index in YYTABLE. */ #define YYLAST 79 -/* YYNTOKENS -- Number of terminals. */ +/* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 27 -/* YYNNTS -- Number of nonterminals. */ +/* YYNNTS -- Number of nonterminals. */ #define YYNNTS 16 -/* YYNRULES -- Number of rules. */ +/* YYNRULES -- Number of rules. */ #define YYNRULES 56 -/* YYNRULES -- Number of states. */ +/* YYNRULES -- Number of states. */ #define YYNSTATES 83 /* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX. */ #define YYUNDEFTOK 2 #define YYMAXUTOK 275 -#define YYTRANSLATE(YYX) \ +#define YYTRANSLATE(YYX) \ ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK) /* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX. */ -static const unsigned char yytranslate[] = +static const yytype_uint8 yytranslate[] = { 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -448,7 +577,7 @@ static const unsigned char yytranslate[] = #if YYDEBUG /* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in YYRHS. */ -static const unsigned char yyprhs[] = +static const yytype_uint8 yyprhs[] = { 0, 0, 3, 4, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 28, 33, 39, 46, 54, 57, @@ -458,8 +587,8 @@ static const unsigned char yyprhs[] = 167, 169, 171, 173, 175, 177, 178 }; -/* YYRHS -- A `-1'-separated list of the rules' RHS. */ -static const yysigned_char yyrhs[] = +/* YYRHS -- A `-1'-separated list of the rules' RHS. */ +static const yytype_int8 yyrhs[] = { 28, 0, -1, -1, 28, 29, -1, 30, -1, 31, -1, 33, -1, 34, -1, 32, -1, 37, -1, 35, @@ -482,7 +611,7 @@ static const yysigned_char yyrhs[] = }; /* YYRLINE[YYN] -- source line where rule number YYN was defined. */ -static const unsigned short int yyrline[] = +static const yytype_uint16 yyrline[] = { 0, 185, 185, 186, 189, 192, 195, 198, 201, 204, 207, 211, 216, 219, 225, 231, 239, 245, 256, 260, @@ -493,9 +622,9 @@ static const unsigned short int yyrline[] = }; #endif -#if YYDEBUG || YYERROR_VERBOSE -/* YYTNME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM. - First, the terminals, then, starting at YYNTOKENS, nonterminals. */ +#if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE +/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM. + First, the terminals, then, starting at YYNTOKENS, nonterminals. */ static const char *const yytname[] = { "$end", "error", "$undefined", "tAGO", "tDAY", "tDAYZONE", "tID", @@ -511,7 +640,7 @@ static const char *const yytname[] = # ifdef YYPRINT /* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to token YYLEX-NUM. */ -static const unsigned short int yytoknum[] = +static const yytype_uint16 yytoknum[] = { 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, 271, 272, 273, 274, @@ -520,7 +649,7 @@ static const unsigned short int yytoknum[] = # endif /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ -static const unsigned char yyr1[] = +static const yytype_uint8 yyr1[] = { 0, 27, 28, 28, 29, 29, 29, 29, 29, 29, 29, 29, 29, 30, 30, 30, 30, 30, 31, 31, @@ -531,7 +660,7 @@ static const unsigned char yyr1[] = }; /* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN. */ -static const unsigned char yyr2[] = +static const yytype_uint8 yyr2[] = { 0, 2, 0, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 4, 5, 6, 7, 2, 1, @@ -544,7 +673,7 @@ static const unsigned char yyr2[] = /* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state STATE-NUM when YYTABLE doesn't specify something else to do. Zero means the default is an error. */ -static const unsigned char yydefact[] = +static const yytype_uint8 yydefact[] = { 2, 0, 1, 21, 20, 0, 53, 0, 51, 54, 19, 34, 28, 52, 0, 49, 50, 3, 4, 5, @@ -557,8 +686,8 @@ static const unsigned char yydefact[] = 0, 17, 39 }; -/* YYDEFGOTO[NTERM-NUM]. */ -static const yysigned_char yydefgoto[] = +/* YYDEFGOTO[NTERM-NUM]. */ +static const yytype_int8 yydefgoto[] = { -1, 1, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 67 @@ -567,7 +696,7 @@ static const yysigned_char yydefgoto[] = /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing STATE-NUM. */ #define YYPACT_NINF -23 -static const yysigned_char yypact[] = +static const yytype_int8 yypact[] = { -23, 2, -23, -22, -23, -5, -23, -4, -23, 22, -2, -23, 12, -23, 38, -23, -23, -23, -23, -23, @@ -581,7 +710,7 @@ static const yysigned_char yypact[] = }; /* YYPGOTO[NTERM-NUM]. */ -static const yysigned_char yypgoto[] = +static const yytype_int8 yypgoto[] = { -23, -23, -23, -23, -23, -23, -23, -23, -23, -23, -23, -23, -23, -9, -23, 7 @@ -592,7 +721,7 @@ static const yysigned_char yypgoto[] = number is the opposite. If zero, do what YYDEFACT says. If YYTABLE_NINF, syntax error. */ #define YYTABLE_NINF -1 -static const unsigned char yytable[] = +static const yytype_uint8 yytable[] = { 39, 30, 2, 53, 64, 46, 3, 4, 54, 31, 32, 5, 6, 7, 8, 40, 9, 10, 11, 78, @@ -604,7 +733,7 @@ static const unsigned char yytable[] = 74, 69, 71, 75, 76, 77, 81, 82, 80, 79 }; -static const unsigned char yycheck[] = +static const yytype_uint8 yycheck[] = { 9, 23, 0, 9, 7, 14, 4, 5, 14, 14, 14, 9, 10, 11, 12, 17, 14, 15, 16, 22, @@ -618,7 +747,7 @@ static const unsigned char yycheck[] = /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing symbol of state STATE-NUM. */ -static const unsigned char yystos[] = +static const yytype_uint8 yystos[] = { 0, 28, 0, 4, 5, 9, 10, 11, 12, 14, 15, 16, 18, 19, 20, 22, 26, 29, 30, 31, @@ -631,22 +760,6 @@ static const unsigned char yystos[] = 21, 14, 14 }; -#if ! defined (YYSIZE_T) && defined (__SIZE_TYPE__) -# define YYSIZE_T __SIZE_TYPE__ -#endif -#if ! defined (YYSIZE_T) && defined (size_t) -# define YYSIZE_T size_t -#endif -#if ! defined (YYSIZE_T) -# if defined (__STDC__) || defined (__cplusplus) -# include /* INFRINGES ON USER NAME SPACE */ -# define YYSIZE_T size_t -# endif -#endif -#if ! defined (YYSIZE_T) -# define YYSIZE_T unsigned int -#endif - #define yyerrok (yyerrstatus = 0) #define yyclearin (yychar = YYEMPTY) #define YYEMPTY (-2) @@ -672,15 +785,15 @@ do \ yychar = (Token); \ yylval = (Value); \ yytoken = YYTRANSLATE (yychar); \ - YYPOPSTACK; \ + YYPOPSTACK (1); \ goto yybackup; \ } \ else \ - { \ - yyerror ("syntax error: cannot back up");\ + { \ + yyerror (YY_("syntax error: cannot back up")); \ YYERROR; \ } \ -while (0) +while (YYID (0)) #define YYTERROR 1 @@ -691,22 +804,25 @@ while (0) If N is 0, then set CURRENT to the empty location which ends the previous symbol: RHS[0] (always defined). */ +#define YYRHSLOC(Rhs, K) ((Rhs)[K]) #ifndef YYLLOC_DEFAULT -# define YYLLOC_DEFAULT(Current, Rhs, N) \ -do { \ - if (N) \ - { \ - (Current).first_line = (Rhs)[1].first_line; \ - (Current).first_column = (Rhs)[1].first_column; \ - (Current).last_line = (Rhs)[N].last_line; \ - (Current).last_column = (Rhs)[N].last_column; \ - } \ - else \ - { \ - (Current).first_line = (Current).last_line = (Rhs)[0].last_line; \ - (Current).first_column = (Current).last_column = (Rhs)[0].last_column; \ - } \ -} while(0) +# define YYLLOC_DEFAULT(Current, Rhs, N) \ + do \ + if (YYID (N)) \ + { \ + (Current).first_line = YYRHSLOC (Rhs, 1).first_line; \ + (Current).first_column = YYRHSLOC (Rhs, 1).first_column; \ + (Current).last_line = YYRHSLOC (Rhs, N).last_line; \ + (Current).last_column = YYRHSLOC (Rhs, N).last_column; \ + } \ + else \ + { \ + (Current).first_line = (Current).last_line = \ + YYRHSLOC (Rhs, 0).last_line; \ + (Current).first_column = (Current).last_column = \ + YYRHSLOC (Rhs, 0).last_column; \ + } \ + while (YYID (0)) #endif @@ -718,8 +834,8 @@ do { \ # if YYLTYPE_IS_TRIVIAL # define YY_LOCATION_PRINT(File, Loc) \ fprintf (File, "%d.%d-%d.%d", \ - (Loc).first_line, (Loc).first_column, \ - (Loc).last_line, (Loc).last_column) + (Loc).first_line, (Loc).first_column, \ + (Loc).last_line, (Loc).last_column) # else # define YY_LOCATION_PRINT(File, Loc) ((void) 0) # endif @@ -746,36 +862,96 @@ do { \ do { \ if (yydebug) \ YYFPRINTF Args; \ -} while (0) +} while (YYID (0)) -# define YY_SYMBOL_PRINT(Title, Type, Value, Location) \ -do { \ - if (yydebug) \ - { \ - YYFPRINTF (stderr, "%s ", Title); \ - yysymprint (stderr, \ - Type, Value); \ - YYFPRINTF (stderr, "\n"); \ - } \ -} while (0) +# define YY_SYMBOL_PRINT(Title, Type, Value, Location) \ +do { \ + if (yydebug) \ + { \ + YYFPRINTF (stderr, "%s ", Title); \ + yy_symbol_print (stderr, \ + Type, Value); \ + YYFPRINTF (stderr, "\n"); \ + } \ +} while (YYID (0)) + + +/*--------------------------------. +| Print this symbol on YYOUTPUT. | +`--------------------------------*/ + +/*ARGSUSED*/ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static void +yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep) +#else +static void +yy_symbol_value_print (yyoutput, yytype, yyvaluep) + FILE *yyoutput; + int yytype; + YYSTYPE const * const yyvaluep; +#endif +{ + if (!yyvaluep) + return; +# ifdef YYPRINT + if (yytype < YYNTOKENS) + YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep); +# else + YYUSE (yyoutput); +# endif + switch (yytype) + { + default: + break; + } +} + + +/*--------------------------------. +| Print this symbol on YYOUTPUT. | +`--------------------------------*/ + +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static void +yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep) +#else +static void +yy_symbol_print (yyoutput, yytype, yyvaluep) + FILE *yyoutput; + int yytype; + YYSTYPE const * const yyvaluep; +#endif +{ + if (yytype < YYNTOKENS) + YYFPRINTF (yyoutput, "token %s (", yytname[yytype]); + else + YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]); + + yy_symbol_value_print (yyoutput, yytype, yyvaluep); + YYFPRINTF (yyoutput, ")"); +} /*------------------------------------------------------------------. | yy_stack_print -- Print the state stack from its BOTTOM up to its | | TOP (included). | `------------------------------------------------------------------*/ -#if defined (__STDC__) || defined (__cplusplus) +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) static void -yy_stack_print (short int *bottom, short int *top) +yy_stack_print (yytype_int16 *bottom, yytype_int16 *top) #else static void yy_stack_print (bottom, top) - short int *bottom; - short int *top; + yytype_int16 *bottom; + yytype_int16 *top; #endif { YYFPRINTF (stderr, "Stack now"); - for (/* Nothing. */; bottom <= top; ++bottom) + for (; bottom <= top; ++bottom) YYFPRINTF (stderr, " %d", *bottom); YYFPRINTF (stderr, "\n"); } @@ -784,37 +960,45 @@ yy_stack_print (bottom, top) do { \ if (yydebug) \ yy_stack_print ((Bottom), (Top)); \ -} while (0) +} while (YYID (0)) /*------------------------------------------------. | Report that the YYRULE is going to be reduced. | `------------------------------------------------*/ -#if defined (__STDC__) || defined (__cplusplus) +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) static void -yy_reduce_print (int yyrule) +yy_reduce_print (YYSTYPE *yyvsp, int yyrule) #else static void -yy_reduce_print (yyrule) +yy_reduce_print (yyvsp, yyrule) + YYSTYPE *yyvsp; int yyrule; #endif { + int yynrhs = yyr2[yyrule]; int yyi; - unsigned int yylno = yyrline[yyrule]; - YYFPRINTF (stderr, "Reducing stack by rule %d (line %u), ", - yyrule - 1, yylno); - /* Print the symbols being reduced, and their result. */ - for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++) - YYFPRINTF (stderr, "%s ", yytname [yyrhs[yyi]]); - YYFPRINTF (stderr, "-> %s\n", yytname [yyr1[yyrule]]); + unsigned long int yylno = yyrline[yyrule]; + YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n", + yyrule - 1, yylno); + /* The symbols being reduced. */ + for (yyi = 0; yyi < yynrhs; yyi++) + { + fprintf (stderr, " $%d = ", yyi + 1); + yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi], + &(yyvsp[(yyi + 1) - (yynrhs)]) + ); + fprintf (stderr, "\n"); + } } # define YY_REDUCE_PRINT(Rule) \ do { \ if (yydebug) \ - yy_reduce_print (Rule); \ -} while (0) + yy_reduce_print (yyvsp, Rule); \ +} while (YYID (0)) /* Nonzero means print parse trace. It is left uninitialized so that multiple parsers can coexist. */ @@ -836,13 +1020,9 @@ int yydebug; if the built-in stack extension method is used). Do not make this value too large; the results are undefined if - SIZE_MAX < YYSTACK_BYTES (YYMAXDEPTH) + YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH) evaluated with infinite-precision integer arithmetic. */ -#if defined (YYMAXDEPTH) && YYMAXDEPTH == 0 -# undef YYMAXDEPTH -#endif - #ifndef YYMAXDEPTH # define YYMAXDEPTH 10000 #endif @@ -852,45 +1032,47 @@ int yydebug; #if YYERROR_VERBOSE # ifndef yystrlen -# if defined (__GLIBC__) && defined (_STRING_H) +# if defined __GLIBC__ && defined _STRING_H # define yystrlen strlen # else /* Return the length of YYSTR. */ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) static YYSIZE_T -# if defined (__STDC__) || defined (__cplusplus) yystrlen (const char *yystr) -# else +#else +static YYSIZE_T yystrlen (yystr) - const char *yystr; -# endif + const char *yystr; +#endif { - register const char *yys = yystr; - - while (*yys++ != '\0') + YYSIZE_T yylen; + for (yylen = 0; yystr[yylen]; yylen++) continue; - - return yys - yystr - 1; + return yylen; } # endif # endif # ifndef yystpcpy -# if defined (__GLIBC__) && defined (_STRING_H) && defined (_GNU_SOURCE) +# if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE # define yystpcpy stpcpy # else /* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in YYDEST. */ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) static char * -# if defined (__STDC__) || defined (__cplusplus) yystpcpy (char *yydest, const char *yysrc) -# else +#else +static char * yystpcpy (yydest, yysrc) - char *yydest; - const char *yysrc; -# endif + char *yydest; + const char *yysrc; +#endif { - register char *yyd = yydest; - register const char *yys = yysrc; + char *yyd = yydest; + const char *yys = yysrc; while ((*yyd++ = *yys++) != '\0') continue; @@ -900,53 +1082,171 @@ yystpcpy (yydest, yysrc) # endif # endif -#endif /* !YYERROR_VERBOSE */ +# ifndef yytnamerr +/* Copy to YYRES the contents of YYSTR after stripping away unnecessary + quotes and backslashes, so that it's suitable for yyerror. The + heuristic is that double-quoting is unnecessary unless the string + contains an apostrophe, a comma, or backslash (other than + backslash-backslash). YYSTR is taken from yytname. If YYRES is + null, do not copy; instead, return the length of what the result + would have been. */ +static YYSIZE_T +yytnamerr (char *yyres, const char *yystr) +{ + if (*yystr == '"') + { + YYSIZE_T yyn = 0; + char const *yyp = yystr; + + for (;;) + switch (*++yyp) + { + case '\'': + case ',': + goto do_not_strip_quotes; + + case '\\': + if (*++yyp != '\\') + goto do_not_strip_quotes; + /* Fall through. */ + default: + if (yyres) + yyres[yyn] = *yyp; + yyn++; + break; + + case '"': + if (yyres) + yyres[yyn] = '\0'; + return yyn; + } + do_not_strip_quotes: ; + } - + if (! yyres) + return yystrlen (yystr); -#if YYDEBUG -/*--------------------------------. -| Print this symbol on YYOUTPUT. | -`--------------------------------*/ + return yystpcpy (yyres, yystr) - yyres; +} +# endif -#if defined (__STDC__) || defined (__cplusplus) -static void -yysymprint (FILE *yyoutput, int yytype, YYSTYPE *yyvaluep) -#else -static void -yysymprint (yyoutput, yytype, yyvaluep) - FILE *yyoutput; - int yytype; - YYSTYPE *yyvaluep; -#endif +/* Copy into YYRESULT an error message about the unexpected token + YYCHAR while in state YYSTATE. Return the number of bytes copied, + including the terminating null byte. If YYRESULT is null, do not + copy anything; just return the number of bytes that would be + copied. As a special case, return 0 if an ordinary "syntax error" + message will do. Return YYSIZE_MAXIMUM if overflow occurs during + size calculation. */ +static YYSIZE_T +yysyntax_error (char *yyresult, int yystate, int yychar) { - /* Pacify ``unused variable'' warnings. */ - (void) yyvaluep; + int yyn = yypact[yystate]; - if (yytype < YYNTOKENS) - YYFPRINTF (yyoutput, "token %s (", yytname[yytype]); + if (! (YYPACT_NINF < yyn && yyn <= YYLAST)) + return 0; else - YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]); - - -# ifdef YYPRINT - if (yytype < YYNTOKENS) - YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep); -# endif - switch (yytype) { - default: - break; + int yytype = YYTRANSLATE (yychar); + YYSIZE_T yysize0 = yytnamerr (0, yytname[yytype]); + YYSIZE_T yysize = yysize0; + YYSIZE_T yysize1; + int yysize_overflow = 0; + enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 }; + char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM]; + int yyx; + +# if 0 + /* This is so xgettext sees the translatable formats that are + constructed on the fly. */ + YY_("syntax error, unexpected %s"); + YY_("syntax error, unexpected %s, expecting %s"); + YY_("syntax error, unexpected %s, expecting %s or %s"); + YY_("syntax error, unexpected %s, expecting %s or %s or %s"); + YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s"); +# endif + char *yyfmt; + char const *yyf; + static char const yyunexpected[] = "syntax error, unexpected %s"; + static char const yyexpecting[] = ", expecting %s"; + static char const yyor[] = " or %s"; + char yyformat[sizeof yyunexpected + + sizeof yyexpecting - 1 + + ((YYERROR_VERBOSE_ARGS_MAXIMUM - 2) + * (sizeof yyor - 1))]; + char const *yyprefix = yyexpecting; + + /* Start YYX at -YYN if negative to avoid negative indexes in + YYCHECK. */ + int yyxbegin = yyn < 0 ? -yyn : 0; + + /* Stay within bounds of both yycheck and yytname. */ + int yychecklim = YYLAST - yyn + 1; + int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS; + int yycount = 1; + + yyarg[0] = yytname[yytype]; + yyfmt = yystpcpy (yyformat, yyunexpected); + + for (yyx = yyxbegin; yyx < yyxend; ++yyx) + if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR) + { + if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM) + { + yycount = 1; + yysize = yysize0; + yyformat[sizeof yyunexpected - 1] = '\0'; + break; + } + yyarg[yycount++] = yytname[yyx]; + yysize1 = yysize + yytnamerr (0, yytname[yyx]); + yysize_overflow |= (yysize1 < yysize); + yysize = yysize1; + yyfmt = yystpcpy (yyfmt, yyprefix); + yyprefix = yyor; + } + + yyf = YY_(yyformat); + yysize1 = yysize + yystrlen (yyf); + yysize_overflow |= (yysize1 < yysize); + yysize = yysize1; + + if (yysize_overflow) + return YYSIZE_MAXIMUM; + + if (yyresult) + { + /* Avoid sprintf, as that infringes on the user's name space. + Don't have undefined behavior even if the translation + produced a string with the wrong number of "%s"s. */ + char *yyp = yyresult; + int yyi = 0; + while ((*yyp = *yyf) != '\0') + { + if (*yyp == '%' && yyf[1] == 's' && yyi < yycount) + { + yyp += yytnamerr (yyp, yyarg[yyi++]); + yyf += 2; + } + else + { + yyp++; + yyf++; + } + } + } + return yysize; } - YYFPRINTF (yyoutput, ")"); } +#endif /* YYERROR_VERBOSE */ + -#endif /* ! YYDEBUG */ /*-----------------------------------------------. | Release the memory associated to this symbol. | `-----------------------------------------------*/ -#if defined (__STDC__) || defined (__cplusplus) +/*ARGSUSED*/ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) static void yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep) #else @@ -957,8 +1257,7 @@ yydestruct (yymsg, yytype, yyvaluep) YYSTYPE *yyvaluep; #endif { - /* Pacify ``unused variable'' warnings. */ - (void) yyvaluep; + YYUSE (yyvaluep); if (!yymsg) yymsg = "Deleting"; @@ -968,7 +1267,7 @@ yydestruct (yymsg, yytype, yyvaluep) { default: - break; + break; } } @@ -976,13 +1275,13 @@ yydestruct (yymsg, yytype, yyvaluep) /* Prevent warnings from -Wmissing-prototypes. */ #ifdef YYPARSE_PARAM -# if defined (__STDC__) || defined (__cplusplus) +#if defined __STDC__ || defined __cplusplus int yyparse (void *YYPARSE_PARAM); -# else +#else int yyparse (); -# endif +#endif #else /* ! YYPARSE_PARAM */ -#if defined (__STDC__) || defined (__cplusplus) +#if defined __STDC__ || defined __cplusplus int yyparse (void); #else int yyparse (); @@ -1007,14 +1306,18 @@ int yynerrs; `----------*/ #ifdef YYPARSE_PARAM -# if defined (__STDC__) || defined (__cplusplus) -int yyparse (void *YYPARSE_PARAM) -# else -int yyparse (YYPARSE_PARAM) - void *YYPARSE_PARAM; -# endif +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +int +yyparse (void *YYPARSE_PARAM) +#else +int +yyparse (YYPARSE_PARAM) + void *YYPARSE_PARAM; +#endif #else /* ! YYPARSE_PARAM */ -#if defined (__STDC__) || defined (__cplusplus) +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) int yyparse (void) #else @@ -1025,13 +1328,19 @@ yyparse () #endif { - register int yystate; - register int yyn; + int yystate; + int yyn; int yyresult; /* Number of tokens to shift before error messages enabled. */ int yyerrstatus; /* Look-ahead token as an internal (translated) token number. */ int yytoken = 0; +#if YYERROR_VERBOSE + /* Buffer for error messages, and its allocated size. */ + char yymsgbuf[128]; + char *yymsg = yymsgbuf; + YYSIZE_T yymsg_alloc = sizeof yymsgbuf; +#endif /* Three stacks and their tools: `yyss': related to states, @@ -1042,18 +1351,18 @@ yyparse () to reallocate them elsewhere. */ /* The state stack. */ - short int yyssa[YYINITDEPTH]; - short int *yyss = yyssa; - register short int *yyssp; + yytype_int16 yyssa[YYINITDEPTH]; + yytype_int16 *yyss = yyssa; + yytype_int16 *yyssp; /* The semantic value stack. */ YYSTYPE yyvsa[YYINITDEPTH]; YYSTYPE *yyvs = yyvsa; - register YYSTYPE *yyvsp; + YYSTYPE *yyvsp; -#define YYPOPSTACK (yyvsp--, yyssp--) +#define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N)) YYSIZE_T yystacksize = YYINITDEPTH; @@ -1062,9 +1371,9 @@ yyparse () YYSTYPE yyval; - /* When reducing, the number of symbols on the RHS of the reduced - rule. */ - int yylen; + /* The number of symbols on the RHS of the reduced rule. + Keep to zero when no symbol should be popped. */ + int yylen = 0; YYDPRINTF ((stderr, "Starting parse\n")); @@ -1081,9 +1390,6 @@ yyparse () yyssp = yyss; yyvsp = yyvs; - - yyvsp[0] = yylval; - goto yysetstate; /*------------------------------------------------------------. @@ -1091,8 +1397,7 @@ yyparse () `------------------------------------------------------------*/ yynewstate: /* In all cases, when you get here, the value and location stacks - have just been pushed. so pushing a state here evens the stacks. - */ + have just been pushed. So pushing a state here evens the stacks. */ yyssp++; yysetstate: @@ -1105,18 +1410,18 @@ yyparse () #ifdef yyoverflow { - /* Give user a chance to reallocate the stack. Use copies of + /* Give user a chance to reallocate the stack. Use copies of these so that the &'s don't force the real ones into memory. */ YYSTYPE *yyvs1 = yyvs; - short int *yyss1 = yyss; + yytype_int16 *yyss1 = yyss; /* Each stack pointer address is followed by the size of the data in use in that stack, in bytes. This used to be a conditional around just the two extra args, but that might be undefined if yyoverflow is a macro. */ - yyoverflow ("parser stack overflow", + yyoverflow (YY_("memory exhausted"), &yyss1, yysize * sizeof (*yyssp), &yyvs1, yysize * sizeof (*yyvsp), @@ -1127,21 +1432,21 @@ yyparse () } #else /* no yyoverflow */ # ifndef YYSTACK_RELOCATE - goto yyoverflowlab; + goto yyexhaustedlab; # else /* Extend the stack our own way. */ if (YYMAXDEPTH <= yystacksize) - goto yyoverflowlab; + goto yyexhaustedlab; yystacksize *= 2; if (YYMAXDEPTH < yystacksize) yystacksize = YYMAXDEPTH; { - short int *yyss1 = yyss; + yytype_int16 *yyss1 = yyss; union yyalloc *yyptr = (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize)); if (! yyptr) - goto yyoverflowlab; + goto yyexhaustedlab; YYSTACK_RELOCATE (yyss); YYSTACK_RELOCATE (yyvs); @@ -1172,12 +1477,10 @@ yyparse () `-----------*/ yybackup: -/* Do appropriate processing given the current state. */ -/* Read a look-ahead token if we need one and don't already have one. */ -/* yyresume: */ + /* Do appropriate processing given the current state. Read a + look-ahead token if we need one and don't already have one. */ /* First try to decide what to do without reference to look-ahead token. */ - yyn = yypact[yystate]; if (yyn == YYPACT_NINF) goto yydefault; @@ -1219,22 +1522,21 @@ yybackup: if (yyn == YYFINAL) YYACCEPT; + /* Count tokens shifted since error; after three, turn off error + status. */ + if (yyerrstatus) + yyerrstatus--; + /* Shift the look-ahead token. */ YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc); - /* Discard the token being shifted unless it is eof. */ + /* Discard the shifted token unless it is eof. */ if (yychar != YYEOF) yychar = YYEMPTY; + yystate = yyn; *++yyvsp = yylval; - - /* Count tokens shifted since error; after three, turn off error - status. */ - if (yyerrstatus) - yyerrstatus--; - - yystate = yyn; goto yynewstate; @@ -1331,31 +1633,31 @@ yyreduce: case 13: { - yyHour = yyvsp[-1].Number; + yyHour = (yyvsp[(1) - (2)].Number); yyMinutes = 0; yySeconds = 0; - yyMeridian = yyvsp[0].Meridian; + yyMeridian = (yyvsp[(2) - (2)].Meridian); ;} break; case 14: { - yyHour = yyvsp[-3].Number; - yyMinutes = yyvsp[-1].Number; + yyHour = (yyvsp[(1) - (4)].Number); + yyMinutes = (yyvsp[(3) - (4)].Number); yySeconds = 0; - yyMeridian = yyvsp[0].Meridian; + yyMeridian = (yyvsp[(4) - (4)].Meridian); ;} break; case 15: { - yyHour = yyvsp[-4].Number; - yyMinutes = yyvsp[-2].Number; + yyHour = (yyvsp[(1) - (5)].Number); + yyMinutes = (yyvsp[(3) - (5)].Number); yyMeridian = MER24; yyDSTmode = DSToff; - yyTimezone = (yyvsp[0].Number % 100 + (yyvsp[0].Number / 100) * 60); + yyTimezone = ((yyvsp[(5) - (5)].Number) % 100 + ((yyvsp[(5) - (5)].Number) / 100) * 60); ++yyHaveZone; ;} break; @@ -1363,22 +1665,22 @@ yyreduce: case 16: { - yyHour = yyvsp[-5].Number; - yyMinutes = yyvsp[-3].Number; - yySeconds = yyvsp[-1].Number; - yyMeridian = yyvsp[0].Meridian; + yyHour = (yyvsp[(1) - (6)].Number); + yyMinutes = (yyvsp[(3) - (6)].Number); + yySeconds = (yyvsp[(5) - (6)].Number); + yyMeridian = (yyvsp[(6) - (6)].Meridian); ;} break; case 17: { - yyHour = yyvsp[-6].Number; - yyMinutes = yyvsp[-4].Number; - yySeconds = yyvsp[-2].Number; + yyHour = (yyvsp[(1) - (7)].Number); + yyMinutes = (yyvsp[(3) - (7)].Number); + yySeconds = (yyvsp[(5) - (7)].Number); yyMeridian = MER24; yyDSTmode = DSToff; - yyTimezone = (yyvsp[0].Number % 100 + (yyvsp[0].Number / 100) * 60); + yyTimezone = ((yyvsp[(7) - (7)].Number) % 100 + ((yyvsp[(7) - (7)].Number) / 100) * 60); ++yyHaveZone; ;} break; @@ -1386,7 +1688,7 @@ yyreduce: case 18: { - yyTimezone = yyvsp[-1].Number; + yyTimezone = (yyvsp[(1) - (2)].Number); yyDSTmode = DSTon; ;} break; @@ -1394,7 +1696,7 @@ yyreduce: case 19: { - yyTimezone = yyvsp[0].Number; + yyTimezone = (yyvsp[(1) - (1)].Number); yyDSTmode = DSToff; ;} break; @@ -1402,7 +1704,7 @@ yyreduce: case 20: { - yyTimezone = yyvsp[0].Number; + yyTimezone = (yyvsp[(1) - (1)].Number); yyDSTmode = DSTon; ;} break; @@ -1411,7 +1713,7 @@ yyreduce: { yyDayOrdinal = 1; - yyDayNumber = yyvsp[0].Number; + yyDayNumber = (yyvsp[(1) - (1)].Number); ;} break; @@ -1419,23 +1721,23 @@ yyreduce: { yyDayOrdinal = 1; - yyDayNumber = yyvsp[-1].Number; + yyDayNumber = (yyvsp[(1) - (2)].Number); ;} break; case 23: { - yyDayOrdinal = yyvsp[-1].Number; - yyDayNumber = yyvsp[0].Number; + yyDayOrdinal = (yyvsp[(1) - (2)].Number); + yyDayNumber = (yyvsp[(2) - (2)].Number); ;} break; case 24: { - yyDayOrdinal = yyvsp[-2].Number * yyvsp[-1].Number; - yyDayNumber = yyvsp[0].Number; + yyDayOrdinal = (yyvsp[(1) - (3)].Number) * (yyvsp[(2) - (3)].Number); + yyDayNumber = (yyvsp[(3) - (3)].Number); ;} break; @@ -1443,76 +1745,76 @@ yyreduce: { yyDayOrdinal = 2; - yyDayNumber = yyvsp[0].Number; + yyDayNumber = (yyvsp[(2) - (2)].Number); ;} break; case 26: { - yyMonth = yyvsp[-2].Number; - yyDay = yyvsp[0].Number; + yyMonth = (yyvsp[(1) - (3)].Number); + yyDay = (yyvsp[(3) - (3)].Number); ;} break; case 27: { - yyMonth = yyvsp[-4].Number; - yyDay = yyvsp[-2].Number; - yyYear = yyvsp[0].Number; + yyMonth = (yyvsp[(1) - (5)].Number); + yyDay = (yyvsp[(3) - (5)].Number); + yyYear = (yyvsp[(5) - (5)].Number); ;} break; case 28: { - yyYear = yyvsp[0].Number / 10000; - yyMonth = (yyvsp[0].Number % 10000)/100; - yyDay = yyvsp[0].Number % 100; + yyYear = (yyvsp[(1) - (1)].Number) / 10000; + yyMonth = ((yyvsp[(1) - (1)].Number) % 10000)/100; + yyDay = (yyvsp[(1) - (1)].Number) % 100; ;} break; case 29: { - yyDay = yyvsp[-4].Number; - yyMonth = yyvsp[-2].Number; - yyYear = yyvsp[0].Number; + yyDay = (yyvsp[(1) - (5)].Number); + yyMonth = (yyvsp[(3) - (5)].Number); + yyYear = (yyvsp[(5) - (5)].Number); ;} break; case 30: { - yyMonth = yyvsp[-2].Number; - yyDay = yyvsp[0].Number; - yyYear = yyvsp[-4].Number; + yyMonth = (yyvsp[(3) - (5)].Number); + yyDay = (yyvsp[(5) - (5)].Number); + yyYear = (yyvsp[(1) - (5)].Number); ;} break; case 31: { - yyMonth = yyvsp[-1].Number; - yyDay = yyvsp[0].Number; + yyMonth = (yyvsp[(1) - (2)].Number); + yyDay = (yyvsp[(2) - (2)].Number); ;} break; case 32: { - yyMonth = yyvsp[-3].Number; - yyDay = yyvsp[-2].Number; - yyYear = yyvsp[0].Number; + yyMonth = (yyvsp[(1) - (4)].Number); + yyDay = (yyvsp[(2) - (4)].Number); + yyYear = (yyvsp[(4) - (4)].Number); ;} break; case 33: { - yyMonth = yyvsp[0].Number; - yyDay = yyvsp[-1].Number; + yyMonth = (yyvsp[(2) - (2)].Number); + yyDay = (yyvsp[(1) - (2)].Number); ;} break; @@ -1528,9 +1830,9 @@ yyreduce: case 35: { - yyMonth = yyvsp[-1].Number; - yyDay = yyvsp[-2].Number; - yyYear = yyvsp[0].Number; + yyMonth = (yyvsp[(2) - (3)].Number); + yyDay = (yyvsp[(1) - (3)].Number); + yyYear = (yyvsp[(3) - (3)].Number); ;} break; @@ -1538,53 +1840,53 @@ yyreduce: { yyMonthOrdinal = 1; - yyMonth = yyvsp[0].Number; + yyMonth = (yyvsp[(2) - (2)].Number); ;} break; case 37: { - yyMonthOrdinal = yyvsp[-1].Number; - yyMonth = yyvsp[0].Number; + yyMonthOrdinal = (yyvsp[(2) - (3)].Number); + yyMonth = (yyvsp[(3) - (3)].Number); ;} break; case 38: { - if (yyvsp[-1].Number != HOUR( 7)) YYABORT; - yyYear = yyvsp[-2].Number / 10000; - yyMonth = (yyvsp[-2].Number % 10000)/100; - yyDay = yyvsp[-2].Number % 100; - yyHour = yyvsp[0].Number / 10000; - yyMinutes = (yyvsp[0].Number % 10000)/100; - yySeconds = yyvsp[0].Number % 100; + if ((yyvsp[(2) - (3)].Number) != HOUR( 7)) YYABORT; + yyYear = (yyvsp[(1) - (3)].Number) / 10000; + yyMonth = ((yyvsp[(1) - (3)].Number) % 10000)/100; + yyDay = (yyvsp[(1) - (3)].Number) % 100; + yyHour = (yyvsp[(3) - (3)].Number) / 10000; + yyMinutes = ((yyvsp[(3) - (3)].Number) % 10000)/100; + yySeconds = (yyvsp[(3) - (3)].Number) % 100; ;} break; case 39: { - if (yyvsp[-5].Number != HOUR( 7)) YYABORT; - yyYear = yyvsp[-6].Number / 10000; - yyMonth = (yyvsp[-6].Number % 10000)/100; - yyDay = yyvsp[-6].Number % 100; - yyHour = yyvsp[-4].Number; - yyMinutes = yyvsp[-2].Number; - yySeconds = yyvsp[0].Number; + if ((yyvsp[(2) - (7)].Number) != HOUR( 7)) YYABORT; + yyYear = (yyvsp[(1) - (7)].Number) / 10000; + yyMonth = ((yyvsp[(1) - (7)].Number) % 10000)/100; + yyDay = (yyvsp[(1) - (7)].Number) % 100; + yyHour = (yyvsp[(3) - (7)].Number); + yyMinutes = (yyvsp[(5) - (7)].Number); + yySeconds = (yyvsp[(7) - (7)].Number); ;} break; case 40: { - yyYear = yyvsp[-1].Number / 10000; - yyMonth = (yyvsp[-1].Number % 10000)/100; - yyDay = yyvsp[-1].Number % 100; - yyHour = yyvsp[0].Number / 10000; - yyMinutes = (yyvsp[0].Number % 10000)/100; - yySeconds = yyvsp[0].Number % 100; + yyYear = (yyvsp[(1) - (2)].Number) / 10000; + yyMonth = ((yyvsp[(1) - (2)].Number) % 10000)/100; + yyDay = (yyvsp[(1) - (2)].Number) % 100; + yyHour = (yyvsp[(2) - (2)].Number) / 10000; + yyMinutes = ((yyvsp[(2) - (2)].Number) % 10000)/100; + yySeconds = (yyvsp[(2) - (2)].Number) % 100; ;} break; @@ -1596,11 +1898,11 @@ yyreduce: * in a range accessible with a 32 bit clock seconds value. */ - yyYear = yyvsp[-2].Number/1000 + 2323 - 377; + yyYear = (yyvsp[(2) - (4)].Number)/1000 + 2323 - 377; yyDay = 1; yyMonth = 1; - yyRelDay += ((yyvsp[-2].Number%1000)*(365 + IsLeapYear(yyYear)))/1000; - yyRelSeconds += yyvsp[0].Number * 144 * 60; + yyRelDay += (((yyvsp[(2) - (4)].Number)%1000)*(365 + IsLeapYear(yyYear)))/1000; + yyRelSeconds += (yyvsp[(4) - (4)].Number) * 144 * 60; ;} break; @@ -1616,56 +1918,56 @@ yyreduce: case 44: { - *yyRelPointer += yyvsp[-2].Number * yyvsp[-1].Number * yyvsp[0].Number; + *yyRelPointer += (yyvsp[(1) - (3)].Number) * (yyvsp[(2) - (3)].Number) * (yyvsp[(3) - (3)].Number); ;} break; case 45: { - *yyRelPointer += yyvsp[-1].Number * yyvsp[0].Number; + *yyRelPointer += (yyvsp[(1) - (2)].Number) * (yyvsp[(2) - (2)].Number); ;} break; case 46: { - *yyRelPointer += yyvsp[0].Number; + *yyRelPointer += (yyvsp[(2) - (2)].Number); ;} break; case 47: { - *yyRelPointer += yyvsp[-1].Number * yyvsp[0].Number; + *yyRelPointer += (yyvsp[(2) - (3)].Number) * (yyvsp[(3) - (3)].Number); ;} break; case 48: { - *yyRelPointer += yyvsp[0].Number; + *yyRelPointer += (yyvsp[(1) - (1)].Number); ;} break; case 49: { - yyval.Number = -1; + (yyval.Number) = -1; ;} break; case 50: { - yyval.Number = 1; + (yyval.Number) = 1; ;} break; case 51: { - yyval.Number = yyvsp[0].Number; + (yyval.Number) = (yyvsp[(1) - (1)].Number); yyRelPointer = &yyRelSeconds; ;} break; @@ -1673,7 +1975,7 @@ yyreduce: case 52: { - yyval.Number = yyvsp[0].Number; + (yyval.Number) = (yyvsp[(1) - (1)].Number); yyRelPointer = &yyRelDay; ;} break; @@ -1681,7 +1983,7 @@ yyreduce: case 53: { - yyval.Number = yyvsp[0].Number; + (yyval.Number) = (yyvsp[(1) - (1)].Number); yyRelPointer = &yyRelMonth; ;} break; @@ -1690,15 +1992,15 @@ yyreduce: { if (yyHaveTime && yyHaveDate && !yyHaveRel) { - yyYear = yyvsp[0].Number; + yyYear = (yyvsp[(1) - (1)].Number); } else { yyHaveTime++; if (yyDigitCount <= 2) { - yyHour = yyvsp[0].Number; + yyHour = (yyvsp[(1) - (1)].Number); yyMinutes = 0; } else { - yyHour = yyvsp[0].Number / 100; - yyMinutes = yyvsp[0].Number % 100; + yyHour = (yyvsp[(1) - (1)].Number) / 100; + yyMinutes = (yyvsp[(1) - (1)].Number) % 100; } yySeconds = 0; yyMeridian = MER24; @@ -1709,27 +2011,26 @@ yyreduce: case 55: { - yyval.Meridian = MER24; + (yyval.Meridian) = MER24; ;} break; case 56: { - yyval.Meridian = yyvsp[0].Meridian; + (yyval.Meridian) = (yyvsp[(1) - (1)].Meridian); ;} break; - } - -/* Line 1043 of yacc.c. */ - - - yyvsp -= yylen; - yyssp -= yylen; +/* Line 1267 of yacc.c. */ + default: break; + } + YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc); + YYPOPSTACK (yylen); + yylen = 0; YY_STACK_PRINT (yyss, yyssp); *++yyvsp = yyval; @@ -1758,66 +2059,41 @@ yyerrlab: if (!yyerrstatus) { ++yynerrs; -#if YYERROR_VERBOSE - yyn = yypact[yystate]; - - if (YYPACT_NINF < yyn && yyn < YYLAST) - { - YYSIZE_T yysize = 0; - int yytype = YYTRANSLATE (yychar); - const char* yyprefix; - char *yymsg; - int yyx; - - /* Start YYX at -YYN if negative to avoid negative indexes in - YYCHECK. */ - int yyxbegin = yyn < 0 ? -yyn : 0; - - /* Stay within bounds of both yycheck and yytname. */ - int yychecklim = YYLAST - yyn; - int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS; - int yycount = 0; - - yyprefix = ", expecting "; - for (yyx = yyxbegin; yyx < yyxend; ++yyx) - if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR) +#if ! YYERROR_VERBOSE + yyerror (YY_("syntax error")); +#else + { + YYSIZE_T yysize = yysyntax_error (0, yystate, yychar); + if (yymsg_alloc < yysize && yymsg_alloc < YYSTACK_ALLOC_MAXIMUM) + { + YYSIZE_T yyalloc = 2 * yysize; + if (! (yysize <= yyalloc && yyalloc <= YYSTACK_ALLOC_MAXIMUM)) + yyalloc = YYSTACK_ALLOC_MAXIMUM; + if (yymsg != yymsgbuf) + YYSTACK_FREE (yymsg); + yymsg = (char *) YYSTACK_ALLOC (yyalloc); + if (yymsg) + yymsg_alloc = yyalloc; + else { - yysize += yystrlen (yyprefix) + yystrlen (yytname [yyx]); - yycount += 1; - if (yycount == 5) - { - yysize = 0; - break; - } + yymsg = yymsgbuf; + yymsg_alloc = sizeof yymsgbuf; } - yysize += (sizeof ("syntax error, unexpected ") - + yystrlen (yytname[yytype])); - yymsg = (char *) YYSTACK_ALLOC (yysize); - if (yymsg != 0) - { - char *yyp = yystpcpy (yymsg, "syntax error, unexpected "); - yyp = yystpcpy (yyp, yytname[yytype]); - - if (yycount < 5) - { - yyprefix = ", expecting "; - for (yyx = yyxbegin; yyx < yyxend; ++yyx) - if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR) - { - yyp = yystpcpy (yyp, yyprefix); - yyp = yystpcpy (yyp, yytname[yyx]); - yyprefix = " or "; - } - } - yyerror (yymsg); - YYSTACK_FREE (yymsg); - } - else - yyerror ("syntax error; also virtual memory exhausted"); - } - else -#endif /* YYERROR_VERBOSE */ - yyerror ("syntax error"); + } + + if (0 < yysize && yysize <= yymsg_alloc) + { + (void) yysyntax_error (yymsg, yystate, yychar); + yyerror (yymsg); + } + else + { + yyerror (YY_("syntax error")); + if (yysize != 0) + goto yyexhaustedlab; + } + } +#endif } @@ -1828,23 +2104,15 @@ yyerrlab: error, discard it. */ if (yychar <= YYEOF) - { - /* If at end of input, pop the error token, - then the rest of the stack, then return failure. */ + { + /* Return failure if at end of input. */ if (yychar == YYEOF) - for (;;) - { - - YYPOPSTACK; - if (yyssp == yyss) - YYABORT; - yydestruct ("Error: popping", - yystos[*yyssp], yyvsp); - } - } + YYABORT; + } else { - yydestruct ("Error: discarding", yytoken, &yylval); + yydestruct ("Error: discarding", + yytoken, &yylval); yychar = YYEMPTY; } } @@ -1859,15 +2127,17 @@ yyerrlab: `---------------------------------------------------*/ yyerrorlab: -#ifdef __GNUC__ - /* Pacify GCC when the user code never invokes YYERROR and the label - yyerrorlab therefore never appears in user code. */ - if (0) + /* Pacify compilers like GCC when the user code never invokes + YYERROR and the label yyerrorlab therefore never appears in user + code. */ + if (/*CONSTCOND*/ 0) goto yyerrorlab; -#endif -yyvsp -= yylen; - yyssp -= yylen; + /* Do not reclaim the symbols of the rule which action triggered + this YYERROR. */ + YYPOPSTACK (yylen); + yylen = 0; + YY_STACK_PRINT (yyss, yyssp); yystate = *yyssp; goto yyerrlab1; @@ -1897,8 +2167,9 @@ yyerrlab1: YYABORT; - yydestruct ("Error: popping", yystos[yystate], yyvsp); - YYPOPSTACK; + yydestruct ("Error: popping", + yystos[yystate], yyvsp); + YYPOPSTACK (1); yystate = *yyssp; YY_STACK_PRINT (yyss, yyssp); } @@ -1909,7 +2180,7 @@ yyerrlab1: *++yyvsp = yylval; - /* Shift the error token. */ + /* Shift the error token. */ YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp); yystate = yyn; @@ -1927,28 +2198,43 @@ yyacceptlab: | yyabortlab -- YYABORT comes here. | `-----------------------------------*/ yyabortlab: - yydestruct ("Error: discarding lookahead", - yytoken, &yylval); - yychar = YYEMPTY; yyresult = 1; goto yyreturn; #ifndef yyoverflow -/*----------------------------------------------. -| yyoverflowlab -- parser overflow comes here. | -`----------------------------------------------*/ -yyoverflowlab: - yyerror ("parser stack overflow"); +/*-------------------------------------------------. +| yyexhaustedlab -- memory exhaustion comes here. | +`-------------------------------------------------*/ +yyexhaustedlab: + yyerror (YY_("memory exhausted")); yyresult = 2; /* Fall through. */ #endif yyreturn: + if (yychar != YYEOF && yychar != YYEMPTY) + yydestruct ("Cleanup: discarding lookahead", + yytoken, &yylval); + /* Do not reclaim the symbols of the rule which action triggered + this YYABORT or YYACCEPT. */ + YYPOPSTACK (yylen); + YY_STACK_PRINT (yyss, yyssp); + while (yyssp != yyss) + { + yydestruct ("Cleanup: popping", + yystos[*yyssp], yyvsp); + YYPOPSTACK (1); + } #ifndef yyoverflow if (yyss != yyssa) YYSTACK_FREE (yyss); #endif - return yyresult; +#if YYERROR_VERBOSE + if (yymsg != yymsgbuf) + YYSTACK_FREE (yymsg); +#endif + /* Make sure YYID is used. */ + return YYID (yyresult); } @@ -2531,4 +2817,3 @@ TclClockOldscanObjCmd( * End: */ - diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 30bce65..5884abd 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.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: tclEnv.c,v 1.33 2007/04/23 17:34:06 kennykb Exp $ + * RCS: @(#) $Id: tclEnv.c,v 1.33.2.1 2007/09/04 17:43:50 dgp Exp $ */ #include "tclInt.h" @@ -37,16 +37,6 @@ static int environSize = 0; /* Non-zero means that the environ array was #endif /* - * For MacOS X - */ - -#if defined(__APPLE__) && defined(__DYNAMIC__) -#include -__private_extern__ char **environ; -char **environ = NULL; -#endif - -/* * Declarations for local functions defined in this file: */ @@ -91,14 +81,6 @@ TclSetupEnv( int i; /* - * For MacOS X, need to get the real system environment. - */ - -#if defined(__APPLE__) && defined(__DYNAMIC__) - environ = *_NSGetEnviron(); -#endif - - /* * Synchronize the values in the environ array with the contents of the * Tcl "env" variable. To do this: * 1) Remove the trace that fires when the "env" var is unset. @@ -210,18 +192,6 @@ TclSetEnv( } environ = ourEnviron = newEnviron; environSize = length + 5; - -#if defined(__APPLE__) && defined(__DYNAMIC__) - /* - * Install the new environment array where the system routines can - * see it. - */ - - { - char ***e = _NSGetEnviron(); - *e = environ; - } -#endif /* __APPLE__ && __DYNAMIC__ */ } index = length; environ[index + 1] = NULL; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 8a05056..4501de3 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.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: tclExecute.c,v 1.285.2.11 2007/07/01 17:31:23 dgp Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.285.2.12 2007/09/04 17:43:50 dgp Exp $ */ #include "tclInt.h" @@ -87,7 +87,7 @@ int tclTraceExec = 0; * expression opcodes (e.g., INST_LOR) in tclCompile.h. * * Does not include the string for INST_EXPON (and beyond), as that is - * disjoint for backward-compatability reasons + * disjoint for backward-compatability reasons. */ static const char *operatorStrings[] = { @@ -119,7 +119,7 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; #endif /* TCL_COMPILE_STATS */ /* - * Support pre-8.5 bytecodes unless specifically requested otherwise + * Support pre-8.5 bytecodes unless specifically requested otherwise. */ #ifndef TCL_SUPPORT_84_BYTECODE @@ -177,6 +177,27 @@ static BuiltinFunc tclBuiltinFuncTable[] = { #endif /* + * These variable-access macros have to coincide with those in tclVar.c + */ + +#define VarHashGetValue(hPtr) \ + ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry))) + +static inline Var * +VarHashCreateVar(TclVarHashTable *tablePtr, Tcl_Obj *key, int *newPtr) +{ + Tcl_HashEntry *hPtr = Tcl_CreateHashEntry((Tcl_HashTable *) tablePtr, (char *) key, newPtr); + if (hPtr) { + return VarHashGetValue(hPtr); + } else { + return NULL; + } +} + +#define VarHashFindVar(tablePtr, key) \ + VarHashCreateVar((tablePtr), (key), NULL) + +/* * The new macro for ending an instruction; note that a reasonable C-optimiser * will resolve all branches at compile time. (result) is always a constant; * the macro NEXT_INST_F handles constant (nCleanup), NEXT_INST_V is resolved @@ -401,6 +422,19 @@ static BuiltinFunc tclBuiltinFuncTable[] = { #endif /* + * Macro used to make the check for type overflow more mnemonic. This works by + * comparing sign bits; the rest of the word is irrelevant. The ANSI C + * "prototype" (where inttype_t is any integer type) is: + * + * MODULE_SCOPE int Overflowing(inttype_t a, inttype_t b, inttype_t sum); + * + * Check first the condition most likely to fail in usual code (at least for + * usage in [incr]: do the first summand and the sum have != signs? + */ + +#define Overflowing(a,b,sum) ((((a)^(sum)) < 0) && (((a)^(b)) >= 0)) + +/* * Custom object type only used in this file; values of its type should never * be seen by user scripts. */ @@ -411,6 +445,138 @@ static Tcl_ObjType dictIteratorType = { }; /* + * Auxiliary tables used to compute powers of small integers + */ + +#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. + */ + +static const unsigned short Exp32Index[] = { + 0, 11, 18, 23, 26, 29, 31, 32, 33 +}; +static const long Exp32Value[] = { + 19683, 59049, 177147, 531441, 1594323, 4782969, 14348907, 43046721, + 129140163, 387420489, 1162261467, 262144, 1048576, 4194304, + 16777216, 67108864, 268435456, 1073741824, 1953125, 9765625, + 48828125, 244140625, 1220703125, 10077696, 60466176, 362797056, + 40353607, 282475249, 1977326743, 134217728, 1073741824, 387420489, + 1000000000 +}; + +#endif /* LONG_MAX == 0x7fffffff -- 32 bit machine */ + +#if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG) + +/* + * 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. + */ + +static const unsigned short Exp64Index[] = { + 0, 23, 38, 49, 57, 63, 67, 70, 72, 74, 75, 76 +}; +static const Tcl_WideInt Exp64Value[] = { + (Tcl_WideInt)243*243*243*3*3, + (Tcl_WideInt)243*243*243*3*3*3, + (Tcl_WideInt)243*243*243*3*3*3*3, + (Tcl_WideInt)243*243*243*243, + (Tcl_WideInt)243*243*243*243*3, + (Tcl_WideInt)243*243*243*243*3*3, + (Tcl_WideInt)243*243*243*243*3*3*3, + (Tcl_WideInt)243*243*243*243*3*3*3*3, + (Tcl_WideInt)243*243*243*243*243, + (Tcl_WideInt)243*243*243*243*243*3, + (Tcl_WideInt)243*243*243*243*243*3*3, + (Tcl_WideInt)243*243*243*243*243*3*3*3, + (Tcl_WideInt)243*243*243*243*243*3*3*3*3, + (Tcl_WideInt)243*243*243*243*243*243, + (Tcl_WideInt)243*243*243*243*243*243*3, + (Tcl_WideInt)243*243*243*243*243*243*3*3, + (Tcl_WideInt)243*243*243*243*243*243*3*3*3, + (Tcl_WideInt)243*243*243*243*243*243*3*3*3*3, + (Tcl_WideInt)243*243*243*243*243*243*243, + (Tcl_WideInt)243*243*243*243*243*243*243*3, + (Tcl_WideInt)243*243*243*243*243*243*243*3*3, + (Tcl_WideInt)243*243*243*243*243*243*243*3*3*3, + (Tcl_WideInt)243*243*243*243*243*243*243*3*3*3*3, + (Tcl_WideInt)1024*1024*1024*4*4, + (Tcl_WideInt)1024*1024*1024*4*4*4, + (Tcl_WideInt)1024*1024*1024*4*4*4*4, + (Tcl_WideInt)1024*1024*1024*1024, + (Tcl_WideInt)1024*1024*1024*1024*4, + (Tcl_WideInt)1024*1024*1024*1024*4*4, + (Tcl_WideInt)1024*1024*1024*1024*4*4*4, + (Tcl_WideInt)1024*1024*1024*1024*4*4*4*4, + (Tcl_WideInt)1024*1024*1024*1024*1024, + (Tcl_WideInt)1024*1024*1024*1024*1024*4, + (Tcl_WideInt)1024*1024*1024*1024*1024*4*4, + (Tcl_WideInt)1024*1024*1024*1024*1024*4*4*4, + (Tcl_WideInt)1024*1024*1024*1024*1024*4*4*4*4, + (Tcl_WideInt)1024*1024*1024*1024*1024*1024, + (Tcl_WideInt)1024*1024*1024*1024*1024*1024*4, + (Tcl_WideInt)3125*3125*3125*5*5, + (Tcl_WideInt)3125*3125*3125*5*5*5, + (Tcl_WideInt)3125*3125*3125*5*5*5*5, + (Tcl_WideInt)3125*3125*3125*3125, + (Tcl_WideInt)3125*3125*3125*3125*5, + (Tcl_WideInt)3125*3125*3125*3125*5*5, + (Tcl_WideInt)3125*3125*3125*3125*5*5*5, + (Tcl_WideInt)3125*3125*3125*3125*5*5*5*5, + (Tcl_WideInt)3125*3125*3125*3125*3125, + (Tcl_WideInt)3125*3125*3125*3125*3125*5, + (Tcl_WideInt)3125*3125*3125*3125*3125*5*5, + (Tcl_WideInt)7776*7776*7776*6*6, + (Tcl_WideInt)7776*7776*7776*6*6*6, + (Tcl_WideInt)7776*7776*7776*6*6*6*6, + (Tcl_WideInt)7776*7776*7776*7776, + (Tcl_WideInt)7776*7776*7776*7776*6, + (Tcl_WideInt)7776*7776*7776*7776*6*6, + (Tcl_WideInt)7776*7776*7776*7776*6*6*6, + (Tcl_WideInt)7776*7776*7776*7776*6*6*6*6, + (Tcl_WideInt)16807*16807*16807*7*7, + (Tcl_WideInt)16807*16807*16807*7*7*7, + (Tcl_WideInt)16807*16807*16807*7*7*7*7, + (Tcl_WideInt)16807*16807*16807*16807, + (Tcl_WideInt)16807*16807*16807*16807*7, + (Tcl_WideInt)16807*16807*16807*16807*7*7, + (Tcl_WideInt)32768*32768*32768*8*8, + (Tcl_WideInt)32768*32768*32768*8*8*8, + (Tcl_WideInt)32768*32768*32768*8*8*8*8, + (Tcl_WideInt)32768*32768*32768*32768, + (Tcl_WideInt)59049*59049*59049*9*9, + (Tcl_WideInt)59049*59049*59049*9*9*9, + (Tcl_WideInt)59049*59049*59049*9*9*9*9, + (Tcl_WideInt)100000*100000*100000*10*10, + (Tcl_WideInt)100000*100000*100000*10*10*10, + (Tcl_WideInt)161051*161051*161051*11*11, + (Tcl_WideInt)161051*161051*161051*11*11*11, + (Tcl_WideInt)248832*248832*248832*12*12, + (Tcl_WideInt)371293*371293*371293*13*13 +}; + +#endif + +/* * Declarations for local procedures to this file: */ @@ -426,7 +592,8 @@ static ExceptionRange * GetExceptRangeForPc(unsigned char *pc, int catchOnly, ByteCode *codePtr); static const char * GetSrcInfoForPc(unsigned char *pc, ByteCode *codePtr, int *lengthPtr); -static Tcl_Obj ** GrowEvaluationStack(ExecEnv *eePtr, int growth, int move); +static Tcl_Obj ** GrowEvaluationStack(ExecEnv *eePtr, int growth, + int move); static void IllegalExprOperandType(Tcl_Interp *interp, unsigned char *pc, Tcl_Obj *opndPtr); static void InitByteCodeExecution(Tcl_Interp *interp); @@ -437,13 +604,10 @@ static void ValidatePcAndStackTop(ByteCode *codePtr, unsigned char *pc, int stackTop, int stackLowerBound, int checkStack); #endif /* TCL_COMPILE_DEBUG */ - static void DeleteExecStack(ExecStack *esPtr); - /* Useful elsewhere, make available in tclInt.h or stubs? */ static Tcl_Obj ** StackAllocWords(Tcl_Interp *interp, int numWords); static Tcl_Obj ** StackReallocWords(Tcl_Interp *interp, int numWords); - /* *---------------------------------------------------------------------- @@ -472,6 +636,9 @@ InitByteCodeExecution( * "tcl_traceExec" is linked to control * instruction tracing. */ { +#if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG) + int i; +#endif #ifdef TCL_COMPILE_DEBUG if (Tcl_LinkVar(interp, "tcl_traceExec", (char *) &tclTraceExec, TCL_LINK_INT) != TCL_OK) { @@ -482,6 +649,11 @@ InitByteCodeExecution( Tcl_CreateObjCommand(interp, "evalstats", EvalStatsCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); #endif /* TCL_COMPILE_STATS */ +#if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG) + for (i = 2; i <= 16; ++i) { + MaxBaseWide[i-2] = (Tcl_WideInt) pow((double) LLONG_MAX, 1.0 / i); + } +#endif } /* @@ -672,7 +844,7 @@ GrowEvaluationStack( * store it in esPtr as the current marker. Return a pointer to one * word past the marker. */ - + esPtr->markerPtr = ++esPtr->tosPtr; *esPtr->markerPtr = (Tcl_Obj *) markerPtr; return esPtr->markerPtr + 1; @@ -739,7 +911,7 @@ GrowEvaluationStack( * this is the first marker in this stack and that rewinding to here * should actually be a return to the previous stack. */ - + esPtr->stackWords[0] = NULL; esPtr->markerPtr = esPtr->tosPtr = &esPtr->stackWords[0]; @@ -764,10 +936,10 @@ GrowEvaluationStack( /* *-------------------------------------------------------------- * - * TclStackAlloc -- + * TclStackAlloc, TclStackRealloc, TclStackFree -- * * Allocate memory from the execution stack; it has to be returned later - * with a call to TclStackFree + * with a call to TclStackFree. * * Results: * A pointer to the first byte allocated, or panics if the allocation did @@ -788,7 +960,7 @@ StackAllocWords( * Note that GrowEvaluationStack sets a marker in the stack. This marker * is read when rewinding, e.g., by TclStackFree. */ - + Interp *iPtr = (Interp *) interp; ExecEnv *eePtr = iPtr->execEnvPtr; Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 0); @@ -829,14 +1001,14 @@ TclStackFree( * Rewind the stack to the previous marker position. The current marker, * as set in the last call to GrowEvaluationStack, contains a pointer to * the previous marker. - */ + */ eePtr = iPtr->execEnvPtr; esPtr = eePtr->execStackPtr; markerPtr = esPtr->markerPtr; if ((markerPtr+1) != (Tcl_Obj **)freePtr) { - Tcl_Panic("TclStackFree: incorrect freePtr. Call out of sequence?"); + Tcl_Panic("TclStackFree: incorrect freePtr. Call out of sequence?"); } esPtr->tosPtr = markerPtr-1; @@ -897,7 +1069,7 @@ TclStackRealloc( markerPtr = esPtr->markerPtr; if ((markerPtr+1) != (Tcl_Obj **)ptr) { - Tcl_Panic("TclStackRealloc: incorrect ptr. Call out of sequence?"); + Tcl_Panic("TclStackRealloc: incorrect ptr. Call out of sequence?"); } numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *); @@ -939,46 +1111,11 @@ Tcl_ExprObj( Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated * in frame. */ - LiteralTable *localTablePtr = &(compEnv.localLitTable); register ByteCode *codePtr = NULL; /* Tcl Internal type of bytecode. Initialized * to avoid compiler warning. */ - AuxData *auxDataPtr; - LiteralEntry *entryPtr; - Tcl_Obj *saveObjPtr, *resultPtr; - char *string; - int length, i, result; - - /* - * First handle some common expressions specially. - */ - - string = Tcl_GetStringFromObj(objPtr, &length); - if (length == 1) { - if (*string == '0') { - TclNewBooleanObj(resultPtr, 0); - Tcl_IncrRefCount(resultPtr); - *resultPtrPtr = resultPtr; - return TCL_OK; - } else if (*string == '1') { - TclNewBooleanObj(resultPtr, 1); - Tcl_IncrRefCount(resultPtr); - *resultPtrPtr = resultPtr; - return TCL_OK; - } - } else if ((length == 2) && (*string == '!')) { - if (*(string+1) == '0') { - TclNewBooleanObj(resultPtr, 1); - Tcl_IncrRefCount(resultPtr); - *resultPtrPtr = resultPtr; - return TCL_OK; - } else if (*(string+1) == '1') { - TclNewBooleanObj(resultPtr, 0); - Tcl_IncrRefCount(resultPtr); - *resultPtrPtr = resultPtr; - return TCL_OK; - } - } + Tcl_Obj *saveObjPtr; + int result; /* * Get the ByteCode from the object. If it exists, make sure it hasn't @@ -1007,49 +1144,12 @@ 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 = Tcl_GetStringFromObj(objPtr, &length); TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0); - result = TclCompileExpr(interp, string, length, &compEnv); - - /* - * Free the compilation environment's literal table bucket array if it - * was dynamically allocated. - */ - - if (localTablePtr->buckets != localTablePtr->staticBuckets) { - ckfree((char *) localTablePtr->buckets); - } - - if (result != TCL_OK) { - /* - * Compilation errors. Free storage allocated for compilation. - */ - -#ifdef TCL_COMPILE_DEBUG - TclVerifyLocalLiteralTable(&compEnv); -#endif /*TCL_COMPILE_DEBUG*/ - entryPtr = compEnv.literalArrayPtr; - for (i = 0; i < compEnv.literalArrayNext; i++) { - TclReleaseLiteral(interp, entryPtr->objPtr); - entryPtr++; - } -#ifdef TCL_COMPILE_DEBUG - TclVerifyGlobalLiteralTable(iPtr); -#endif /*TCL_COMPILE_DEBUG*/ - - auxDataPtr = compEnv.auxDataArrayPtr; - for (i = 0; i < compEnv.auxDataArrayNext; i++) { - if (auxDataPtr->type->freeProc != NULL) { - auxDataPtr->type->freeProc(auxDataPtr->clientData); - } - auxDataPtr++; - } - TclFreeCompileEnv(&compEnv); - return result; - } + TclCompileExpr(interp, string, length, &compEnv); /* * Successful compilation. If the expression yielded no instructions, @@ -1074,6 +1174,7 @@ Tcl_ExprObj( #ifdef TCL_COMPILE_DEBUG if (tclTraceCompile == 2) { TclPrintByteCodeObj(interp, objPtr); + fflush(stdout); } #endif /* TCL_COMPILE_DEBUG */ } @@ -1204,8 +1305,9 @@ TclCompEvalObj( codePtr->compileEpoch = iPtr->compileEpoch; } else { /* - * This byteCode is invalid: free it and recompile + * This byteCode is invalid: free it and recompile. */ + objPtr->typePtr->freeIntRepProc(objPtr); goto recompileObj; } @@ -1296,15 +1398,16 @@ TclIncrObj( long sum = augend + addend; /* - * Test for overflow. + * Overflow when (augend and sum have different sign) and (augend and + * addend have the same sign). This is encapsulated in the Overflowing + * macro. */ - if ((augend >= 0 || addend >= 0 || sum < 0) - && (sum >= 0 || addend < 0 || augend < 0)) { + if (!Overflowing(augend, addend, sum)) { TclSetLongObj(valuePtr, sum); return TCL_OK; } -#ifndef TCL_WIDE_INT_IS_LONG +#ifndef NO_WIDE_TYPE { Tcl_WideInt w1 = (Tcl_WideInt)augend; Tcl_WideInt w2 = (Tcl_WideInt)addend; @@ -1348,8 +1451,7 @@ TclIncrObj( * Check for overflow. */ - if ((w1 >= 0 || w2 >= 0 || sum < 0) - && (w1 < 0 || w2 < 0 || sum >= 0)) { + if (!Overflowing(w1, w2, sum)) { Tcl_SetWideIntObj(valuePtr, sum); return TCL_OK; } @@ -1559,8 +1661,9 @@ TclExecuteByteCode( case 0: /* * We really want to do nothing now, but this is needed for some - * compilers (SunPro CC) + * compilers (SunPro CC). */ + break; } } @@ -1568,7 +1671,7 @@ TclExecuteByteCode( #ifdef TCL_COMPILE_DEBUG /* - * Skip the stack depth check if an expansion is in progress + * Skip the stack depth check if an expansion is in progress. */ ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH, 0, @@ -1619,7 +1722,23 @@ TclExecuteByteCode( } } + /* + * These two instructions account for 26% of all instructions (according + * to measurements on tclbench by Ben Vitale + * [http://www.cs.toronto.edu/syslab/pubs/tcl2005-vitale-zaleski.pdf] + * Resolving them before the switch reduces the cost of branch + * mispredictions, seems to improve runtime by 5% to 15%, and (amazingly!) + * reduces total obj size. + */ + + if (*pc == INST_LOAD_SCALAR1) { + goto instLoadScalar1; + } else if (*pc == INST_PUSH1) { + goto instPush1Peephole; + } + switch (*pc) { + case INST_SYNTAX: case INST_RETURN_IMM: { int code = TclGetInt4AtPtr(pc+1); int level = TclGetUInt4AtPtr(pc+5); @@ -1636,6 +1755,9 @@ TclExecuteByteCode( NEXT_INST_F(9, 1, 0); } else { Tcl_SetObjResult(interp, OBJ_UNDER_TOS); + if (*pc == INST_SYNTAX) { + iPtr->flags &= ~ERR_ALREADY_LOGGED; + } cleanup = 2; goto processExceptionReturn; } @@ -1680,9 +1802,7 @@ TclExecuteByteCode( } case INST_PUSH1: -#if !TCL_COMPILE_DEBUG instPush1Peephole: -#endif PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]); TRACE_WITH_OBJ(("%u => ", TclGetInt1AtPtr(pc+1)), OBJ_AT_TOS); pc += 2; @@ -1975,7 +2095,6 @@ TclExecuteByteCode( doInvocation: { Tcl_Obj **objv = &OBJ_AT_DEPTH(objc-1); - Command *cmdPtr; #ifdef TCL_COMPILE_DEBUG if (tclTraceExec >= 2) { @@ -2014,43 +2133,19 @@ TclExecuteByteCode( bcFramePtr->data.tebc.pc = (char *) pc; iPtr->cmdFramePtr = bcFramePtr; DECACHE_STACK_INFO(); - cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]); - - if (cmdPtr - && !((cmdPtr->flags & CMD_HAS_EXEC_TRACES) || iPtr->tracePtr) - && !(checkInterp && (codePtr->compileEpoch != iPtr->compileEpoch)) - ) { - cmdPtr->refCount++; - iPtr->cmdCount++; - result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv); - - if (Tcl_AsyncReady()) { - result = Tcl_AsyncInvoke(interp, result); - } - if (result == TCL_OK && TclLimitReady(iPtr->limit)) { - result = Tcl_LimitCheck(interp); - } - TclCleanupCommandMacro(cmdPtr); - } else { - /* - * If trace procedures will be called, we need a command - * string to pass to TclEvalObjvInternal; note that a copy of - * the string will be made there to include the ending \0. - */ - int length; - const char *bytes; - - bytes = GetSrcInfoForPc(pc, codePtr, &length); - result = TclEvalObjvInternal(interp, objc, objv, bytes, - length, 0); - } - + result = TclEvalObjvInternal(interp, objc, objv, + /* call from TEBC */(char *) -1, -1, 0); CACHE_STACK_INFO(); iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr; if (result == TCL_OK) { Tcl_Obj *objPtr; +#ifndef TCL_COMPILE_DEBUG + if (*(pc+pcAdjustment) == INST_POP) { + NEXT_INST_V((pcAdjustment+1), objc, 0); + } +#endif /* * Push the call's object result and continue execution with * the next instruction. @@ -2256,14 +2351,14 @@ TclExecuteByteCode( */ { int opnd, pcAdjustment; - char *part1, *part2; + Tcl_Obj *part1Ptr, *part2Ptr; Var *varPtr, *arrayPtr; Tcl_Obj *objPtr; case INST_LOAD_SCALAR1: + instLoadScalar1: opnd = TclGetUInt1AtPtr(pc+1); varPtr = &(compiledLocals[opnd]); - part1 = varPtr->name; while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } @@ -2280,13 +2375,12 @@ TclExecuteByteCode( pcAdjustment = 2; cleanup = 0; arrayPtr = NULL; - part2 = NULL; + part1Ptr = part2Ptr = NULL; goto doCallPtrGetVar; case INST_LOAD_SCALAR4: opnd = TclGetUInt4AtPtr(pc+1); varPtr = &(compiledLocals[opnd]); - part1 = varPtr->name; while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } @@ -2303,38 +2397,80 @@ TclExecuteByteCode( pcAdjustment = 5; cleanup = 0; arrayPtr = NULL; - part2 = NULL; + part1Ptr = part2Ptr = NULL; + goto doCallPtrGetVar; + + case INST_LOAD_ARRAY4: + opnd = TclGetUInt4AtPtr(pc+1); + pcAdjustment = 5; + goto doLoadArray; + + case INST_LOAD_ARRAY1: + opnd = TclGetUInt1AtPtr(pc+1); + pcAdjustment = 2; + + doLoadArray: + part1Ptr = NULL; + part2Ptr = OBJ_AT_TOS; + arrayPtr = &(compiledLocals[opnd]); + while (TclIsVarLink(arrayPtr)) { + arrayPtr = arrayPtr->value.linkPtr; + } + TRACE(("%u \"%.30s\" => ", opnd, O2S(part2Ptr))); + if (TclIsVarArray(arrayPtr) && !(arrayPtr->flags & VAR_TRACED_READ)) { + varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr); + if (varPtr && TclIsVarDirectReadable(varPtr)) { + /* + * No errors, no traces: just get the value. + */ + + objResultPtr = varPtr->value.objPtr; + TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); + NEXT_INST_F(pcAdjustment, 1, 1); + } + } + varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, + TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr, opnd); + if (varPtr == NULL) { + TRACE_APPEND(("ERROR: %.30s\n", + O2S(Tcl_GetObjResult(interp)))); + result = TCL_ERROR; + goto checkForCatch; + } + cleanup = 1; goto doCallPtrGetVar; case INST_LOAD_ARRAY_STK: cleanup = 2; - part2 = Tcl_GetString(OBJ_AT_TOS); /* element name */ - objPtr = OBJ_UNDER_TOS; /* array name */ - TRACE(("\"%.30s(%.30s)\" => ", O2S(objPtr), part2)); + part2Ptr = OBJ_AT_TOS; /* element name */ + objPtr = OBJ_UNDER_TOS; /* array name */ + TRACE(("\"%.30s(%.30s)\" => ", O2S(objPtr), O2S(part2Ptr))); goto doLoadStk; case INST_LOAD_STK: case INST_LOAD_SCALAR_STK: cleanup = 1; - part2 = NULL; - objPtr = OBJ_AT_TOS; /* variable name */ + part2Ptr = NULL; + objPtr = OBJ_AT_TOS; /* variable name */ TRACE(("\"%.30s\" => ", O2S(objPtr))); doLoadStk: - part1 = TclGetString(objPtr); - varPtr = TclObjLookupVar(interp, objPtr, part2, TCL_LEAVE_ERR_MSG, - "read", /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr); + part1Ptr = objPtr; + varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, + TCL_LEAVE_ERR_MSG, "read", /*createPart1*/0, /*createPart2*/1, + &arrayPtr); if (varPtr) { - if (TclIsVarDirectReadable(varPtr) - && ((arrayPtr == NULL) || TclIsVarUntraced(arrayPtr))) { + if (TclIsVarDirectReadable2(varPtr, arrayPtr)) { /* * No errors, no traces: just get the value. */ + objResultPtr = varPtr->value.objPtr; TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_V(1, cleanup, 1); } pcAdjustment = 1; + opnd = -1; goto doCallPtrGetVar; } else { TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); @@ -2342,57 +2478,6 @@ TclExecuteByteCode( goto checkForCatch; } - case INST_LOAD_ARRAY4: - opnd = TclGetUInt4AtPtr(pc+1); - pcAdjustment = 5; - goto doLoadArray; - - case INST_LOAD_ARRAY1: - opnd = TclGetUInt1AtPtr(pc+1); - pcAdjustment = 2; - - doLoadArray: - part2 = TclGetString(OBJ_AT_TOS); - arrayPtr = &(compiledLocals[opnd]); - part1 = arrayPtr->name; - while (TclIsVarLink(arrayPtr)) { - arrayPtr = arrayPtr->value.linkPtr; - } - TRACE(("%u \"%.30s\" => ", opnd, part2)); - if (!TclIsVarUndefined(arrayPtr) - && TclIsVarArray(arrayPtr) - && TclIsVarUntraced(arrayPtr)) { - Tcl_HashEntry *hPtr = Tcl_FindHashEntry(arrayPtr->value.tablePtr, - part2); - if (hPtr) { - varPtr = (Var *) Tcl_GetHashValue(hPtr); - } else { - goto doLoadArrayNextBranch; - } - } else { - doLoadArrayNextBranch: - varPtr = TclLookupArrayElement(interp, part1, part2, - TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr); - if (varPtr == NULL) { - TRACE_APPEND(("ERROR: %.30s\n", - O2S(Tcl_GetObjResult(interp)))); - result = TCL_ERROR; - goto checkForCatch; - } - } - if (TclIsVarDirectReadable(varPtr) - && ((arrayPtr == NULL) || TclIsVarUntraced(arrayPtr))) { - /* - * No errors, no traces: just get the value. - */ - - objResultPtr = varPtr->value.objPtr; - TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); - NEXT_INST_F(pcAdjustment, 1, 1); - } - cleanup = 1; - goto doCallPtrGetVar; - doCallPtrGetVar: /* * There are either errors or the variable is traced: call @@ -2400,8 +2485,8 @@ TclExecuteByteCode( */ DECACHE_STACK_INFO(); - objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, - TCL_LEAVE_ERR_MSG); + objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, + TCL_LEAVE_ERR_MSG, opnd); CACHE_STACK_INFO(); if (objResultPtr) { TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); @@ -2429,64 +2514,142 @@ TclExecuteByteCode( { int opnd, pcAdjustment, storeFlags; - char *part1, *part2; + Tcl_Obj *part1Ptr, *part2Ptr; Var *varPtr, *arrayPtr; Tcl_Obj *objPtr, *valuePtr; + case INST_STORE_ARRAY4: + opnd = TclGetUInt4AtPtr(pc+1); + pcAdjustment = 5; + goto doStoreArrayDirect; + + case INST_STORE_ARRAY1: + opnd = TclGetUInt1AtPtr(pc+1); + pcAdjustment = 2; + + doStoreArrayDirect: + valuePtr = OBJ_AT_TOS; + part2Ptr = OBJ_UNDER_TOS; + arrayPtr = &(compiledLocals[opnd]); + TRACE(("%u \"%.30s\" <- \"%.30s\" => ", opnd, O2S(part2Ptr), + O2S(valuePtr))); + while (TclIsVarLink(arrayPtr)) { + arrayPtr = arrayPtr->value.linkPtr; + } + if (TclIsVarArray(arrayPtr) && !(arrayPtr->flags & VAR_TRACED_WRITE)) { + varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr); + if (varPtr && TclIsVarDirectWritable(varPtr)) { + tosPtr--; + Tcl_DecrRefCount(OBJ_AT_TOS); + OBJ_AT_TOS = valuePtr; + goto doStoreVarDirect; + } + } + cleanup = 2; + storeFlags = TCL_LEAVE_ERR_MSG; + part1Ptr = NULL; + goto doStoreArrayDirectFailed; + + case INST_STORE_SCALAR4: + opnd = TclGetUInt4AtPtr(pc+1); + pcAdjustment = 5; + goto doStoreScalarDirect; + + case INST_STORE_SCALAR1: + opnd = TclGetUInt1AtPtr(pc+1); + pcAdjustment = 2; + + doStoreScalarDirect: + valuePtr = OBJ_AT_TOS; + varPtr = &(compiledLocals[opnd]); + TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr))); + while (TclIsVarLink(varPtr)) { + varPtr = varPtr->value.linkPtr; + } + if (TclIsVarDirectWritable(varPtr)) { + doStoreVarDirect: + /* + * No traces, no errors, plain 'set': we can safely inline. The + * value *will* be set to what's requested, so that the stack top + * remains pointing to the same Tcl_Obj. + */ + + valuePtr = varPtr->value.objPtr; + if (valuePtr != NULL) { + TclDecrRefCount(valuePtr); + } + objResultPtr = OBJ_AT_TOS; + varPtr->value.objPtr = objResultPtr; +#ifndef TCL_COMPILE_DEBUG + if (*(pc+pcAdjustment) == INST_POP) { + tosPtr--; + NEXT_INST_F((pcAdjustment+1), 0, 0); + } +#else + TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); +#endif + Tcl_IncrRefCount(objResultPtr); + NEXT_INST_F(pcAdjustment, 0, 0); + } + storeFlags = TCL_LEAVE_ERR_MSG; + part1Ptr = NULL; + goto doStoreScalar; + case INST_LAPPEND_STK: valuePtr = OBJ_AT_TOS; /* value to append */ - part2 = NULL; + part2Ptr = NULL; storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE | TCL_LIST_ELEMENT | TCL_TRACE_READS); goto doStoreStk; case INST_LAPPEND_ARRAY_STK: valuePtr = OBJ_AT_TOS; /* value to append */ - part2 = TclGetString(OBJ_UNDER_TOS); + part2Ptr = OBJ_UNDER_TOS; storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE | TCL_LIST_ELEMENT | TCL_TRACE_READS); goto doStoreStk; case INST_APPEND_STK: valuePtr = OBJ_AT_TOS; /* value to append */ - part2 = NULL; + part2Ptr = NULL; storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE); goto doStoreStk; case INST_APPEND_ARRAY_STK: valuePtr = OBJ_AT_TOS; /* value to append */ - part2 = TclGetString(OBJ_UNDER_TOS); + part2Ptr = OBJ_UNDER_TOS; storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE); goto doStoreStk; case INST_STORE_ARRAY_STK: valuePtr = OBJ_AT_TOS; - part2 = TclGetString(OBJ_UNDER_TOS); + part2Ptr = OBJ_UNDER_TOS; storeFlags = TCL_LEAVE_ERR_MSG; goto doStoreStk; case INST_STORE_STK: case INST_STORE_SCALAR_STK: valuePtr = OBJ_AT_TOS; - part2 = NULL; + part2Ptr = NULL; storeFlags = TCL_LEAVE_ERR_MSG; doStoreStk: - objPtr = OBJ_AT_DEPTH(1 + (part2 != NULL)); /* variable name */ - part1 = TclGetString(objPtr); + objPtr = OBJ_AT_DEPTH(1 + (part2Ptr != NULL)); /* variable name */ + part1Ptr = objPtr; #ifdef TCL_COMPILE_DEBUG - if (part2 == NULL) { - TRACE(("\"%.30s\" <- \"%.30s\" =>", part1, O2S(valuePtr))); + if (part2Ptr == NULL) { + TRACE(("\"%.30s\" <- \"%.30s\" =>", O2S(part1Ptr), O2S(valuePtr))); } else { TRACE(("\"%.30s(%.30s)\" <- \"%.30s\" => ", - part1, part2, O2S(valuePtr))); + O2S(part1Ptr), O2S(part2Ptr), O2S(valuePtr))); } #endif - varPtr = TclObjLookupVar(interp, objPtr, part2, TCL_LEAVE_ERR_MSG, + varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr, TCL_LEAVE_ERR_MSG, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (varPtr) { - cleanup = ((part2 == NULL)? 2 : 3); + cleanup = ((part2Ptr == NULL)? 2 : 3); pcAdjustment = 1; + opnd = -1; goto doCallPtrSetVar; } else { TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); @@ -2520,39 +2683,21 @@ TclExecuteByteCode( storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE); goto doStoreArray; - case INST_STORE_ARRAY4: - opnd = TclGetUInt4AtPtr(pc+1); - pcAdjustment = 5; - storeFlags = TCL_LEAVE_ERR_MSG; - goto doStoreArray; - - case INST_STORE_ARRAY1: - opnd = TclGetUInt1AtPtr(pc+1); - pcAdjustment = 2; - storeFlags = TCL_LEAVE_ERR_MSG; - doStoreArray: valuePtr = OBJ_AT_TOS; - part2 = TclGetString(OBJ_UNDER_TOS); + part2Ptr = OBJ_UNDER_TOS; arrayPtr = &(compiledLocals[opnd]); - part1 = arrayPtr->name; - cleanup = 2; - TRACE(("%u \"%.30s\" <- \"%.30s\" => ", opnd, part2, O2S(valuePtr))); + TRACE(("%u \"%.30s\" <- \"%.30s\" => ", opnd, O2S(part2Ptr), + O2S(valuePtr))); while (TclIsVarLink(arrayPtr)) { arrayPtr = arrayPtr->value.linkPtr; } - if (!TclIsVarUndefined(arrayPtr) - && TclIsVarArray(arrayPtr) - && TclIsVarUntraced(arrayPtr)) { - Tcl_HashEntry *hPtr = Tcl_FindHashEntry(arrayPtr->value.tablePtr, - part2); - if (hPtr) { - varPtr = (Var *) Tcl_GetHashValue(hPtr); - goto doCallPtrSetVar; - } - } - varPtr = TclLookupArrayElement(interp, part1, part2, - TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr); + cleanup = 2; + part1Ptr = NULL; + + doStoreArrayDirectFailed: + varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, + TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr, opnd); if (varPtr) { goto doCallPtrSetVar; } else { @@ -2587,78 +2732,34 @@ TclExecuteByteCode( storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE); goto doStoreScalar; - case INST_STORE_SCALAR4: - opnd = TclGetUInt4AtPtr(pc+1); - pcAdjustment = 5; - storeFlags = TCL_LEAVE_ERR_MSG; - goto doStoreScalar; - - case INST_STORE_SCALAR1: - opnd = TclGetUInt1AtPtr(pc+1); - pcAdjustment = 2; - storeFlags = TCL_LEAVE_ERR_MSG; - doStoreScalar: valuePtr = OBJ_AT_TOS; varPtr = &(compiledLocals[opnd]); - part1 = varPtr->name; TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr))); while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } cleanup = 1; arrayPtr = NULL; - part2 = NULL; + part1Ptr = part2Ptr = NULL; doCallPtrSetVar: - if ((storeFlags == TCL_LEAVE_ERR_MSG) - && TclIsVarDirectWritable(varPtr) - && ((arrayPtr == NULL) || TclIsVarUntraced(arrayPtr))) { - /* - * No traces, no errors, plain 'set': we can safely inline. The - * value *will* be set to what's requested, so that the stack top - * remains pointing to the same Tcl_Obj. - */ - - valuePtr = varPtr->value.objPtr; - objResultPtr = OBJ_AT_TOS; - if (valuePtr != objResultPtr) { - if (valuePtr != NULL) { - TclDecrRefCount(valuePtr); - } else { - TclSetVarScalar(varPtr); - TclClearVarUndefined(varPtr); - } - varPtr->value.objPtr = objResultPtr; - Tcl_IncrRefCount(objResultPtr); - } + DECACHE_STACK_INFO(); + objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr, + part1Ptr, part2Ptr, valuePtr, storeFlags, opnd); + CACHE_STACK_INFO(); + if (objResultPtr) { #ifndef TCL_COMPILE_DEBUG if (*(pc+pcAdjustment) == INST_POP) { NEXT_INST_V((pcAdjustment+1), cleanup, 0); } -#else - TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); #endif + TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_V(pcAdjustment, cleanup, 1); } else { - DECACHE_STACK_INFO(); - objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr, - part1, part2, valuePtr, storeFlags); - CACHE_STACK_INFO(); - if (objResultPtr) { -#ifndef TCL_COMPILE_DEBUG - if (*(pc+pcAdjustment) == INST_POP) { - NEXT_INST_V((pcAdjustment+1), cleanup, 0); - } -#endif - TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); - NEXT_INST_V(pcAdjustment, cleanup, 1); - } else { - TRACE_APPEND(("ERROR: %.30s\n", - O2S(Tcl_GetObjResult(interp)))); - result = TCL_ERROR; - goto checkForCatch; - } + TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); + result = TCL_ERROR; + goto checkForCatch; } } @@ -2685,7 +2786,7 @@ TclExecuteByteCode( Tcl_WideInt w; #endif long i; - char *part1, *part2; + Tcl_Obj *part1Ptr, *part2Ptr; Var *varPtr, *arrayPtr; case INST_INCR_SCALAR1: @@ -2718,21 +2819,21 @@ TclExecuteByteCode( doIncrStk: if ((*pc == INST_INCR_ARRAY_STK_IMM) || (*pc == INST_INCR_ARRAY_STK)) { - part2 = TclGetString(OBJ_AT_TOS); + part2Ptr = OBJ_AT_TOS; objPtr = OBJ_UNDER_TOS; TRACE(("\"%.30s(%.30s)\" (by %ld) => ", - O2S(objPtr), part2, i)); + O2S(objPtr), O2S(part2Ptr), i)); } else { - part2 = NULL; + part2Ptr = NULL; objPtr = OBJ_AT_TOS; TRACE(("\"%.30s\" (by %ld) => ", O2S(objPtr), i)); } - part1 = TclGetString(objPtr); - - varPtr = TclObjLookupVar(interp, objPtr, part2, TCL_LEAVE_ERR_MSG, + part1Ptr = objPtr; + opnd = -1; + varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr, TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr); if (varPtr) { - cleanup = ((part2 == NULL)? 1 : 2); + cleanup = ((part2Ptr == NULL)? 1 : 2); goto doIncrVar; } else { Tcl_AddObjErrorInfo(interp, @@ -2751,16 +2852,16 @@ TclExecuteByteCode( pcAdjustment = 3; doIncrArray: - part2 = TclGetString(OBJ_AT_TOS); + part1Ptr = NULL; + part2Ptr = OBJ_AT_TOS; arrayPtr = &(compiledLocals[opnd]); - part1 = arrayPtr->name; cleanup = 1; while (TclIsVarLink(arrayPtr)) { arrayPtr = arrayPtr->value.linkPtr; } - TRACE(("%u \"%.30s\" (by %ld) => ", opnd, part2, i)); - varPtr = TclLookupArrayElement(interp, part1, part2, - TCL_LEAVE_ERR_MSG, "read", 1, 1, arrayPtr); + TRACE(("%u \"%.30s\" (by %ld) => ", opnd, O2S(part2Ptr), i)); + varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, + TCL_LEAVE_ERR_MSG, "read", 1, 1, arrayPtr, opnd); if (varPtr) { goto doIncrVar; } else { @@ -2780,7 +2881,7 @@ TclExecuteByteCode( varPtr = varPtr->value.linkPtr; } - if (TclIsVarDirectReadable(varPtr)) { + if (TclIsVarDirectModifyable(varPtr)) { ClientData ptr; int type; @@ -2791,13 +2892,12 @@ TclExecuteByteCode( long sum = augend + i; /* - * Test for overflow. - * TODO: faster checking with known limits on i? + * Overflow when (augend and sum have different sign) and + * (augend and i have the same sign). This is encapsulated + * in the Overflowing macro. */ - if ((augend >= 0 || i >= 0 || sum < 0) - && (sum >= 0 || i < 0 || augend < 0)) { - + if (!Overflowing(augend, i, sum)) { TRACE(("%u %ld => ", opnd, i)); if (Tcl_IsShared(objPtr)) { objPtr->refCount--; /* We know it's shared. */ @@ -2845,8 +2945,7 @@ TclExecuteByteCode( * Check for overflow. */ - if ((w >= 0 || i >= 0 || sum < 0) - && (w < 0 || i < 0 || sum >= 0)) { + if (!Overflowing(w, i, sum)) { TRACE(("%u %ld => ", opnd, i)); if (Tcl_IsShared(objPtr)) { objPtr->refCount--; /* We know it's shared. */ @@ -2898,18 +2997,16 @@ TclExecuteByteCode( doIncrScalar: varPtr = &(compiledLocals[opnd]); - part1 = varPtr->name; while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } arrayPtr = NULL; - part2 = NULL; + part1Ptr = part2Ptr = NULL; cleanup = 0; TRACE(("%u %ld => ", opnd, i)); doIncrVar: - if (TclIsVarDirectReadable(varPtr) - && ((arrayPtr == NULL) || TclIsVarUntraced(arrayPtr))) { + if (TclIsVarDirectModifyable2(varPtr, arrayPtr)) { objPtr = varPtr->value.objPtr; if (Tcl_IsShared(objPtr)) { objPtr->refCount--; /* We know it's shared */ @@ -2931,7 +3028,7 @@ TclExecuteByteCode( } else { DECACHE_STACK_INFO(); objResultPtr = TclPtrIncrObjVar(interp, varPtr, arrayPtr, - part1, part2, incrPtr, TCL_LEAVE_ERR_MSG); + part1Ptr, part2Ptr, incrPtr, TCL_LEAVE_ERR_MSG, opnd); CACHE_STACK_INFO(); Tcl_DecrRefCount(incrPtr); if (objResultPtr == NULL) { @@ -2968,12 +3065,12 @@ TclExecuteByteCode( result = TclObjGetFrame(interp, OBJ_UNDER_TOS, &framePtr); if (result != -1) { /* - * Locate the other variable + * Locate the other variable. */ savedFramePtr = iPtr->varFramePtr; iPtr->varFramePtr = framePtr; - otherPtr = TclObjLookupVar(interp, OBJ_AT_TOS, NULL, + otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL, (TCL_LEAVE_ERR_MSG), "access", /*createPart1*/ 1, /*createPart2*/ 1, &varPtr); iPtr->varFramePtr = savedFramePtr; @@ -2988,18 +3085,15 @@ TclExecuteByteCode( case INST_VARIABLE: TRACE(("variable ")); - otherPtr = TclObjLookupVar(interp, OBJ_AT_TOS, NULL, + otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL, (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access", /*createPart1*/ 1, /*createPart2*/ 1, &varPtr); if (otherPtr) { /* - * Do the [variable] magic + * Do the [variable] magic. */ - if (!TclIsVarNamespaceVar(otherPtr)) { - TclSetVarNamespaceVar(otherPtr); - otherPtr->refCount++; - } + TclSetVarNamespaceVar(otherPtr); result = TCL_OK; goto doLinkVars; } @@ -3015,12 +3109,12 @@ TclExecuteByteCode( result = TclGetNamespaceFromObj(interp, OBJ_UNDER_TOS, &nsPtr); if ((result == TCL_OK) && nsPtr) { /* - * Locate the other variable + * Locate the other variable. */ savedNsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr; - otherPtr = TclObjLookupVar(interp, OBJ_AT_TOS, NULL, + otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL, (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access", /*createPart1*/ 1, /*createPart2*/ 1, &varPtr); iPtr->varFramePtr->nsPtr = (Namespace *) savedNsPtr; @@ -3051,7 +3145,7 @@ TclExecuteByteCode( opnd = TclGetInt4AtPtr(pc+1);; varPtr = &(compiledLocals[opnd]); - if ((varPtr != otherPtr) && (varPtr->tracePtr == NULL) + if ((varPtr != otherPtr) && !TclIsVarTraced(varPtr) && (TclIsVarUndefined(varPtr) || TclIsVarLink(varPtr))) { if (!TclIsVarUndefined(varPtr)) { /* Then it is a defined link */ @@ -3059,17 +3153,20 @@ TclExecuteByteCode( if (linkPtr == otherPtr) { goto doLinkVarsDone; } - linkPtr->refCount--; - if (TclIsVarUndefined(linkPtr)) { - TclCleanupVar(linkPtr, NULL); + if (TclIsVarInHash(linkPtr)) { + VarHashRefCount(linkPtr)--; + if (TclIsVarUndefined(linkPtr)) { + TclCleanupVar(linkPtr, NULL); + } } } TclSetVarLink(varPtr); - TclClearVarUndefined(varPtr); varPtr->value.linkPtr = otherPtr; - otherPtr->refCount++; + if (TclIsVarInHash(otherPtr)) { + VarHashRefCount(otherPtr)++; + } } else { - result = TclPtrMakeUpvar(interp, otherPtr, NULL, 0, opnd); + result = TclPtrObjMakeUpvar(interp, otherPtr, NULL, 0, opnd); if (result != TCL_OK) { goto checkForCatch; } @@ -3273,20 +3370,20 @@ TclExecuteByteCode( Tcl_Obj *valuePtr, *value2Ptr; /* - * Pop the two operands + * Pop the two operands. */ value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; /* - * Extract the desired list element + * Extract the desired list element. */ objResultPtr = TclLindexList(interp, valuePtr, value2Ptr); if (objResultPtr) { /* - * Stash the list element on the stack + * Stash the list element on the stack. */ TRACE(("%.20s %.20s => %s\n", @@ -3308,7 +3405,7 @@ TclExecuteByteCode( Tcl_Obj *valuePtr; /* - * Pop the list and get the index + * Pop the list and get the index. */ valuePtr = OBJ_AT_TOS; @@ -3367,13 +3464,14 @@ TclExecuteByteCode( numIdx, &OBJ_AT_DEPTH(numIdx - 1)); /* - * Check for errors + * Check for errors. */ if (objResultPtr) { /* - * Set result + * Set result. */ + TRACE(("%d => %s\n", opnd, O2S(objResultPtr))); NEXT_INST_V(5, opnd, -1); } else { @@ -3411,19 +3509,19 @@ TclExecuteByteCode( valuePtr = OBJ_AT_TOS; /* - * Compute the new variable value + * Compute the new variable value. */ objResultPtr = TclLsetFlat(interp, value2Ptr, numIdx, &OBJ_AT_DEPTH(numIdx), valuePtr); /* - * Check for errors + * Check for errors. */ if (objResultPtr) { /* - * Set result + * Set result. */ TRACE(("%d => %s\n", opnd, O2S(objResultPtr))); @@ -3453,25 +3551,25 @@ TclExecuteByteCode( Tcl_DecrRefCount(objPtr); /* This one should be done here */ /* - * Get the new element value, and the index list + * Get the new element value, and the index list. */ valuePtr = OBJ_AT_TOS; value2Ptr = OBJ_UNDER_TOS; /* - * Compute the new variable value + * Compute the new variable value. */ objResultPtr = TclLsetList(interp, objPtr, value2Ptr, valuePtr); /* - * Check for errors + * Check for errors. */ if (objResultPtr) { /* - * Set result + * Set result. */ TRACE(("=> %s\n", O2S(objResultPtr))); @@ -3491,7 +3589,7 @@ TclExecuteByteCode( Tcl_Obj **listv, *valuePtr; /* - * Pop the list and get the indices + * Pop the list and get the indices. */ valuePtr = OBJ_AT_TOS; @@ -3507,7 +3605,7 @@ TclExecuteByteCode( /* * Skip a lot of work if we're about to throw the result away (common - * with uses of [lassign].) + * with uses of [lassign]). */ if (result == TCL_OK) { @@ -3710,7 +3808,7 @@ TclExecuteByteCode( case INST_STR_CMP: { /* - * String compare + * String compare. */ const char *s1, *s2; @@ -3835,8 +3933,9 @@ TclExecuteByteCode( case INST_STR_INDEX: { /* - * String compare + * String compare. */ + int index, length; char *bytes; Tcl_Obj *valuePtr, *value2Ptr; @@ -4297,7 +4396,7 @@ TclExecuteByteCode( } if ((l2 == 1) || (l2 == -1)) { /* - * Div. by |1| always yields remainder of 0 + * Div. by |1| always yields remainder of 0. */ objResultPtr = constants[0]; @@ -4309,7 +4408,7 @@ TclExecuteByteCode( l1 = *((const long *)ptr1); if (l1 == 0) { /* - * 0 % (non-zero) always yields remainder of 0 + * 0 % (non-zero) always yields remainder of 0. */ objResultPtr = constants[0]; @@ -4325,7 +4424,6 @@ TclExecuteByteCode( /* * Force Tcl's integer division rules. - * * TODO: examine for logic simplification */ @@ -4410,7 +4508,6 @@ TclExecuteByteCode( /* * Force Tcl's integer division rules. - * * TODO: examine for logic simplification */ @@ -4502,10 +4599,14 @@ TclExecuteByteCode( invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0); break; #endif - case TCL_NUMBER_BIG: - /* TODO: const correctness? */ - invalid = (mp_cmp_d((mp_int *)ptr2, 0) == MP_LT); + case TCL_NUMBER_BIG: { + mp_int big2; + + Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); + invalid = (mp_cmp_d(&big2, 0) == MP_LT); + mp_clear(&big2); break; + } default: /* Unused, here to silence compiler warning */ invalid = 0; @@ -4588,7 +4689,7 @@ TclExecuteByteCode( } } else { /* - * Quickly force large right shifts to 0 or -1 + * Quickly force large right shifts to 0 or -1. */ TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); @@ -4613,10 +4714,13 @@ TclExecuteByteCode( zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0); break; #endif - case TCL_NUMBER_BIG: - /* TODO: const correctness ? */ - zero = (mp_cmp_d((mp_int *)ptr1, 0) == MP_GT); + case TCL_NUMBER_BIG: { + mp_int big1; + Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); + zero = (mp_cmp_d(&big1, 0) == MP_GT); + mp_clear(&big1); break; + } default: /* Unused, here to silence compiler warning. */ zero = 0; @@ -5122,7 +5226,8 @@ TclExecuteByteCode( /* TODO: Attempts to re-use unshared operands on stack */ if (*pc == INST_EXPON) { - long l1, l2 = 0; + long l1 = 0, l2 = 0; + Tcl_WideInt w1; int oddExponent = 0, negativeExponent = 0; if (type2 == TCL_NUMBER_LONG) { @@ -5134,8 +5239,14 @@ TclExecuteByteCode( objResultPtr = constants[1]; NEXT_INST_F(1, 2, 1); + } else if (l2 == 1) { + /* + * Anything to the first power is itself + */ + NEXT_INST_F(1, 1, 0); } } + switch (type2) { case TCL_NUMBER_LONG: { negativeExponent = (l2 < 0); @@ -5233,7 +5344,282 @@ TclExecuteByteCode( result = TCL_ERROR; goto checkForCatch; } - /* TODO: Perform those computations that fit in native types */ + + if (type1 == TCL_NUMBER_LONG && type2 == TCL_NUMBER_LONG) { + if (l1 == 2) { + /* + * Reduce small powers of 2 to shifts. + */ + 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) { + TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); + objResultPtr + = Tcl_NewWideIntObj(((Tcl_WideInt) 1) << l2); + TRACE(("%s\n", O2S(objResultPtr))); + NEXT_INST_F(1, 2, 1); + } +#endif + } + if (l1 == -2) { + int signum = oddExponent ? -1 : 1; + /* + * Reduce small powers of 2 to shifts. + */ + 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) { + TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); + objResultPtr + = Tcl_NewWideIntObj(signum * + (((Tcl_WideInt) 1) << l2)); + TRACE(("%s\n", O2S(objResultPtr))); + NEXT_INST_F(1, 2, 1); + } +#endif + } +#if (LONG_MAX == 0x7fffffff) + if (l2 <= 8 && + l1 <= MaxBase32[l2-2] && l1 >= -MaxBase32[l2-2]) { + /* + * Small powers of 32-bit integers + */ + long lResult = l1 * l1; /* b**2 */ + switch (l2) { + case 2: + break; + case 3: + lResult *= l1; /* b**3 */ + break; + case 4: + lResult *= lResult; /* b**4 */ + break; + case 5: + lResult *= lResult; /* b**4 */ + lResult *= l1; /* b**5 */ + break; + case 6: + lResult *= l1; /* b**3 */ + lResult *= lResult; /* b**6 */ + break; + case 7: + lResult *= l1; /* b**3 */ + lResult *= lResult; /* b**6 */ + lResult *= l1; /* b**7 */ + break; + case 8: + lResult *= lResult; /* b**4 */ + lResult *= lResult; /* b**8 */ + break; + } + TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); + if (Tcl_IsShared(valuePtr)) { + TclNewLongObj(objResultPtr, lResult); + TRACE(("%s\n", O2S(objResultPtr))); + NEXT_INST_F(1, 2, 1); + } + Tcl_SetLongObj(valuePtr, lResult); + TRACE(("%s\n", O2S(valuePtr))); + NEXT_INST_F(1, 1, 0); + } + if (l1 >= 3 + && (unsigned long) l1 < (sizeof(Exp32Index) + / sizeof(unsigned short)) - 1) { + unsigned short base = Exp32Index[l1-3] + l2 - 9; + if (base < Exp32Index[l1-2]) { + /* + * 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]); + TRACE(("%s\n", O2S(objResultPtr))); + NEXT_INST_F(1, 2, 1); + } + Tcl_SetLongObj(valuePtr, Exp32Value[base]); + TRACE(("%s\n", O2S(valuePtr))); + NEXT_INST_F(1, 1, 0); + } + } + if (-l1 >= 3 + && (unsigned long)(-l1) < (sizeof(Exp32Index) + / sizeof(unsigned short)) - 1) { + unsigned short base = Exp32Index[-l1-3] + l2 - 9; + if (base < Exp32Index[-l1-2]) { + long lResult = (oddExponent) ? + -Exp32Value[base] : Exp32Value[base]; + /* + * 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); + TRACE(("%s\n", O2S(objResultPtr))); + NEXT_INST_F(1, 2, 1); + } + Tcl_SetLongObj(valuePtr, lResult); + TRACE(("%s\n", O2S(valuePtr))); + NEXT_INST_F(1, 1, 0); + } + } +#endif + } + if (type1 == TCL_NUMBER_LONG) { + w1 = l1; +#ifndef NO_WIDE_TYPE + } else if (type1 == TCL_NUMBER_WIDE) { + w1 = *((const Tcl_WideInt*) ptr1); +#endif + } else { + 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 + */ + Tcl_WideInt wResult = w1 * w1; /* b**2 */ + switch (l2) { + case 2: + break; + case 3: + wResult *= l1; /* b**3 */ + break; + case 4: + wResult *= wResult; /* b**4 */ + break; + case 5: + wResult *= wResult; /* b**4 */ + wResult *= w1; /* b**5 */ + break; + case 6: + wResult *= w1; /* b**3 */ + wResult *= wResult; /* b**6 */ + break; + case 7: + wResult *= w1; /* b**3 */ + wResult *= wResult; /* b**6 */ + wResult *= w1; /* b**7 */ + break; + case 8: + wResult *= wResult; /* b**4 */ + wResult *= wResult; /* b**8 */ + break; + case 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**10 */ + break; + case 11: + wResult *= wResult; /* b**4 */ + wResult *= w1; /* b**5 */ + wResult *= wResult; /* b**10 */ + wResult *= w1; /* b**11 */ + break; + case 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 */ + break; + case 14: + 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 *= wResult; /* b**14 */ + wResult *= w1; /* b**15 */ + break; + case 16: + wResult *= wResult; /* b**4 */ + wResult *= wResult; /* b**8 */ + wResult *= wResult; /* b**16 */ + break; + + } + TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); + objResultPtr = Tcl_NewWideIntObj(wResult); + TRACE(("%s\n", O2S(objResultPtr))); + NEXT_INST_F(1, 2, 1); + } + + /* + * 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] + l2 - 17; + if (base < Exp64Index[w1-2]) { + /* + * 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]); + TRACE(("%s\n", O2S(objResultPtr))); + NEXT_INST_F(1, 2, 1); + } + Tcl_SetWideIntObj(valuePtr, Exp64Value[base]); + TRACE(("%s\n", O2S(valuePtr))); + NEXT_INST_F(1, 1, 0); + } + } + if (-w1 >= 3 + && (Tcl_WideUInt) (-w1) < (sizeof(Exp64Index) + / sizeof(unsigned short)) - 1) { + unsigned short base = Exp64Index[-w1-3] + l2 - 17; + if (base < Exp64Index[-w1-2]) { + Tcl_WideInt wResult = (oddExponent) ? + -Exp64Value[base] : Exp64Value[base]; + /* + * 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); + TRACE(("%s\n", O2S(objResultPtr))); + NEXT_INST_F(1, 2, 1); + } + Tcl_SetWideIntObj(valuePtr, wResult); + TRACE(("%s\n", O2S(valuePtr))); + NEXT_INST_F(1, 1, 0); + } + } +#endif + goto overflow; } @@ -5254,8 +5640,7 @@ TclExecuteByteCode( * Check for overflow. */ - if (((w1 < 0) && (w2 < 0) && (wResult >= 0)) - || ((w1 > 0) && (w2 > 0) && (wResult < 0))) { + if (Overflowing(w1, w2, wResult)) { goto overflow; } } @@ -5268,11 +5653,17 @@ TclExecuteByteCode( #endif { /* - * Must check for overflow. + * 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. */ - if (((w1 < 0) && (w2 > 0) && (wResult > 0)) - || ((w1 >= 0) && (w2 < 0) && (wResult < 0))) { + if (Overflowing(w1, ~w2, wResult)) { goto overflow; } } @@ -5681,8 +6072,6 @@ TclExecuteByteCode( } else { TclSetLongObj(oldValuePtr, -1); } - TclSetVarScalar(iterVarPtr); - TclClearVarUndefined(iterVarPtr); TRACE(("%u => loop iter count temp %d\n", opnd, iterTmpIndex)); #ifndef TCL_COMPILE_DEBUG @@ -5712,7 +6101,6 @@ TclExecuteByteCode( int iterNum, listTmpIndex, listLen, numVars; int varIndex, valIndex, continueLoop, j; long i; - char *part1; opnd = TclGetUInt4AtPtr(pc+1); infoPtr = (ForeachInfo *) codePtr->auxDataArrayPtr[opnd].clientData; @@ -5782,7 +6170,6 @@ TclExecuteByteCode( varIndex = varListPtr->varIndexes[j]; varPtr = &(compiledLocals[varIndex]); - part1 = varPtr->name; while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } @@ -5791,17 +6178,14 @@ TclExecuteByteCode( if (valuePtr != value2Ptr) { if (value2Ptr != NULL) { TclDecrRefCount(value2Ptr); - } else { - TclSetVarScalar(varPtr); - TclClearVarUndefined(varPtr); } varPtr->value.objPtr = valuePtr; Tcl_IncrRefCount(valuePtr); } } else { DECACHE_STACK_INFO(); - value2Ptr = TclPtrSetVar(interp, varPtr, NULL, part1, - NULL, valuePtr, TCL_LEAVE_ERR_MSG); + value2Ptr = TclPtrSetVar(interp, varPtr, NULL, NULL, + NULL, valuePtr, TCL_LEAVE_ERR_MSG, varIndex); CACHE_STACK_INFO(); if (value2Ptr == NULL) { TRACE_WITH_OBJ(( @@ -5887,7 +6271,6 @@ TclExecuteByteCode( int opnd, opnd2, allocateDict; Tcl_Obj *dictPtr, *valPtr; Var *varPtr; - char *part1; case INST_DICT_GET: opnd = TclGetUInt4AtPtr(pc+1); @@ -5932,7 +6315,6 @@ TclExecuteByteCode( opnd2 = TclGetUInt4AtPtr(pc+5); varPtr = &(compiledLocals[opnd2]); - part1 = varPtr->name; while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } @@ -5941,7 +6323,7 @@ TclExecuteByteCode( dictPtr = varPtr->value.objPtr; } else { DECACHE_STACK_INFO(); - dictPtr = TclPtrGetVar(interp, varPtr, NULL, part1, NULL, 0); + dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd2); CACHE_STACK_INFO(); } if (dictPtr == NULL) { @@ -6010,9 +6392,6 @@ TclExecuteByteCode( Tcl_IncrRefCount(dictPtr); if (oldValuePtr != NULL) { Tcl_DecrRefCount(oldValuePtr); - } else { - TclSetVarScalar(varPtr); - TclClearVarUndefined(varPtr); } varPtr->value.objPtr = dictPtr; } @@ -6020,8 +6399,8 @@ TclExecuteByteCode( } else { Tcl_IncrRefCount(dictPtr); DECACHE_STACK_INFO(); - objResultPtr = TclPtrSetVar(interp, varPtr, NULL, part1, NULL, - dictPtr, TCL_LEAVE_ERR_MSG); + objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL, + dictPtr, TCL_LEAVE_ERR_MSG, opnd2); CACHE_STACK_INFO(); Tcl_DecrRefCount(dictPtr); if (objResultPtr == NULL) { @@ -6045,7 +6424,6 @@ TclExecuteByteCode( cleanup = 2; varPtr = &(compiledLocals[opnd]); - part1 = varPtr->name; while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } @@ -6054,7 +6432,7 @@ TclExecuteByteCode( dictPtr = varPtr->value.objPtr; } else { DECACHE_STACK_INFO(); - dictPtr = TclPtrGetVar(interp, varPtr, NULL, part1, NULL, 0); + dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd); CACHE_STACK_INFO(); } if (dictPtr == NULL) { @@ -6132,9 +6510,6 @@ TclExecuteByteCode( Tcl_IncrRefCount(dictPtr); if (oldValuePtr != NULL) { Tcl_DecrRefCount(oldValuePtr); - } else { - TclSetVarScalar(varPtr); - TclClearVarUndefined(varPtr); } varPtr->value.objPtr = dictPtr; } @@ -6142,8 +6517,8 @@ TclExecuteByteCode( } else { Tcl_IncrRefCount(dictPtr); DECACHE_STACK_INFO(); - objResultPtr = TclPtrSetVar(interp, varPtr, NULL, part1, NULL, - dictPtr, TCL_LEAVE_ERR_MSG); + objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL, + dictPtr, TCL_LEAVE_ERR_MSG, opnd); CACHE_STACK_INFO(); Tcl_DecrRefCount(dictPtr); if (objResultPtr == NULL) { @@ -6184,14 +6559,13 @@ TclExecuteByteCode( statePtr->typePtr = &dictIteratorType; statePtr->internalRep.twoPtrValue.ptr1 = (void *) searchPtr; statePtr->internalRep.twoPtrValue.ptr2 = (void *) dictPtr; - varPtr = compiledLocals + opnd; - if (varPtr->value.objPtr == NULL) { - TclSetVarScalar(compiledLocals + opnd); - TclClearVarUndefined(compiledLocals + opnd); - } else if (varPtr->value.objPtr->typePtr == &dictIteratorType) { - Tcl_Panic("mis-issued dictFirst!"); - } else { - Tcl_DecrRefCount(varPtr->value.objPtr); + varPtr = (compiledLocals + opnd); + if (varPtr->value.objPtr) { + if (varPtr->value.objPtr->typePtr != &dictIteratorType) { + Tcl_DecrRefCount(varPtr->value.objPtr); + } else { + Tcl_Panic("mis-issued dictFirst!"); + } } varPtr->value.objPtr = statePtr; Tcl_IncrRefCount(statePtr); @@ -6261,14 +6635,12 @@ TclExecuteByteCode( Tcl_Obj **keyPtrPtr, *dictPtr; DictUpdateInfo *duiPtr; Var *varPtr; - char *part1; case INST_DICT_UPDATE_START: opnd = TclGetUInt4AtPtr(pc+1); opnd2 = TclGetUInt4AtPtr(pc+5); varPtr = &(compiledLocals[opnd]); duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData; - part1 = varPtr->name; while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } @@ -6277,8 +6649,8 @@ TclExecuteByteCode( dictPtr = varPtr->value.objPtr; } else { DECACHE_STACK_INFO(); - dictPtr = TclPtrGetVar(interp, varPtr, NULL, part1, NULL, - TCL_LEAVE_ERR_MSG); + dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, + TCL_LEAVE_ERR_MSG, opnd); CACHE_STACK_INFO(); if (dictPtr == NULL) { goto dictUpdateStartFailed; @@ -6299,15 +6671,17 @@ TclExecuteByteCode( goto dictUpdateStartFailed; } varPtr = &(compiledLocals[duiPtr->varIndices[i]]); - part1 = varPtr->name; while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } DECACHE_STACK_INFO(); if (valPtr == NULL) { - Tcl_UnsetVar(interp, part1, 0); - } else if (TclPtrSetVar(interp, varPtr, NULL, part1, NULL, - valPtr, TCL_LEAVE_ERR_MSG) == NULL) { + TclObjUnsetVar2(interp, + localName(iPtr->varFramePtr, duiPtr->varIndices[i]), + NULL, 0); + } else if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL, + valPtr, TCL_LEAVE_ERR_MSG, + duiPtr->varIndices[i]) == NULL) { CACHE_STACK_INFO(); dictUpdateStartFailed: cleanup = 1; @@ -6323,7 +6697,6 @@ TclExecuteByteCode( opnd2 = TclGetUInt4AtPtr(pc+5); varPtr = &(compiledLocals[opnd]); duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData; - part1 = varPtr->name; while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } @@ -6332,7 +6705,7 @@ TclExecuteByteCode( dictPtr = varPtr->value.objPtr; } else { DECACHE_STACK_INFO(); - dictPtr = TclPtrGetVar(interp, varPtr, NULL, part1, NULL, 0); + dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd); CACHE_STACK_INFO(); } if (dictPtr == NULL) { @@ -6352,10 +6725,8 @@ TclExecuteByteCode( for (i=0 ; ivarIndices[i]]); - part1a = var2Ptr->name; while (TclIsVarLink(var2Ptr)) { var2Ptr = var2Ptr->value.linkPtr; } @@ -6363,7 +6734,8 @@ TclExecuteByteCode( valPtr = var2Ptr->value.objPtr; } else { DECACHE_STACK_INFO(); - valPtr = TclPtrGetVar(interp, var2Ptr, NULL, part1a, NULL, 0); + valPtr = TclPtrGetVar(interp, var2Ptr, NULL, NULL, NULL, 0, + duiPtr->varIndices[i]); CACHE_STACK_INFO(); } if (valPtr == NULL) { @@ -6378,8 +6750,8 @@ TclExecuteByteCode( varPtr->value.objPtr = dictPtr; } else { DECACHE_STACK_INFO(); - objResultPtr = TclPtrSetVar(interp, varPtr, NULL, part1, NULL, - dictPtr, TCL_LEAVE_ERR_MSG); + objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL, + dictPtr, TCL_LEAVE_ERR_MSG, opnd); CACHE_STACK_INFO(); if (objResultPtr == NULL) { if (allocdict) { @@ -6424,7 +6796,7 @@ TclExecuteByteCode( goto checkForCatch; /* - * Block for variables needed to process exception returns + * Block for variables needed to process exception returns. */ { @@ -6530,7 +6902,9 @@ TclExecuteByteCode( if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { bytes = GetSrcInfoForPc(pc, codePtr, &length); if (bytes != NULL) { + DECACHE_STACK_INFO(); Tcl_LogCommandInfo(interp, codePtr->source, bytes, length); + CACHE_STACK_INFO(); } } iPtr->flags &= ~ERR_ALREADY_LOGGED; @@ -6858,7 +7232,7 @@ IllegalExprOperandType( /* *---------------------------------------------------------------------- * - * TclGetSrcInfoForPc, GetSrcInfoForPc -- + * TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSrcInfoForCmd -- * * Given a program counter value, finds the closest command in the * bytecode code unit's CmdLocation array and returns information about @@ -6879,6 +7253,18 @@ IllegalExprOperandType( *---------------------------------------------------------------------- */ +const char * +TclGetSrcInfoForCmd( + Interp *iPtr, + int *lenPtr) +{ + CmdFrame *cfPtr = iPtr->cmdFramePtr; + ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr; + + return GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc, + codePtr, lenPtr); +} + void TclGetSrcInfoForPc( CmdFrame *cfPtr) diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index 9890168..00d473b 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -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: tclGetDate.y,v 1.35.2.1 2007/07/01 17:31:24 dgp Exp $ + * RCS: @(#) $Id: tclGetDate.y,v 1.35.2.2 2007/09/04 17:43:50 dgp Exp $ */ %{ @@ -85,7 +85,7 @@ typedef struct DateInfo { #define YYLEX_PARAM info #define YYMALLOC ckalloc -#define YYFREE ckfree +#define YYFREE(x) (ckfree((void*) (x))) #define yyDSTmode (((DateInfo *) info)->dateDSTmode) #define yyDayOrdinal (((DateInfo *) info)->dateDayOrdinal) diff --git a/generic/tclHash.c b/generic/tclHash.c index dcd7aa0..3209151 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.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: tclHash.c,v 1.29.2.1 2007/07/03 02:28:36 dgp Exp $ + * RCS: @(#) $Id: tclHash.c,v 1.29.2.2 2007/09/04 17:43:50 dgp Exp $ */ #include "tclInt.h" @@ -343,6 +343,7 @@ Tcl_CreateHashEntry( } else { hPtr = (Tcl_HashEntry *) ckalloc((unsigned) sizeof(Tcl_HashEntry)); hPtr->key.oneWordValue = (char *) key; + hPtr->clientData = 0; } hPtr->tablePtr = tablePtr; @@ -355,7 +356,6 @@ Tcl_CreateHashEntry( hPtr->nextPtr = *hPtr->bucketPtr; *hPtr->bucketPtr = hPtr; #endif - hPtr->clientData = 0; tablePtr->numEntries++; /* @@ -724,6 +724,7 @@ AllocArrayEntry( count > 0; count--, iPtr1++, iPtr2++) { *iPtr2 = *iPtr1; } + hPtr->clientData = 0; return hPtr; } @@ -831,7 +832,7 @@ AllocStringEntry( } hPtr = (Tcl_HashEntry *) ckalloc(size); strcpy(hPtr->key.string, string); - + hPtr->clientData = 0; return hPtr; } diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 5725e45..eac627a 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -17,7 +17,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOUtil.c,v 1.145 2007/04/25 19:09:03 kennykb Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.145.2.1 2007/09/04 17:43:50 dgp Exp $ */ #include "tclInt.h" @@ -1569,22 +1569,16 @@ TclGetOpenModeEx( mode = O_WRONLY|O_CREAT|O_TRUNC; break; case 'a': - /* [Bug 680143]. - * Added O_APPEND for proper automatic - * seek-to-end-on-write by the OS. + /* + * Added O_APPEND for proper automatic seek-to-end-on-write by the + * OS. [Bug 680143] */ + mode = O_WRONLY|O_CREAT|O_APPEND; *seekFlagPtr = 1; break; default: - error: - *seekFlagPtr = 0; - *binaryPtr = 0; - if (interp != NULL) { - Tcl_AppendResult(interp, "illegal access mode \"", modeString, - "\"", NULL); - } - return -1; + goto error; } i=1; while (i<3 && modeString[i]) { @@ -1593,7 +1587,12 @@ TclGetOpenModeEx( } switch (modeString[i++]) { case '+': - mode &= ~(O_RDONLY|O_WRONLY); + /* + * Must remove the O_APPEND flag so that the seek command + * works. [Bug 1773127] + */ + + mode &= ~(O_RDONLY|O_WRONLY|O_APPEND); mode |= O_RDWR; break; case 'b': @@ -1607,6 +1606,15 @@ TclGetOpenModeEx( goto error; } return mode; + + error: + *seekFlagPtr = 0; + *binaryPtr = 0; + if (interp != NULL) { + Tcl_AppendResult(interp, "illegal access mode \"", modeString, + "\"", NULL); + } + return -1; } /* diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 0f666c7..4f544cd 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -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: tclInt.decls,v 1.108.2.2 2007/06/21 16:04:56 dgp Exp $ +# RCS: @(#) $Id: tclInt.decls,v 1.108.2.3 2007/09/04 17:43:51 dgp Exp $ library tcl @@ -73,7 +73,7 @@ declare 11 generic { void TclDeleteCompiledLocalVars(Interp *iPtr, CallFrame *framePtr) } declare 12 generic { - void TclDeleteVars(Interp *iPtr, Tcl_HashTable *tablePtr) + void TclDeleteVars(Interp *iPtr, TclVarHashTable *tablePtr) } # Removed in 8.5 #declare 13 generic { @@ -928,6 +928,15 @@ declare 233 generic { void TclGetSrcInfoForPc(CmdFrame *contextPtr) } +# Exports for VarReform compat: Itcl, XOTcl like to peek into our varTables :( +declare 234 generic { + Var *TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key, + int *newPtr) +} +declare 235 generic { + void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr) +} + ############################################################################## # Define the platform specific internal Tcl interface. These functions are diff --git a/generic/tclInt.h b/generic/tclInt.h index 90ba721..f7bd3bd 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -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: tclInt.h,v 1.310.2.7 2007/07/03 02:28:36 dgp Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.310.2.8 2007/09/04 17:43:52 dgp Exp $ */ #ifndef _TCLINT @@ -81,7 +81,7 @@ typedef int ptrdiff_t; # ifdef BIG_ENDIAN # if BYTE_ORDER == BIG_ENDIAN # undef WORDS_BIGENDIAN -# define WORDS_BIGENDIAN +# define WORDS_BIGENDIAN 1 # endif # endif # ifdef LITTLE_ENDIAN @@ -119,7 +119,7 @@ typedef int ptrdiff_t; */ #if !defined(INT2PTR) && !defined(PTR2INT) -# if defined(HAVE_INTPTR_T) || defined(intptr_t) +# if defined(HAVE_INTPTR_T) || defined(intptr_t) # define INT2PTR(p) ((void*)(intptr_t)(p)) # define PTR2INT(p) ((int)(intptr_t)(p)) # else @@ -171,14 +171,16 @@ typedef int (Tcl_ResolveCmdProc) (Tcl_Interp *interp, CONST84 char *name, Tcl_Namespace *context, int flags, Tcl_Command *rPtr); typedef struct Tcl_ResolverInfo { - Tcl_ResolveCmdProc *cmdResProc; /* Procedure handling command name - * resolution. */ - Tcl_ResolveVarProc *varResProc; /* Procedure handling variable name - * resolution for variables that - * can only be handled at runtime. */ + Tcl_ResolveCmdProc *cmdResProc; + /* Procedure handling command name + * resolution. */ + Tcl_ResolveVarProc *varResProc; + /* Procedure handling variable name resolution + * for variables that can only be handled at + * runtime. */ Tcl_ResolveCompiledVarProc *compiledVarResProc; - /* Procedure handling variable name - * resolution at compile time. */ + /* Procedure handling variable name resolution + * at compile time. */ } Tcl_ResolverInfo; /* @@ -191,6 +193,26 @@ typedef struct Tcl_Ensemble Tcl_Ensemble; typedef struct NamespacePathEntry NamespacePathEntry; /* + * Special hashtable for variables: this is just a Tcl_HashTable with an nsPtr + * field added at the end: in this way variables can find their namespace + * without having to copy a pointer in their struct: they can access it via + * their hPtr->tablePtr. + */ + +typedef struct TclVarHashTable { + Tcl_HashTable table; + struct Namespace *nsPtr; +} TclVarHashTable; + +/* + * This is for itcl - it likes to search our varTables directly :( + */ + +#define TclVarHashFindVar(tablePtr, key) \ + TclVarHashCreateVar((tablePtr), (key), NULL) + + +/* * The structure below defines a namespace. * Note: the first five fields must match exactly the fields in a * Tcl_Namespace structure (see tcl.h). If you change one, be sure to change @@ -234,7 +256,7 @@ typedef struct Namespace { * ImportedCmdRef structure) to the Command * structure in the source namespace's command * table. */ - Tcl_HashTable varTable; /* Contains all the (global) variables + TclVarHashTable varTable; /* Contains all the (global) variables * currently in this namespace. Indexed by * strings; values have type (Var *). */ char **exportArrayPtr; /* Points to an array of string patterns @@ -347,7 +369,7 @@ struct NamespacePathEntry { /* * Flags passed to TclGetNamespaceForQualName: * - * TCL_GLOBAL_ONLY - (see tcl.h) Look only in the global ns. + * TCL_GLOBAL_ONLY - (see tcl.h) Look only in the global ns. * TCL_NAMESPACE_ONLY - (see tcl.h) Look only in the context ns. * TCL_CREATE_NS_IF_UNKNOWN - Create unknown namespaces. * TCL_FIND_ONLY_NS - The name sought is a namespace name. @@ -497,10 +519,12 @@ typedef struct ArraySearch { */ typedef struct Var { + int flags; /* Miscellaneous bits of information about + * variable. See below for definitions. */ union { Tcl_Obj *objPtr; /* The variable's object value. Used for * scalar variables and array elements. */ - Tcl_HashTable *tablePtr;/* For array variables, this points to + TclVarHashTable *tablePtr;/* For array variables, this points to * information about the hash table used to * implement the associative array. Points to * ckalloc-ed data. */ @@ -509,48 +533,30 @@ typedef struct Var { * "upvar", this field points to the * referenced variable's Var struct. */ } value; - char *name; /* NULL if the variable is in a hashtable, - * otherwise points to the variable's name. It - * is used, e.g., by TclLookupVar and "info - * locals". The storage for the characters of - * the name is not owned by the Var and must - * not be freed when freeing the Var. */ - Namespace *nsPtr; /* Points to the namespace that contains this - * variable or NULL if the variable is a local - * variable in a Tcl procedure. */ - Tcl_HashEntry *hPtr; /* If variable is in a hashtable, either the - * hash table entry that refers to this - * variable or NULL if the variable has been - * detached from its hash table (e.g. an array - * is deleted, but some of its elements are - * still referred to in upvars). NULL if the - * variable is not in a hashtable. This is - * used to delete an variable from its - * hashtable if it is no longer needed. */ - int refCount; /* Counts number of active uses of this - * variable, not including its entry in the - * call frame or the hash table: 1 for each - * additional variable whose linkPtr points - * here, 1 for each nested trace active on - * variable, and 1 if the variable is a - * namespace variable. This record can't be - * deleted until refCount becomes 0. */ - VarTrace *tracePtr; /* First in list of all traces set for this - * variable. */ - ArraySearch *searchPtr; /* First in list of all searches active for - * this variable, or NULL if none. */ - int flags; /* Miscellaneous bits of information about - * variable. See below for definitions. */ } Var; -/* - * Flag bits for variables. The first three (VAR_SCALAR, VAR_ARRAY, and - * VAR_LINK) are mutually exclusive and give the "type" of the variable. - * VAR_UNDEFINED is independent of the variable's type. +typedef struct VarInHash { + Var var; + int refCount; /* Counts number of active uses of this + * variable: 1 for the entry in the hash + * table, 1 for each additional variable whose + * linkPtr points here, 1 for each nested + * trace active on variable, and 1 if the + * variable is a namespace variable. This + * record can't be deleted until refCount + * becomes 0. */ + Tcl_HashEntry entry; /* The hash table entry that refers to this + * variable. This is used to find the name of + * the variable and to delete it from its + * hashtable if it is no longer needed. It + * also holds the variable's name. */ +} VarInHash; + +/* + * Flag bits for variables. The first two (VAR_ARRAY and VAR_LINK) are + * mutually exclusive and give the "type" of the variable. If none is set, + * this is a scalar variable. * - * VAR_SCALAR - 1 means this is a scalar variable and not an - * array or link. The "objPtr" field points to - * the variable's value, a Tcl object. * VAR_ARRAY - 1 means this is an array variable rather than * a scalar variable or link. The "tablePtr" * field points to the array's hashtable for its @@ -562,21 +568,17 @@ typedef struct Var { * through "upvar" and "global" commands, or * through references to variables in enclosing * namespaces. - * VAR_UNDEFINED - 1 means that the variable is in the process of - * being deleted. An undefined variable logically - * does not exist and survives only while it has - * a trace, or if it is a global variable - * currently being used by some procedure. + * + * Flags that indicate the type and status of storage; none is set for + * compiled local variables (Var structs). + * * VAR_IN_HASHTABLE - 1 means this variable is in a hashtable and * the Var structure is malloced. 0 if it is a * local variable that was assigned a slot in a * procedure frame by the compiler so the Var * storage is part of the call frame. - * VAR_TRACE_ACTIVE - 1 means that trace processing is currently - * underway for a read or write access, so new - * read or write accesses should not cause trace - * procedures to be called and the variable can't - * be deleted. + * VAR_DEAD_HASH 1 means that this var's entry in the hashtable + * has already been deleted. * VAR_ARRAY_ELEMENT - 1 means that this variable is an array * element, so it is not legal for it to be an * array itself (the VAR_ARRAY flag had better @@ -590,6 +592,19 @@ typedef struct Var { * incremented to reflect the "reference" from * its namespace. * + * Flag values relating to the variable's trace and search status. + * + * VAR_TRACED_READ + * VAR_TRACED_WRITE + * VAR_TRACED_UNSET + * VAR_TRACED_ARRAY + * VAR_TRACE_ACTIVE - 1 means that trace processing is currently + * underway for a read or write access, so new + * read or write accesses should not cause trace + * procedures to be called and the variable can't + * be deleted. + * VAR_SEARCH_ACTIVE + * * The following additional flags are used with the CompiledLocal type defined * below: * @@ -600,21 +615,50 @@ typedef struct Var { * name. * VAR_RESOLVED - 1 if name resolution has been done for this * variable. + * VAR_IS_ARGS 1 if this variable is the last argument and is + * named "args". + */ + +/* + * FLAGS RENUMBERED: everything breaks already, make things simpler. + * + * IMPORTANT: skip the values 0x10, 0x20, 0x40, 0x800 corresponding to + * TCL_TRACE_(READS/WRITES/UNSETS/ARRAY): makes code simpler in tclTrace.c + * + * Keep the flag values for VAR_ARGUMENT and VAR_TEMPORARY so that old values + * in precompiled scripts keep working. */ -#define VAR_SCALAR 0x1 -#define VAR_ARRAY 0x2 -#define VAR_LINK 0x4 -#define VAR_UNDEFINED 0x8 -#define VAR_IN_HASHTABLE 0x10 -#define VAR_TRACE_ACTIVE 0x20 -#define VAR_ARRAY_ELEMENT 0x40 -#define VAR_NAMESPACE_VAR 0x80 -#define VAR_ARGUMENT 0x100 -#define VAR_TEMPORARY 0x200 -#define VAR_RESOLVED 0x400 -#define VAR_IS_ARGS 0x800 +/* Type of value (0 is scalar) */ +#define VAR_ARRAY 0x1 +#define VAR_LINK 0x2 + +/* Type of storage (0 is compiled local) */ +#define VAR_IN_HASHTABLE 0x4 +#define VAR_DEAD_HASH 0x8 +#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) + +/* 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_TRACE_ACTIVE 0x2000 +#define VAR_SEARCH_ACTIVE 0x4000 +#define VAR_ALL_TRACES \ + (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_IS_ARGS 0x400 +#define VAR_RESOLVED 0x8000 /* * Macros to ensure that various flag bits are set properly for variables. @@ -629,22 +673,22 @@ typedef struct Var { */ #define TclSetVarScalar(varPtr) \ - (varPtr)->flags = ((varPtr)->flags & ~(VAR_ARRAY|VAR_LINK)) | VAR_SCALAR + (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK) #define TclSetVarArray(varPtr) \ - (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_LINK)) | VAR_ARRAY + (varPtr)->flags = ((varPtr)->flags & ~VAR_LINK) | VAR_ARRAY #define TclSetVarLink(varPtr) \ - (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_ARRAY)) | VAR_LINK + (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_LINK #define TclSetVarArrayElement(varPtr) \ (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_ARRAY_ELEMENT #define TclSetVarUndefined(varPtr) \ - (varPtr)->flags |= VAR_UNDEFINED + (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK);\ + (varPtr)->value.objPtr = NULL -#define TclClearVarUndefined(varPtr) \ - (varPtr)->flags &= ~VAR_UNDEFINED +#define TclClearVarUndefined(varPtr) #define TclSetVarTraceActive(varPtr) \ (varPtr)->flags |= VAR_TRACE_ACTIVE @@ -653,10 +697,16 @@ typedef struct Var { (varPtr)->flags &= ~VAR_TRACE_ACTIVE #define TclSetVarNamespaceVar(varPtr) \ - (varPtr)->flags |= VAR_NAMESPACE_VAR + if (!TclIsVarNamespaceVar(varPtr)) {\ + (varPtr)->flags |= VAR_NAMESPACE_VAR;\ + ((VarInHash *)(varPtr))->refCount++;\ + } #define TclClearVarNamespaceVar(varPtr) \ - (varPtr)->flags &= ~VAR_NAMESPACE_VAR + if (TclIsVarNamespaceVar(varPtr)) {\ + (varPtr)->flags &= ~VAR_NAMESPACE_VAR;\ + ((VarInHash *)(varPtr))->refCount--;\ + } /* * Macros to read various flag bits of variables. @@ -673,7 +723,7 @@ typedef struct Var { */ #define TclIsVarScalar(varPtr) \ - ((varPtr)->flags & VAR_SCALAR) + !((varPtr)->flags & (VAR_ARRAY|VAR_LINK)) #define TclIsVarLink(varPtr) \ ((varPtr)->flags & VAR_LINK) @@ -682,7 +732,7 @@ typedef struct Var { ((varPtr)->flags & VAR_ARRAY) #define TclIsVarUndefined(varPtr) \ - ((varPtr)->flags & VAR_UNDEFINED) + ((varPtr)->value.objPtr == NULL) #define TclIsVarArrayElement(varPtr) \ ((varPtr)->flags & VAR_ARRAY_ELEMENT) @@ -702,24 +752,50 @@ typedef struct Var { #define TclIsVarTraceActive(varPtr) \ ((varPtr)->flags & VAR_TRACE_ACTIVE) -#define TclIsVarUntraced(varPtr) \ - ((varPtr)->tracePtr == NULL) +#define TclIsVarTraced(varPtr) \ + ((varPtr)->flags & VAR_ALL_TRACES) + +#define TclIsVarInHash(varPtr) \ + ((varPtr)->flags & VAR_IN_HASHTABLE) + +#define TclIsVarDeadHash(varPtr) \ + ((varPtr)->flags & VAR_DEAD_HASH) + +#define TclGetVarNsPtr(varPtr) \ + (TclIsVarInHash(varPtr) \ + ? ((TclVarHashTable *) ((((VarInHash *) (varPtr))->entry.tablePtr)))->nsPtr \ + : NULL) + +#define VarHashRefCount(varPtr) \ + ((VarInHash *) (varPtr))->refCount /* * Macros for direct variable access by TEBC */ #define TclIsVarDirectReadable(varPtr) \ - (TclIsVarScalar(varPtr) \ - && !TclIsVarUndefined(varPtr) \ - && TclIsVarUntraced(varPtr)) + ( !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ)) \ + && (varPtr)->value.objPtr) #define TclIsVarDirectWritable(varPtr) \ - ( !(((varPtr)->flags & VAR_IN_HASHTABLE) \ - && ((varPtr)->hPtr == NULL)) \ - && TclIsVarUntraced(varPtr) \ - && (TclIsVarScalar(varPtr) \ - || TclIsVarUndefined(varPtr))) + !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_WRITE|VAR_DEAD_HASH)) + +#define TclIsVarDirectModifyable(varPtr) \ + ( !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ|VAR_TRACED_WRITE)) \ + && (varPtr)->value.objPtr) + +#define TclIsVarDirectReadable2(varPtr, arrayPtr) \ + (TclIsVarDirectReadable(varPtr) &&\ + (!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_READ))) + +#define TclIsVarDirectWritable2(varPtr, arrayPtr) \ + (TclIsVarDirectWritable(varPtr) &&\ + (!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_WRITE))) + +#define TclIsVarDirectModifyable2(varPtr, arrayPtr) \ + (TclIsVarDirectModifyable(varPtr) &&\ + (!(arrayPtr) || !((arrayPtr)->flags & (VAR_TRACED_READ|VAR_TRACED_WRITE)))) + /* *---------------------------------------------------------------- @@ -760,9 +836,8 @@ typedef struct CompiledLocal { * variables in the procedure call frame. */ int flags; /* Flag bits for the local variable. Same as * the flags for the Var structure above, - * although only VAR_SCALAR, VAR_ARRAY, - * VAR_LINK, VAR_ARGUMENT, VAR_TEMPORARY, and - * VAR_RESOLVED make sense. */ + * although only VAR_ARGUMENT, VAR_TEMPORARY, + * and VAR_RESOLVED make sense. */ Tcl_Obj *defValuePtr; /* Pointer to the default value of an * argument, if any. NULL if not an argument * or, if an argument, no default value. */ @@ -900,6 +975,22 @@ typedef struct AssocData { * Tcl_CallFrame structure in tcl.h. If you change one, change the other. */ +/* + * Will be grown to contain: pointers to the varnames (allocated at the end), + * plus the init values for each variable (suitable to be memcopied on init) + */ + +typedef struct LocalCache { + int refCount; + int numVars; + Tcl_Obj *varName0; +} LocalCache; + +#define localName(framePtr, i) \ + ((&((framePtr)->localCachePtr->varName0))[(i)]) + +MODULE_SCOPE void TclFreeLocalCache(Tcl_Interp *interp, LocalCache *localCachePtr); + typedef struct CallFrame { Namespace *nsPtr; /* Points to the namespace used to resolve * commands and global variables. */ @@ -933,7 +1024,8 @@ typedef struct CallFrame { * the number of compiled local variables * (local variables assigned entries ["slots"] * in the compiledLocals array below). */ - Tcl_HashTable *varTablePtr; /* Hash table containing local variables not + TclVarHashTable *varTablePtr; + /* Hash table containing local variables not * recognized by the compiler, or created at * execution time through, e.g., upvar. * Initially NULL and created if needed. */ @@ -952,6 +1044,7 @@ typedef struct CallFrame { * have some means of discovering what the * meaning of the value is, which we do not * specify. */ + LocalCache *localCachePtr; } CallFrame; #define FRAME_IS_PROC 0x1 @@ -1104,9 +1197,8 @@ typedef void **TclHandle; *---------------------------------------------------------------- */ -#define TCL_REG_BOSONLY 002000 /* prepend \A to pattern so it only - * matches at the beginning of the - * string. */ +#define TCL_REG_BOSONLY 002000 /* Prepend \A to pattern so it only matches at + * the beginning of the string. */ /* * These are a thin layer over TclpThreadKeyDataGet and TclpThreadKeyDataSet @@ -1529,7 +1621,7 @@ typedef struct Interp { CallFrame *varFramePtr; /* Points to the call frame whose variables * are currently in use (same as framePtr * unless an "uplevel" command is - * executing). */ + * executing). */ ActiveVarTrace *activeVarTracePtr; /* First in list of active traces for interp, * or NULL if no active traces. */ @@ -1736,6 +1828,14 @@ typedef struct Interp { int packagePrefer; /* Current package selection mode. */ /* + * Hashtables for variable traces and searches + */ + + 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 + * active searches list; varPtr is the key */ + /* * Statistical information about the bytecode compiler and interpreter's * operation. */ @@ -2229,7 +2329,7 @@ MODULE_SCOPE char tclEmptyString; */ MODULE_SCOPE void TclAdvanceLines(int* line, CONST char* start, - CONST char* end); + CONST char* end); MODULE_SCOPE int TclArraySet(Tcl_Interp *interp, Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj); MODULE_SCOPE double TclBignumToDouble(mp_int *bignum); @@ -2289,6 +2389,7 @@ MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp, CONST char *modeString, int *seekFlagPtr, int *binaryPtr); MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); +MODULE_SCOPE const char *TclGetSrcInfoForCmd(Interp *iPtr, int *lenPtr); MODULE_SCOPE int TclGlob(Tcl_Interp *interp, char *pattern, Tcl_Obj *unquotedPrefix, int globFlags, Tcl_GlobTypeData *types); @@ -2296,6 +2397,12 @@ MODULE_SCOPE int TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr, Tcl_Obj *incrPtr); MODULE_SCOPE Tcl_Obj * TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags); +MODULE_SCOPE int TclInfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +MODULE_SCOPE int TclInfoVarsCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); MODULE_SCOPE void TclInitAlloc(void); MODULE_SCOPE void TclInitDbCkalloc(void); MODULE_SCOPE void TclInitDoubleConversion(void); @@ -2338,9 +2445,14 @@ MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc, 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[], 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, int numBytes, int *readPtr, char *dst); MODULE_SCOPE int TclParseHex(CONST char *src, int numBytes, @@ -2903,25 +3015,39 @@ MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp, * the public interface. */ +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); MODULE_SCOPE Var * TclLookupArrayElement(Tcl_Interp *interp, - CONST char *arrayName, CONST char *elName, + Tcl_Obj *arrayNamePtr, Tcl_Obj *elNamePtr, CONST int flags, CONST char *msg, CONST int createPart1, CONST int createPart2, - Var *arrayPtr); + Var *arrayPtr, int index); MODULE_SCOPE Tcl_Obj * TclPtrGetVar(Tcl_Interp *interp, - Var *varPtr, Var *arrayPtr, CONST char *part1, - CONST char *part2, CONST int flags); + Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr, + Tcl_Obj *part2Ptr, CONST int flags, int index); MODULE_SCOPE Tcl_Obj * TclPtrSetVar(Tcl_Interp *interp, - Var *varPtr, Var *arrayPtr, CONST char *part1, - CONST char *part2, Tcl_Obj *newValuePtr, - CONST int flags); + 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, - Var *varPtr, Var *arrayPtr, CONST char *part1, - CONST char *part2, Tcl_Obj *incrPtr, - CONST int flags); + Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr, + Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, + 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); /* + * The new extended interface to the variable traces. + */ + +MODULE_SCOPE int TclObjCallVarTraces(Interp *iPtr, Var *arrayPtr, + Var *varPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, + int flags, int leaveErrMsg, int index); + +/* *---------------------------------------------------------------- * Macros used by the Tcl core to create and release Tcl objects. * TclNewObj(objPtr) creates a new object denoting an empty string. @@ -3319,8 +3445,11 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum, (objPtr)->typePtr = &tclDoubleType #define TclNewStringObj(objPtr, s, len) \ - TclNewObj(objPtr); \ - TclInitStringRep((objPtr), (s), (len)) + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + TclInitStringRep((objPtr), (s), (len));\ + (objPtr)->typePtr = NULL #else /* TCL_MEM_DEBUG */ #define TclNewIntObj(objPtr, i) \ @@ -3364,6 +3493,18 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum, #endif /* + * ---------------------------------------------------------------------- + * Macro to use to find the offset of a field in a structure. + * Computes number of bytes from beginning of structure to a given field. + */ + +#ifdef offsetof +#define TclOffset(type, field) ((int) offsetof(type, field)) +#else +#define TclOffset(type, field) ((int) ((char *) &((type *) 0)->field)) +#endif + +/* *---------------------------------------------------------------- * Inline version of Tcl_GetCurrentNamespace and Tcl_GetGlobalNamespace */ diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 3ffca4b..8546fed 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -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: tclIntDecls.h,v 1.99.2.2 2007/06/21 16:04:56 dgp Exp $ + * RCS: @(#) $Id: tclIntDecls.h,v 1.99.2.3 2007/09/04 17:43:52 dgp Exp $ */ #ifndef _TCLINTDECLS @@ -123,7 +123,7 @@ EXTERN void TclDeleteCompiledLocalVars (Interp * iPtr, #define TclDeleteVars_TCL_DECLARED /* 12 */ EXTERN void TclDeleteVars (Interp * iPtr, - Tcl_HashTable * tablePtr); + TclVarHashTable * tablePtr); #endif /* Slot 13 is reserved */ #ifndef TclDumpMemoryInfo_TCL_DECLARED @@ -1039,6 +1039,18 @@ EXTERN int TclEvalObjEx (Tcl_Interp * interp, Tcl_Obj * objPtr, /* 233 */ EXTERN void TclGetSrcInfoForPc (CmdFrame * contextPtr); #endif +#ifndef TclVarHashCreateVar_TCL_DECLARED +#define TclVarHashCreateVar_TCL_DECLARED +/* 234 */ +EXTERN Var * TclVarHashCreateVar (TclVarHashTable * tablePtr, + const char * key, int * newPtr); +#endif +#ifndef TclInitVarHashTable_TCL_DECLARED +#define TclInitVarHashTable_TCL_DECLARED +/* 235 */ +EXTERN void TclInitVarHashTable (TclVarHashTable * tablePtr, + Namespace * nsPtr); +#endif typedef struct TclIntStubs { int magic; @@ -1066,7 +1078,7 @@ typedef struct TclIntStubs { #endif /* __WIN32__ */ int (*tclCreateProc) (Tcl_Interp * interp, Namespace * nsPtr, CONST char * procName, Tcl_Obj * argsPtr, Tcl_Obj * bodyPtr, Proc ** procPtrPtr); /* 10 */ void (*tclDeleteCompiledLocalVars) (Interp * iPtr, CallFrame * framePtr); /* 11 */ - void (*tclDeleteVars) (Interp * iPtr, Tcl_HashTable * tablePtr); /* 12 */ + void (*tclDeleteVars) (Interp * iPtr, TclVarHashTable * tablePtr); /* 12 */ void *reserved13; void (*tclDumpMemoryInfo) (FILE * outFile); /* 14 */ void *reserved15; @@ -1293,6 +1305,8 @@ typedef struct TclIntStubs { int (*tclGetNamespaceFromObj) (Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_Namespace ** nsPtrPtr); /* 231 */ int (*tclEvalObjEx) (Tcl_Interp * interp, Tcl_Obj * objPtr, int flags, const CmdFrame * invoker, int word); /* 232 */ void (*tclGetSrcInfoForPc) (CmdFrame * contextPtr); /* 233 */ + Var * (*tclVarHashCreateVar) (TclVarHashTable * tablePtr, const char * key, int * newPtr); /* 234 */ + void (*tclInitVarHashTable) (TclVarHashTable * tablePtr, Namespace * nsPtr); /* 235 */ } TclIntStubs; #ifdef __cplusplus @@ -2014,6 +2028,14 @@ extern TclIntStubs *tclIntStubsPtr; #define TclGetSrcInfoForPc \ (tclIntStubsPtr->tclGetSrcInfoForPc) /* 233 */ #endif +#ifndef TclVarHashCreateVar +#define TclVarHashCreateVar \ + (tclIntStubsPtr->tclVarHashCreateVar) /* 234 */ +#endif +#ifndef TclInitVarHashTable +#define TclInitVarHashTable \ + (tclIntStubsPtr->tclInitVarHashTable) /* 235 */ +#endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 170831f..4931ace 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.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: tclListObj.c,v 1.46 2007/04/24 22:31:39 msofer Exp $ + * RCS: @(#) $Id: tclListObj.c,v 1.46.2.1 2007/09/04 17:43:53 dgp Exp $ */ #include "tclInt.h" @@ -1108,10 +1108,17 @@ TclLindexFlat( if (index<0 || index>=listLen) { /* * Index is out of range. Break out of loop with empty result. + * First check remaining indices for validity */ + while (++i < indexCount) { + if (TclGetIntForIndex(interp, indexArray[i], -1, &index) + != TCL_OK) { + Tcl_DecrRefCount(sublistCopy); + return NULL; + } + } listPtr = Tcl_NewObj(); - i = indexCount; } else { /* * Extract the pointer to the appropriate element. diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 3f1d059..9821ce2 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.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: tclLiteral.c,v 1.30 2007/03/21 16:25:28 dgp Exp $ + * RCS: @(#) $Id: tclLiteral.c,v 1.30.2.1 2007/09/04 17:43:53 dgp Exp $ */ #include "tclInt.h" @@ -31,7 +31,7 @@ */ static int AddLocalLiteralEntry(CompileEnv *envPtr, - LiteralEntry *globalPtr, int localHash); + Tcl_Obj *objPtr, int localHash); static void ExpandLocalLiteralArray(CompileEnv *envPtr); static unsigned int HashString(const char *bytes, int length); static void RebuildLiteralTable(LiteralTable *tablePtr); @@ -216,21 +216,20 @@ TclDeleteLiteralTable( /* *---------------------------------------------------------------------- * - * TclRegisterLiteral -- + * TclCreateLiteral -- * - * Find, or if necessary create, an object in a CompileEnv literal array - * that has a string representation matching the argument string. + * Find, or if necessary create, an object in the interpreter's literal + * table that has a string representation matching the argument + * string. If nsPtr!=NULL then only literals stored for the namespace are + * considered. * * Results: - * The index in the CompileEnv's literal array that references a shared - * literal matching the string. The object is created if necessary. + * The literal object. If it was created in this call *newPtr is set to + * 1, else 0. NULL is returned if newPtr==NULL and no literal is found. * * Side effects: - * To maximize sharing, we look up the string in the interpreter's global - * literal table. If not found, we create a new shared literal in the - * global table. We then add a reference to the shared literal in the - * CompileEnv's literal array. - * + * Increments the ref count of the global LiteralEntry since the caller + * now holds a reference. * If LITERAL_ON_HEAP is set in flags, this function is given ownership * of the string: if an object is created then its string representation * is set directly from string, otherwise the string is freed. Typically, @@ -240,77 +239,29 @@ TclDeleteLiteralTable( *---------------------------------------------------------------------- */ -int -TclRegisterLiteral( - CompileEnv *envPtr, /* Points to the CompileEnv in whose object - * array an object is found or created. */ - register char *bytes, /* Points to string for which to find or - * create an object in CompileEnv's object - * array. */ - int length, /* Number of bytes in the string. If < 0, the - * string consists of all bytes up to the - * first null character. */ - int flags) /* If LITERAL_ON_HEAP then the caller already - * malloc'd bytes and ownership is passed to - * this function. If LITERAL_NS_SCOPE then - * the literal shouldnot be shared accross - * namespaces. */ +Tcl_Obj * +TclCreateLiteral( + Interp *iPtr, + char *bytes, + int length, + unsigned int hash, /* The string's hash. If -1, it will be computed here */ + int *newPtr, + Namespace *nsPtr, + int flags, + LiteralEntry **globalPtrPtr) { - Interp *iPtr = envPtr->iPtr; LiteralTable *globalTablePtr = &(iPtr->literalTable); - LiteralTable *localTablePtr = &(envPtr->localLitTable); - register LiteralEntry *globalPtr, *localPtr; - register Tcl_Obj *objPtr; - unsigned int hash; - int localHash, globalHash, objIndex; - Namespace *nsPtr; - - if (length < 0) { - length = (bytes ? strlen(bytes) : 0); - } - hash = HashString(bytes, length); - - /* - * Is the literal already in the CompileEnv's local literal array? If so, - * just return its index. - */ - - localHash = (hash & localTablePtr->mask); - for (localPtr=localTablePtr->buckets[localHash] ; localPtr!=NULL; - localPtr = localPtr->nextPtr) { - objPtr = localPtr->objPtr; - if ((objPtr->length == length) && ((length == 0) - || ((objPtr->bytes[0] == bytes[0]) - && (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) { - if (flags & LITERAL_ON_HEAP) { - ckfree(bytes); - } - objIndex = (localPtr - envPtr->literalArrayPtr); -#ifdef TCL_COMPILE_DEBUG - TclVerifyLocalLiteralTable(envPtr); -#endif /*TCL_COMPILE_DEBUG*/ - - return objIndex; - } - } - - /* - * The literal is new to this CompileEnv. Should it be shared accross - * namespaces? If it is a fully qualified name, the namespace - * specification is not needed to avoid sharing. - */ - - if ((flags & LITERAL_NS_SCOPE) && iPtr->varFramePtr - && ((length <2) || (bytes[0] != ':') || (bytes[1] != ':'))) { - nsPtr = iPtr->varFramePtr->nsPtr; - } else { - nsPtr = NULL; - } - + LiteralEntry *globalPtr; + int globalHash; + Tcl_Obj *objPtr; + /* * Is it in the interpreter's global literal table? */ + if (hash == (unsigned int) -1) { + hash = HashString(bytes, length); + } globalHash = (hash & globalTablePtr->mask); for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL; globalPtr = globalPtr->nextPtr) { @@ -320,29 +271,32 @@ TclRegisterLiteral( || ((objPtr->bytes[0] == bytes[0]) && (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) { /* - * A global literal was found. Add an entry to the CompileEnv's - * local literal array. + * A literal was found: return it */ + if (newPtr) { + *newPtr = 0; + } + if (globalPtrPtr) { + *globalPtrPtr = globalPtr; + } if (flags & LITERAL_ON_HEAP) { ckfree(bytes); } - objIndex = AddLocalLiteralEntry(envPtr, globalPtr, localHash); -#ifdef TCL_COMPILE_DEBUG - if (globalPtr->refCount < 1) { - Tcl_Panic("TclRegisterLiteral: global literal \"%.*s\" had bad refCount %d", - (length>60? 60 : length), bytes, globalPtr->refCount); - } - TclVerifyLocalLiteralTable(envPtr); -#endif /*TCL_COMPILE_DEBUG*/ - return objIndex; + globalPtr->refCount++; + return objPtr; } } + if (!newPtr) { + if (flags & LITERAL_ON_HEAP) { + ckfree(bytes); + } + return NULL; + } /* * The literal is new to the interpreter. Add it to the global literal - * table then add an entry to the CompileEnv's local literal array. - * Convert the object to an integer object if possible. + * table. */ TclNewObj(objPtr); @@ -363,7 +317,7 @@ TclRegisterLiteral( globalPtr = (LiteralEntry *) ckalloc((unsigned) sizeof(LiteralEntry)); globalPtr->objPtr = objPtr; - globalPtr->refCount = 0; + globalPtr->refCount = 1; globalPtr->nsPtr = nsPtr; globalPtr->nextPtr = globalTablePtr->buckets[globalHash]; globalTablePtr->buckets[globalHash] = globalPtr; @@ -377,11 +331,9 @@ TclRegisterLiteral( if (globalTablePtr->numEntries >= globalTablePtr->rebuildSize) { RebuildLiteralTable(globalTablePtr); } - objIndex = AddLocalLiteralEntry(envPtr, globalPtr, localHash); #ifdef TCL_COMPILE_DEBUG TclVerifyGlobalLiteralTable(iPtr); - TclVerifyLocalLiteralTable(envPtr); { LiteralEntry *entryPtr; int found, i; @@ -409,6 +361,121 @@ TclRegisterLiteral( iPtr->stats.literalCount[TclLog2(length)]++; #endif /*TCL_COMPILE_STATS*/ + if (globalPtrPtr) { + *globalPtrPtr = globalPtr; + } + *newPtr = 1; + return objPtr; +} + +/* + *---------------------------------------------------------------------- + * + * TclRegisterLiteral -- + * + * Find, or if necessary create, an object in a CompileEnv literal array + * that has a string representation matching the argument string. + * + * Results: + * The index in the CompileEnv's literal array that references a shared + * literal matching the string. The object is created if necessary. + * + * Side effects: + * To maximize sharing, we look up the string in the interpreter's global + * literal table. If not found, we create a new shared literal in the + * global table. We then add a reference to the shared literal in the + * CompileEnv's literal array. + * + * If LITERAL_ON_HEAP is set in flags, this function is given ownership + * of the string: if an object is created then its string representation + * is set directly from string, otherwise the string is freed. Typically, + * a caller sets LITERAL_ON_HEAP if "string" is an already heap-allocated + * buffer holding the result of backslash substitutions. + * + *---------------------------------------------------------------------- + */ + +int +TclRegisterLiteral( + CompileEnv *envPtr, /* Points to the CompileEnv in whose object + * array an object is found or created. */ + register char *bytes, /* Points to string for which to find or + * create an object in CompileEnv's object + * array. */ + int length, /* Number of bytes in the string. If < 0, the + * string consists of all bytes up to the + * first null character. */ + int flags) /* If LITERAL_ON_HEAP then the caller already + * malloc'd bytes and ownership is passed to + * this function. If LITERAL_NS_SCOPE then + * the literal shouldnot be shared accross + * namespaces. */ +{ + Interp *iPtr = envPtr->iPtr; + LiteralTable *localTablePtr = &(envPtr->localLitTable); + LiteralEntry *globalPtr, *localPtr; + Tcl_Obj *objPtr; + unsigned int hash; + int localHash, objIndex, new; + Namespace *nsPtr; + + if (length < 0) { + length = (bytes ? strlen(bytes) : 0); + } + hash = HashString(bytes, length); + + /* + * Is the literal already in the CompileEnv's local literal array? If so, + * just return its index. + */ + + localHash = (hash & localTablePtr->mask); + for (localPtr=localTablePtr->buckets[localHash] ; localPtr!=NULL; + localPtr = localPtr->nextPtr) { + objPtr = localPtr->objPtr; + if ((objPtr->length == length) && ((length == 0) + || ((objPtr->bytes[0] == bytes[0]) + && (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) { + if (flags & LITERAL_ON_HEAP) { + ckfree(bytes); + } + objIndex = (localPtr - envPtr->literalArrayPtr); +#ifdef TCL_COMPILE_DEBUG + TclVerifyLocalLiteralTable(envPtr); +#endif /*TCL_COMPILE_DEBUG*/ + + return objIndex; + } + } + + /* + * The literal is new to this CompileEnv. Should it be shared accross + * namespaces? If it is a fully qualified name, the namespace + * specification is not needed to avoid sharing. + */ + + if ((flags & LITERAL_NS_SCOPE) && iPtr->varFramePtr + && ((length <2) || (bytes[0] != ':') || (bytes[1] != ':'))) { + nsPtr = iPtr->varFramePtr->nsPtr; + } else { + nsPtr = NULL; + } + + /* + * Is it in the interpreter's global literal table? If not, create it. + */ + + objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr, + flags, &globalPtr); + objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash); + +#ifdef TCL_COMPILE_DEBUG + if (globalPtr->refCount < 1) { + Tcl_Panic("TclRegisterLiteral: global literal \"%.*s\" had bad refCount %d", + (length>60? 60 : length), bytes, globalPtr->refCount); + } + TclVerifyLocalLiteralTable(envPtr); +#endif /*TCL_COMPILE_DEBUG*/ return objIndex; } @@ -582,10 +649,8 @@ TclAddLiteralObj( * literal. * * Side effects: - * Increments the ref count of the global LiteralEntry since the - * CompileEnv now refers to the literal. Expands the literal array if - * necessary. May rebuild the hash bucket array of the CompileEnv's - * literal array if it becomes too large. + * Expands the literal array if necessary. May rebuild the hash bucket + * array of the CompileEnv's literal array if it becomes too large. * *---------------------------------------------------------------------- */ @@ -594,15 +659,14 @@ static int AddLocalLiteralEntry( register CompileEnv *envPtr,/* Points to CompileEnv in whose literal array * the object is to be inserted. */ - LiteralEntry *globalPtr, /* Points to the global LiteralEntry for the - * literal to add to the CompileEnv. */ + Tcl_Obj *objPtr, /* The literal to add to the CompileEnv. */ int localHash) /* Hash value for the literal's string. */ { register LiteralTable *localTablePtr = &(envPtr->localLitTable); LiteralEntry *localPtr; int objIndex; - objIndex = TclAddLiteralObj(envPtr, globalPtr->objPtr, &localPtr); + objIndex = TclAddLiteralObj(envPtr, objPtr, &localPtr); /* * Add the literal to the local table. @@ -612,8 +676,6 @@ AddLocalLiteralEntry( localTablePtr->buckets[localHash] = localPtr; localTablePtr->numEntries++; - globalPtr->refCount++; - /* * If the CompileEnv's local literal table has exceeded a decent size, * rebuild it with more buckets. @@ -633,14 +695,14 @@ AddLocalLiteralEntry( for (i=0 ; inumBuckets ; i++) { for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL ; localPtr=localPtr->nextPtr) { - if (localPtr->objPtr == globalPtr->objPtr) { + if (localPtr->objPtr == objPtr) { found = 1; } } } if (!found) { - bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length); + bytes = Tcl_GetStringFromObj(objPtr, &length); Tcl_Panic("AddLocalLiteralEntry: literal \"%.*s\" wasn't found locally", (length>60? 60 : length), bytes); } diff --git a/generic/tclMain.c b/generic/tclMain.c index 2ccb855..d037abb 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.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: tclMain.c,v 1.42 2007/04/24 16:03:51 dgp Exp $ + * RCS: @(#) $Id: tclMain.c,v 1.42.2.1 2007/09/04 17:43:53 dgp Exp $ */ #include "tclInt.h" @@ -527,22 +527,30 @@ Tcl_Main( break; } - if (!TclObjCommandComplete(commandPtr)) { - /* - * Add the newline removed by Tcl_GetsObj back to the string. - */ + /* + * Add the newline removed by Tcl_GetsObj back to the string. + * Have to add it back before testing completeness, because + * it can make a difference. [Bug 1775878]. + */ - if (Tcl_IsShared(commandPtr)) { - Tcl_DecrRefCount(commandPtr); - commandPtr = Tcl_DuplicateObj(commandPtr); - Tcl_IncrRefCount(commandPtr); - } - Tcl_AppendToObj(commandPtr, "\n", 1); + if (Tcl_IsShared(commandPtr)) { + Tcl_DecrRefCount(commandPtr); + commandPtr = Tcl_DuplicateObj(commandPtr); + Tcl_IncrRefCount(commandPtr); + } + Tcl_AppendToObj(commandPtr, "\n", 1); + if (!TclObjCommandComplete(commandPtr)) { prompt = PROMPT_CONTINUE; continue; } prompt = PROMPT_START; + /* + * The final newline is syntactically redundant, and causes + * some error messages troubles deeper in, so lop it back off. + */ + Tcl_GetStringFromObj(commandPtr, &length); + Tcl_SetObjLength(commandPtr, --length); code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL); inChannel = Tcl_GetStdChannel(TCL_STDIN); outChannel = Tcl_GetStdChannel(TCL_STDOUT); @@ -758,17 +766,19 @@ StdinProc( return; } + if (Tcl_IsShared(commandPtr)) { + Tcl_DecrRefCount(commandPtr); + commandPtr = Tcl_DuplicateObj(commandPtr); + Tcl_IncrRefCount(commandPtr); + } + Tcl_AppendToObj(commandPtr, "\n", 1); if (!TclObjCommandComplete(commandPtr)) { - if (Tcl_IsShared(commandPtr)) { - Tcl_DecrRefCount(commandPtr); - commandPtr = Tcl_DuplicateObj(commandPtr); - Tcl_IncrRefCount(commandPtr); - } - Tcl_AppendToObj(commandPtr, "\n", 1); isPtr->prompt = PROMPT_CONTINUE; goto prompt; } isPtr->prompt = PROMPT_START; + Tcl_GetStringFromObj(commandPtr, &length); + Tcl_SetObjLength(commandPtr, --length); /* * Disable the stdin channel handler while evaluating the command; diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index b8c1281..8a91609 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -22,7 +22,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.5 2007/07/05 14:12:21 dgp Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.134.2.6 2007/09/04 17:43:53 dgp Exp $ */ #include "tclInt.h" @@ -404,6 +404,7 @@ Tcl_PushCallFrame( framePtr->numCompiledLocals = 0; framePtr->compiledLocals = NULL; framePtr->clientData = NULL; + framePtr->localCachePtr = NULL; /* * Push the new call frame onto the interpreter's stack of procedure call @@ -462,6 +463,10 @@ Tcl_PopCallFrame( } if (framePtr->numCompiledLocals > 0) { TclDeleteCompiledLocalVars(iPtr, framePtr); + if (--framePtr->localCachePtr->refCount == 0) { + TclFreeLocalCache(interp, framePtr->localCachePtr); + } + framePtr->localCachePtr = NULL; } /* @@ -793,7 +798,7 @@ Tcl_CreateNamespace( nsPtr->activationCount = 0; nsPtr->refCount = 0; Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS); - Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS); + TclInitVarHashTable(&nsPtr->varTable, nsPtr); nsPtr->exportArrayPtr = NULL; nsPtr->numExportPatterns = 0; nsPtr->maxExportPatterns = 0; @@ -897,7 +902,7 @@ Tcl_CreateNamespace( void Tcl_DeleteNamespace( - Tcl_Namespace *namespacePtr)/* Points to the namespace to delete */ + Tcl_Namespace *namespacePtr)/* Points to the namespace to delete. */ { register Namespace *nsPtr = (Namespace *) namespacePtr; Interp *iPtr = (Interp *) nsPtr->interp; @@ -1006,8 +1011,8 @@ Tcl_DeleteNamespace( EstablishErrorCodeTraces(NULL, nsPtr->interp, NULL, NULL, 0); /* - * We didn't really kill it, so remove the KILLED marks, so - * it can get killed later, avoiding mem leaks + * We didn't really kill it, so remove the KILLED marks, so it can + * get killed later, avoiding mem leaks. */ nsPtr->flags &= ~(NS_DYING|NS_KILLED); @@ -1056,7 +1061,7 @@ TclTeardownNamespace( */ TclDeleteNamespaceVars(nsPtr); - Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS); + TclInitVarHashTable(&nsPtr->varTable, nsPtr); /* * Delete all commands in this namespace. Be careful when traversing the @@ -1283,7 +1288,7 @@ Tcl_Export( for (i = 0; i < nsPtr->numExportPatterns; i++) { if (strcmp(pattern, nsPtr->exportArrayPtr[i]) == 0) { /* - * The pattern already exists in the list + * The pattern already exists in the list. */ return TCL_OK; @@ -1769,7 +1774,7 @@ Tcl_ForgetImport( Tcl_Command origin = TclGetOriginalCommand(token); if (Tcl_GetCommandInfoFromToken(origin, &info) == 0) { - continue; /* Not an imported command */ + continue; /* Not an imported command. */ } if (info.namespacePtr != (Tcl_Namespace *) sourceNsPtr) { /* @@ -1913,7 +1918,7 @@ DeleteImportedCmd( * that refer to it. */ - if (prevPtr == NULL) { /* refPtr is first in list */ + if (prevPtr == NULL) { /* refPtr is first in list. */ realCmdPtr->importRefPtr = refPtr->nextPtr; } else { prevPtr->nextPtr = refPtr->nextPtr; @@ -2490,129 +2495,6 @@ Tcl_FindCommand( /* *---------------------------------------------------------------------- * - * Tcl_FindNamespaceVar -- - * - * Searches for a namespace variable, a variable not local to a - * procedure. The variable can be either a scalar or an array, but may - * not be an element of an array. - * - * Results: - * Returns a token for the variable if it is found. Otherwise, if it - * can't be found or there is an error, returns NULL and leaves an error - * message in the interpreter's result object if "flags" contains - * TCL_LEAVE_ERR_MSG. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -Tcl_Var -Tcl_FindNamespaceVar( - Tcl_Interp *interp, /* The interpreter in which to find the - * variable. */ - const char *name, /* Variable's name. If it starts with "::", - * will be looked up in global namespace. - * Else, looked up first in contextNsPtr - * (current namespace if contextNsPtr is - * NULL), then in global namespace. */ - Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag set. - * Otherwise, points to namespace in which to - * resolve name. If NULL, look up name in the - * current namespace. */ - int flags) /* An OR'd combination of flags: - * TCL_GLOBAL_ONLY (look up name only in - * global namespace), TCL_NAMESPACE_ONLY (look - * up only in contextNsPtr, or the current - * namespace if contextNsPtr is NULL), and - * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY - * and TCL_NAMESPACE_ONLY are given, - * TCL_GLOBAL_ONLY is ignored. */ -{ - Interp *iPtr = (Interp *) interp; - ResolverScheme *resPtr; - Namespace *nsPtr[2], *cxtNsPtr; - const char *simpleName; - Tcl_HashEntry *entryPtr; - Var *varPtr; - register int search; - int result; - Tcl_Var var; - - /* - * If this namespace has a variable resolver, then give it first crack at - * the variable resolution. It may return a Tcl_Var value, it may signal - * to continue onward, or it may signal an error. - */ - - if ((flags & TCL_GLOBAL_ONLY) != 0) { - cxtNsPtr = (Namespace *) TclGetGlobalNamespace(interp); - } else if (contextNsPtr != NULL) { - cxtNsPtr = (Namespace *) contextNsPtr; - } else { - cxtNsPtr = (Namespace *) TclGetCurrentNamespace(interp); - } - - if (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) { - resPtr = iPtr->resolverPtr; - - if (cxtNsPtr->varResProc) { - result = (*cxtNsPtr->varResProc)(interp, name, - (Tcl_Namespace *) cxtNsPtr, flags, &var); - } else { - result = TCL_CONTINUE; - } - - while (result == TCL_CONTINUE && resPtr) { - if (resPtr->varResProc) { - result = (*resPtr->varResProc)(interp, name, - (Tcl_Namespace *) cxtNsPtr, flags, &var); - } - resPtr = resPtr->nextPtr; - } - - if (result == TCL_OK) { - return var; - } else if (result != TCL_CONTINUE) { - return (Tcl_Var) NULL; - } - } - - /* - * Find the namespace(s) that contain the variable. - */ - - TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr, - flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName); - - /* - * Look for the variable in the variable table of its namespace. Be sure - * to check both possible search paths: from the specified namespace - * context and from the global namespace. - */ - - varPtr = NULL; - for (search = 0; (search < 2) && (varPtr == NULL); search++) { - if ((nsPtr[search] != NULL) && (simpleName != NULL)) { - entryPtr = Tcl_FindHashEntry(&nsPtr[search]->varTable, simpleName); - if (entryPtr != NULL) { - varPtr = (Var *) Tcl_GetHashValue(entryPtr); - } - } - } - if (varPtr != NULL) { - return (Tcl_Var) varPtr; - } else if (flags & TCL_LEAVE_ERR_MSG) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "unknown variable \"", name, "\"", NULL); - } - return (Tcl_Var) NULL; -} - -/* - *---------------------------------------------------------------------- - * * TclResetShadowedCmdRefs -- * * Called when a command is added to a namespace to check for existing @@ -2654,7 +2536,7 @@ TclResetShadowedCmdRefs( Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp); int found, i; int trailFront = -1; - int trailSize = 5; /* formerly NUM_TRAIL_ELEMS */ + int trailSize = 5; /* Formerly NUM_TRAIL_ELEMS. */ Namespace **trailPtr = (Namespace **) TclStackAlloc(interp, trailSize * sizeof(Namespace *)); @@ -2779,7 +2661,7 @@ TclGetNamespaceFromObj( ResolvedNsName *resPtr; Namespace *nsPtr; int result = TCL_OK; - + /* * Get the internal representation, converting to a namespace type if * needed. The internal representation is a ResolvedNsName that points to @@ -2788,15 +2670,15 @@ TclGetNamespaceFromObj( * Check the context namespace of the resolved symbol to make sure that it * is fresh. Note that we verify that the namespace id of the context * namespace is the same as the one we cached; this insures that the - * namespace wasn't deleted and a new one created at the same - * address. Note that fully qualified names have a NULL refNsPtr, these - * checks needn't be made. + * namespace wasn't deleted and a new one created at the same address. + * Note that fully qualified names have a NULL refNsPtr, these checks + * needn't be made. * * If any check fails, then force another conversion to the command type, - * to discard the old rep and create a new one. + * to discard the old rep and create a new one. */ - resPtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr; + resPtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1; if ((objPtr->typePtr != &tclNsNameType) || (resPtr == NULL) || (resPtr->refNsPtr && @@ -2807,7 +2689,7 @@ TclGetNamespaceFromObj( result = tclNsNameType.setFromAnyProc(interp, objPtr); - resPtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr; + resPtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1; if ((result == TCL_OK) && resPtr) { nsPtr = resPtr->nsPtr; if (nsPtr && (nsPtr->flags & NS_DEAD)) { @@ -3838,7 +3720,7 @@ NamespaceInscopeCmd( for (i = 4; i < objc; i++) { result = Tcl_ListObjAppendElement(interp, listPtr, objv[i]); if (result != TCL_OK) { - Tcl_DecrRefCount(listPtr); /* Free unneeded obj */ + Tcl_DecrRefCount(listPtr); /* Free unneeded obj. */ return result; } } @@ -3847,7 +3729,7 @@ NamespaceInscopeCmd( concatObjv[1] = listPtr; cmdObjPtr = Tcl_ConcatObj(2, concatObjv); result = Tcl_EvalObjEx(interp, cmdObjPtr, TCL_EVAL_DIRECT); - Tcl_DecrRefCount(listPtr); /* we're done with the list object */ + Tcl_DecrRefCount(listPtr); /* We're done with the list object. */ } if (result == TCL_ERROR) { @@ -4120,7 +4002,7 @@ NamespacePathCmd( void TclSetNsPath( Namespace *nsPtr, /* Namespace whose path is to be set. */ - int pathLength, /* Length of pathAry */ + int pathLength, /* Length of pathAry. */ Tcl_Namespace *pathAry[]) /* Array of namespaces that are the path. */ { NamespacePathEntry *tmpPathArray; @@ -4596,7 +4478,7 @@ NamespaceUpvarCmd( savedNsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr; - otherPtr = TclObjLookupVar(interp, objv[0], NULL, + otherPtr = TclObjLookupVarEx(interp, objv[0], NULL, (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); iPtr->varFramePtr->nsPtr = (Namespace *) savedNsPtr; @@ -4605,7 +4487,7 @@ NamespaceUpvarCmd( } /* - * Create the new variable and link it to otherPtr + * Create the new variable and link it to otherPtr. */ myName = TclGetString(objv[1]); @@ -4719,10 +4601,10 @@ NamespaceWhichCmd( static void FreeNsNameInternalRep( register Tcl_Obj *objPtr) /* nsName object with internal representation - * to free */ + * to free. */ { register ResolvedNsName *resNamePtr = (ResolvedNsName *) - objPtr->internalRep.otherValuePtr; + objPtr->internalRep.twoPtrValue.ptr1; Namespace *nsPtr; /* @@ -4775,9 +4657,9 @@ DupNsNameInternalRep( register Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { register ResolvedNsName *resNamePtr = (ResolvedNsName *) - srcPtr->internalRep.otherValuePtr; + srcPtr->internalRep.twoPtrValue.ptr1; - copyPtr->internalRep.otherValuePtr = (void *) resNamePtr; + copyPtr->internalRep.twoPtrValue.ptr1 = (void *) resNamePtr; if (resNamePtr != NULL) { resNamePtr->refCount++; } @@ -4840,13 +4722,13 @@ SetNsNameFromAny( if (nsPtr) { nsPtr->refCount++; - resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr; + resNamePtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1; if ((objPtr->typePtr == &tclNsNameType) && resNamePtr && (resNamePtr->refCount == 1)) { /* * Reuse the old ResolvedNsName struct instead of freeing it */ - + Namespace *oldNsPtr = resNamePtr->nsPtr; if ((--oldNsPtr->refCount == 0) && (oldNsPtr->flags & NS_DEAD)) { NamespaceFree(oldNsPtr); @@ -4854,8 +4736,8 @@ SetNsNameFromAny( } else { TclFreeIntRep(objPtr); resNamePtr = (ResolvedNsName *) ckalloc(sizeof(ResolvedNsName)); - resNamePtr->refCount = 1; - objPtr->internalRep.otherValuePtr = (void *) resNamePtr; + resNamePtr->refCount = 1; + objPtr->internalRep.twoPtrValue.ptr1 = (void *) resNamePtr; objPtr->typePtr = &tclNsNameType; } resNamePtr->nsPtr = nsPtr; @@ -4868,7 +4750,7 @@ SetNsNameFromAny( } } else { TclFreeIntRep(objPtr); - objPtr->internalRep.otherValuePtr = (void *) NULL; + objPtr->internalRep.twoPtrValue.ptr1 = (void *) NULL; objPtr->typePtr = &tclNsNameType; } return TCL_OK; @@ -6115,7 +5997,7 @@ NsEnsembleImplementationCmd( * 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; @@ -6128,7 +6010,7 @@ NsEnsembleImplementationCmd( prefixObj = ensembleCmd->realPrefixObj; Tcl_IncrRefCount(prefixObj); - + runResultingSubcommand: /* * Do the real work of execution of the subcommand by @@ -6147,7 +6029,7 @@ NsEnsembleImplementationCmd( isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL); copyObj = TclListObjCopy(NULL, prefixObj); - + Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv); if (isRootEnsemble) { @@ -6994,27 +6876,32 @@ Tcl_LogCommandInfo( ? "while executing" : "invoked from within"), (overflow ? limit : length), command, (overflow ? "..." : ""))); - varPtr = TclObjLookupVar(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY, + varPtr = TclObjLookupVarEx(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY, NULL, 0, 0, &arrayPtr); - if ((varPtr == NULL) || (varPtr->tracePtr == NULL)) { + if ((varPtr == NULL) || !TclIsVarTraced(varPtr)) { /* * Should not happen. */ return; - } - if (varPtr->tracePtr->traceProc != EstablishErrorInfoTraces) { - /* - * The most recent trace set on ::errorInfo is not the one the core - * itself puts on last. This means some other code is tracing the - * variable, and the additional trace(s) might be write traces that - * expect the timing of writes to ::errorInfo that existed Tcl - * releases before 8.5. To satisfy that compatibility need, we write - * the current -errorinfo value to the ::errorInfo variable. - */ + } else { + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&iPtr->varTraces, + (char *) varPtr); + VarTrace *tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr); - Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL, - iPtr->errorInfo, TCL_GLOBAL_ONLY); + if (tracePtr->traceProc != EstablishErrorInfoTraces) { + /* + * The most recent trace set on ::errorInfo is not the one the + * core itself puts on last. This means some other code is tracing + * the variable, and the additional trace(s) might be write traces + * that expect the timing of writes to ::errorInfo that existed + * Tcl releases before 8.5. To satisfy that compatibility need, we + * write the current -errorinfo value to the ::errorInfo variable. + */ + + Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL, + iPtr->errorInfo, TCL_GLOBAL_ONLY); + } } } diff --git a/generic/tclObj.c b/generic/tclObj.c index 22fdbe5..84d1199 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.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: tclObj.c,v 1.122.2.2 2007/07/05 14:12:21 dgp Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.122.2.3 2007/09/04 17:43:53 dgp Exp $ */ #include "tclInt.h" @@ -175,6 +175,7 @@ static void UpdateStringOfDouble(Tcl_Obj *objPtr); static void UpdateStringOfInt(Tcl_Obj *objPtr); #ifndef NO_WIDE_TYPE static void UpdateStringOfWideInt(Tcl_Obj *objPtr); +static int SetWideIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); #endif static void FreeBignum(Tcl_Obj *objPtr); static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); @@ -241,7 +242,7 @@ Tcl_ObjType tclWideIntType = { NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ UpdateStringOfWideInt, /* updateStringProc */ - NULL /* setFromAnyProc */ + SetWideIntFromAny /* setFromAnyProc */ }; #endif Tcl_ObjType tclBignumType = { @@ -366,6 +367,9 @@ TclInitObjSubsystem(void) /* For backward compatibility only ... */ Tcl_RegisterObjType(&oldBooleanType); +#ifndef NO_WIDE_TYPE + Tcl_RegisterObjType(&tclWideIntType); +#endif #ifdef TCL_COMPILE_STATS Tcl_MutexLock(&tclObjMutex); @@ -791,7 +795,6 @@ TclAllocateFreeObjects(void) */ basePtr = (char *) ckalloc(bytesToAlloc); - memset(basePtr, 0, bytesToAlloc); prevPtr = NULL; objPtr = (Tcl_Obj *) basePtr; @@ -2533,6 +2536,33 @@ Tcl_GetWideIntFromObj( TCL_PARSE_INTEGER_ONLY)==TCL_OK); return TCL_ERROR; } +#ifndef NO_WIDE_TYPE + +/* + *---------------------------------------------------------------------- + * + * SetWideIntFromAny -- + * + * Attempts to force the internal representation for a Tcl object to + * tclWideIntType, specifically. + * + * Results: + * The return value is a standard object Tcl result. If an error occurs + * during conversion, an error message is left in the interpreter's + * result unless "interp" is NULL. + * + *---------------------------------------------------------------------- + */ + +static int +SetWideIntFromAny( + Tcl_Interp *interp, /* Tcl interpreter */ + Tcl_Obj *objPtr) /* Pointer to the object to convert */ +{ + Tcl_WideInt w; + return Tcl_GetWideIntFromObj(interp, objPtr, &w); +} +#endif /* !NO_WIDE_TYPE */ /* *---------------------------------------------------------------------- @@ -2608,6 +2638,8 @@ DupBignum( * * The object's existing string representation is NOT freed; memory will leak * if the string rep is still valid at the time this function is called. + * + *---------------------------------------------------------------------- */ static void @@ -3288,7 +3320,8 @@ AllocObjEntry( hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry))); hPtr->key.oneWordValue = (char *) objPtr; Tcl_IncrRefCount(objPtr); - + hPtr->clientData = NULL; + return hPtr; } diff --git a/generic/tclProc.c b/generic/tclProc.c index 662b9f8..c0a6d8e 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.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: tclProc.c,v 1.115.2.8 2007/06/21 16:04:56 dgp Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.115.2.9 2007/09/04 17:43:53 dgp Exp $ */ #include "tclInt.h" @@ -26,14 +26,16 @@ static void DupLambdaInternalRep(Tcl_Obj *objPtr, static void FreeLambdaInternalRep(Tcl_Obj *objPtr); static int InitArgsAndLocals(Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip); -static void InitCompiledLocals(Tcl_Interp *interp, - ByteCode *codePtr, CompiledLocal *localPtr, - Var *varPtr, Namespace *nsPtr); +static void InitResolvedLocals(Tcl_Interp *interp, + ByteCode *codePtr, Var *defPtr, + Namespace *nsPtr); +static void InitLocalCache(Proc *procPtr); static int PushProcCallFrame(ClientData clientData, register Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int isLambda); static void ProcBodyDup(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr); static void ProcBodyFree(Tcl_Obj *objPtr); +static int ProcWrongNumArgs(Tcl_Interp *interp, int skip); static void MakeProcError(Tcl_Interp *interp, Tcl_Obj *procNameObj); static void MakeLambdaError(Tcl_Interp *interp, @@ -523,17 +525,20 @@ TclCreateProc( if (precompiled) { /* - * Compare the parsed argument with the stored one. For the flags, - * we and out VAR_UNDEFINED to support bridging precompiled <= 8.3 - * code in 8.4 where this is now used as an optimization - * indicator. Yes, this is a hack. -- hobbs + * Compare the parsed argument with the stored one. Note that the + * only flag value that makes sense at this point is VAR_ARGUMENT + * (its value was kept the same as pre VarReform to simplify + * tbcload's processing of older byetcodes). + * + * The only other flag vlaue that is important to retrieve from + * precompiled procs is VAR_TEMPORARY (also unchanged). It is + * needed later when retrieving the variable names. */ if ((localPtr->nameLength != nameLength) || (strcmp(localPtr->name, fieldValues[0])) || (localPtr->frameIndex != i) - || ((localPtr->flags & ~VAR_UNDEFINED) - != (VAR_SCALAR | VAR_ARGUMENT)) + || !(localPtr->flags & VAR_ARGUMENT) || (localPtr->defValuePtr == NULL && fieldCount == 2) || (localPtr->defValuePtr != NULL && fieldCount != 2)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -588,7 +593,7 @@ TclCreateProc( localPtr->nextPtr = NULL; localPtr->nameLength = nameLength; localPtr->frameIndex = i; - localPtr->flags = VAR_SCALAR | VAR_ARGUMENT; + localPtr->flags = VAR_ARGUMENT; localPtr->resolveInfo = NULL; if (fieldCount == 2) { @@ -1031,161 +1036,21 @@ TclIsProc( */ static int -InitArgsAndLocals( - register Tcl_Interp *interp,/* Interpreter in which procedure was - * invoked. */ - Tcl_Obj *procNameObj, /* Procedure name for error reporting. */ - int skip) /* Number of initial arguments to be skipped, - * i.e., words in the "command name". */ +ProcWrongNumArgs( + Tcl_Interp *interp, int skip) { CallFrame *framePtr = ((Interp *)interp)->varFramePtr; register Proc *procPtr = framePtr->procPtr; - ByteCode *codePtr = procPtr->bodyPtr->internalRep.otherValuePtr; - register Var *varPtr; - register CompiledLocal *localPtr; - int localCt, numArgs, argCt, i, imax; - Var *compiledLocals; - Tcl_Obj *const *argObjs; + register Var *defPtr; + int localCt = procPtr->numCompiledLocals, numArgs, i; Tcl_Obj **desiredObjs; - const char *final; - - /* - * Create the "compiledLocals" array. Make sure it is large enough to hold - * all the procedure's compiled local variables, including its formal - * parameters. - */ - - localCt = procPtr->numCompiledLocals; - compiledLocals = (Var*) TclStackAlloc(interp, (int)(localCt*sizeof(Var))); - framePtr->numCompiledLocals = localCt; - framePtr->compiledLocals = compiledLocals; - - /* - * Match and assign the call's actual parameters to the procedure's formal - * arguments. The formal arguments are described by the first numArgs - * entries in both the Proc structure's local variable list and the call - * frame's local variable array. - */ - - numArgs = procPtr->numArgs; - argCt = framePtr->objc - skip; /* Set it to the number of args to the - * procedure. */ - argObjs = framePtr->objv + skip; - varPtr = framePtr->compiledLocals; - localPtr = procPtr->firstLocalPtr; - if (numArgs == 0) { - if (argCt) { - goto incorrectArgs; - } else { - goto correctArgs; - } - } - imax = ((argCt < numArgs-1) ? argCt : numArgs-1); - for (i = 0; i < imax; i++) { - /* - * "Normal" arguments; last formal is special, depends on it being - * 'args'. - */ - - Tcl_Obj *objPtr = argObjs[i]; - - varPtr->value.objPtr = objPtr; - Tcl_IncrRefCount(objPtr); /* Local var is a reference. */ - varPtr->name = localPtr->name; - varPtr->nsPtr = NULL; - varPtr->hPtr = NULL; - varPtr->refCount = 0; - varPtr->tracePtr = NULL; - varPtr->searchPtr = NULL; - varPtr->flags = localPtr->flags; - varPtr++; - localPtr = localPtr->nextPtr; - } - for (; i < numArgs-1; i++) { - /* - * This loop is entered if argCt < (numArgs-1). Set default values; - * last formal is special. - */ - - if (localPtr->defValuePtr != NULL) { - Tcl_Obj *objPtr = localPtr->defValuePtr; - - varPtr->value.objPtr = objPtr; - Tcl_IncrRefCount(objPtr); /* Local var is a reference. */ - varPtr->name = localPtr->name; - varPtr->nsPtr = NULL; - varPtr->hPtr = NULL; - varPtr->refCount = 0; - varPtr->tracePtr = NULL; - varPtr->searchPtr = NULL; - varPtr->flags = localPtr->flags; - varPtr++; - localPtr = localPtr->nextPtr; - } else { - goto incorrectArgs; - } - } - - /* - * When we get here, the last formal argument remains to be defined: - * localPtr and varPtr point to the last argument to be initialized. - */ - - if (localPtr->flags & VAR_IS_ARGS) { - Tcl_Obj *listPtr = Tcl_NewListObj(argCt-i, argObjs+i); - - varPtr->value.objPtr = listPtr; - Tcl_IncrRefCount(listPtr); /* Local var is a reference. */ - } else if (argCt == numArgs) { - Tcl_Obj *objPtr = argObjs[i]; - - varPtr->value.objPtr = objPtr; - Tcl_IncrRefCount(objPtr); /* Local var is a reference. */ - } else if ((argCt < numArgs) && (localPtr->defValuePtr != NULL)) { - Tcl_Obj *objPtr = localPtr->defValuePtr; - - varPtr->value.objPtr = objPtr; - Tcl_IncrRefCount(objPtr); /* Local var is a reference. */ - } else { - goto incorrectArgs; - } - - varPtr->name = localPtr->name; - varPtr->nsPtr = NULL; - varPtr->hPtr = NULL; - varPtr->refCount = 0; - varPtr->tracePtr = NULL; - varPtr->searchPtr = NULL; - varPtr->flags = localPtr->flags; - - localPtr = localPtr->nextPtr; - varPtr++; - - /* - * Initialise and resolve the remaining compiledLocals. - */ - - correctArgs: - if (localPtr) { - InitCompiledLocals(interp, codePtr, localPtr, varPtr, framePtr->nsPtr); - } - - return TCL_OK; - - - incorrectArgs: - /* - * Do initialise all compiled locals, to avoid problems at - * DeleteLocalVars. - */ - - final = NULL; - InitCompiledLocals(interp, codePtr, localPtr, varPtr, framePtr->nsPtr); - + const char *final = NULL; + /* * Build up desired argument list for Tcl_WrongNumArgs */ + numArgs = framePtr->procPtr->numArgs; desiredObjs = (Tcl_Obj **) TclStackAlloc(interp, (int) sizeof(Tcl_Obj *) * (numArgs+1)); @@ -1198,22 +1063,23 @@ InitArgsAndLocals( #endif /* AVOID_HACKS_FOR_ITCL */ Tcl_IncrRefCount(desiredObjs[0]); - localPtr = procPtr->firstLocalPtr; - for (i=1 ; i<=numArgs ; i++) { + defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt); + for (i=1 ; i<=numArgs ; i++, defPtr++) { Tcl_Obj *argObj; + Tcl_Obj *namePtr = localName(framePtr, i-1); - if (localPtr->defValuePtr != NULL) { + if (defPtr->value.objPtr != NULL) { TclNewObj(argObj); - Tcl_AppendStringsToObj(argObj, "?", localPtr->name, "?", NULL); - } else if ((i==numArgs) && !strcmp(localPtr->name, "args")) { + Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL); + } else if (defPtr->flags & VAR_IS_ARGS) { numArgs--; final = "..."; break; } else { - argObj = Tcl_NewStringObj(localPtr->name, -1); + argObj = namePtr; + Tcl_IncrRefCount(namePtr); } desiredObjs[i] = argObj; - localPtr = localPtr->nextPtr; } Tcl_ResetResult(interp); @@ -1229,7 +1095,55 @@ InitArgsAndLocals( /* *---------------------------------------------------------------------- * - * InitCompiledLocals -- + * TclInitCompiledLocals -- + * + * This routine is invoked in order to initialize the compiled locals + * table for a new call frame. + * + * DEPRECATED: functionality has been inlined elsewhere; this function + * remains to insure binary compatibility with Itcl. + * + + * Results: + * None. + * + * Side effects: + * May invoke various name resolvers in order to determine which + * variables are being referenced at runtime. + * + *---------------------------------------------------------------------- + */ +void +TclInitCompiledLocals( + Tcl_Interp *interp, /* Current interpreter. */ + CallFrame *framePtr, /* Call frame to initialize. */ + Namespace *nsPtr) /* Pointer to current namespace. */ +{ + Var *varPtr = framePtr->compiledLocals; + Tcl_Obj *bodyPtr; + ByteCode *codePtr; + + bodyPtr = framePtr->procPtr->bodyPtr; + if (bodyPtr->typePtr != &tclByteCodeType) { + Tcl_Panic("body object for proc attached to frame is not a byte code type"); + } + codePtr = bodyPtr->internalRep.otherValuePtr; + + if (framePtr->numCompiledLocals) { + if (!codePtr->localCachePtr) { + InitLocalCache(framePtr->procPtr) ; + } + framePtr->localCachePtr = codePtr->localCachePtr; + framePtr->localCachePtr->refCount++; + } + + InitResolvedLocals(interp, codePtr, varPtr, nsPtr); +} + +/* + *---------------------------------------------------------------------- + * + * InitResolvedLocals -- * * This routine is invoked in order to initialize the compiled locals * table for a new call frame. @@ -1245,16 +1159,27 @@ InitArgsAndLocals( */ static void -InitCompiledLocals( +InitResolvedLocals( Tcl_Interp *interp, /* Current interpreter. */ ByteCode *codePtr, - CompiledLocal *localPtr, Var *varPtr, Namespace *nsPtr) /* Pointer to current namespace. */ { Interp *iPtr = (Interp *) interp; int haveResolvers = (nsPtr->compiledVarResProc || iPtr->resolverPtr); - CompiledLocal *firstLocalPtr; + CompiledLocal *firstLocalPtr, *localPtr; + int varNum; + Tcl_ResolvedVarInfo *resVarInfo; + + /* + * Find the localPtr corresponding to varPtr + */ + + varNum = varPtr - iPtr->framePtr->compiledLocals; + localPtr = iPtr->framePtr->procPtr->firstLocalPtr; + while (varNum--) { + localPtr = localPtr->nextPtr; + } if (!(haveResolvers && (codePtr->flags & TCL_BYTECODE_RESOLVE_VARS))) { /* @@ -1264,143 +1189,297 @@ InitCompiledLocals( * we make the compiled local a link to the real variable. */ - doInitCompiledLocals: - if (!haveResolvers) { - for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) { - varPtr->value.objPtr = NULL; - varPtr->name = localPtr->name; /* Will be just '\0' if temp - * var. */ - varPtr->nsPtr = NULL; - varPtr->hPtr = NULL; - varPtr->refCount = 0; - varPtr->tracePtr = NULL; - varPtr->searchPtr = NULL; - varPtr->flags = localPtr->flags; + doInitResolvedLocals: + for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) { + varPtr->flags = 0; + varPtr->value.objPtr = NULL; + + /* + * Now invoke the resolvers to determine the exact variables + * that should be used. + */ + + resVarInfo = localPtr->resolveInfo; + if (resVarInfo && resVarInfo->fetchProc) { + Var *resolvedVarPtr = (Var *) + (*resVarInfo->fetchProc)(interp, resVarInfo); + if (resolvedVarPtr) { + VarHashRefCount(resolvedVarPtr)++; + varPtr->flags = VAR_LINK; + varPtr->value.linkPtr = resolvedVarPtr; + } } - return; - } else { - Tcl_ResolvedVarInfo *resVarInfo; - - for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) { - varPtr->value.objPtr = NULL; - varPtr->name = localPtr->name; /* Will be just '\0' if temp - * var. */ - varPtr->nsPtr = NULL; - varPtr->hPtr = NULL; - varPtr->refCount = 0; - varPtr->tracePtr = NULL; - varPtr->searchPtr = NULL; - varPtr->flags = localPtr->flags; + } + return; + } - /* - * Now invoke the resolvers to determine the exact variables - * that should be used. - */ + /* + * This is the first run after a recompile, or else the resolver epoch + * has changed: update the resolver cache. + */ + + firstLocalPtr = localPtr; + for (; localPtr != NULL; localPtr = localPtr->nextPtr) { + if (localPtr->resolveInfo) { + if (localPtr->resolveInfo->deleteProc) { + localPtr->resolveInfo->deleteProc(localPtr->resolveInfo); + } else { + ckfree((char *) localPtr->resolveInfo); + } + localPtr->resolveInfo = NULL; + } + localPtr->flags &= ~VAR_RESOLVED; + + if (haveResolvers && + !(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY))) { + ResolverScheme *resPtr = iPtr->resolverPtr; + Tcl_ResolvedVarInfo *vinfo; + int result; + + if (nsPtr->compiledVarResProc) { + result = (*nsPtr->compiledVarResProc)(nsPtr->interp, + localPtr->name, localPtr->nameLength, + (Tcl_Namespace *) nsPtr, &vinfo); + } else { + result = TCL_CONTINUE; + } - resVarInfo = localPtr->resolveInfo; - if (resVarInfo && resVarInfo->fetchProc) { - Var *resolvedVarPtr = (Var *) - (*resVarInfo->fetchProc)(interp, resVarInfo); - if (resolvedVarPtr) { - resolvedVarPtr->refCount++; - varPtr->value.linkPtr = resolvedVarPtr; - varPtr->flags = VAR_LINK; - } + while ((result == TCL_CONTINUE) && resPtr) { + if (resPtr->compiledVarResProc) { + result = (*resPtr->compiledVarResProc)(nsPtr->interp, + localPtr->name, localPtr->nameLength, + (Tcl_Namespace *) nsPtr, &vinfo); } + resPtr = resPtr->nextPtr; + } + if (result == TCL_OK) { + localPtr->resolveInfo = vinfo; + localPtr->flags |= VAR_RESOLVED; } - return; } - } else { + } + localPtr = firstLocalPtr; + codePtr->flags &= ~TCL_BYTECODE_RESOLVE_VARS; + goto doInitResolvedLocals; +} + +void +TclFreeLocalCache( + Tcl_Interp *interp, + LocalCache *localCachePtr) +{ + int i; + Tcl_Obj **namePtrPtr = &localCachePtr->varName0; + + for (i = 0; i < localCachePtr->numVars; i++, namePtrPtr++) { + Tcl_Obj *objPtr = *namePtrPtr; /* - * This is the first run after a recompile, or else the resolver epoch - * has changed: update the resolver cache. + * Note that this can be called with interp==NULL, on interp + * deletion. In that case, the literal table and objects go away + * on their own. */ - - firstLocalPtr = localPtr; - for (; localPtr != NULL; localPtr = localPtr->nextPtr) { - if (localPtr->resolveInfo) { - if (localPtr->resolveInfo->deleteProc) { - localPtr->resolveInfo->deleteProc(localPtr->resolveInfo); - } else { - ckfree((char *) localPtr->resolveInfo); - } - localPtr->resolveInfo = NULL; + if (objPtr) { + if (interp) { + TclReleaseLiteral(interp, objPtr); + } else { + Tcl_DecrRefCount(objPtr); } - localPtr->flags &= ~VAR_RESOLVED; + } + } + ckfree((char *) localCachePtr); +} - if (haveResolvers && - !(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY))) { - ResolverScheme *resPtr = iPtr->resolverPtr; - Tcl_ResolvedVarInfo *vinfo; - int result; +static void +InitLocalCache(Proc *procPtr) +{ + Interp *iPtr = procPtr->iPtr; + ByteCode *codePtr = procPtr->bodyPtr->internalRep.otherValuePtr; + int localCt = procPtr->numCompiledLocals; + int numArgs = procPtr->numArgs, i = 0; - if (nsPtr->compiledVarResProc) { - result = (*nsPtr->compiledVarResProc)(nsPtr->interp, - localPtr->name, localPtr->nameLength, - (Tcl_Namespace *) nsPtr, &vinfo); - } else { - result = TCL_CONTINUE; - } + Tcl_Obj **namePtr; + Var *varPtr; + LocalCache *localCachePtr; + CompiledLocal *localPtr; + int new; - while ((result == TCL_CONTINUE) && resPtr) { - if (resPtr->compiledVarResProc) { - result = (*resPtr->compiledVarResProc)(nsPtr->interp, - localPtr->name, localPtr->nameLength, - (Tcl_Namespace *) nsPtr, &vinfo); - } - resPtr = resPtr->nextPtr; - } - if (result == TCL_OK) { - localPtr->resolveInfo = vinfo; - localPtr->flags |= VAR_RESOLVED; - } - } + /* + * Cache the names and initial values of local variables; store the + * cache in both the framePtr for this execution and in the codePtr + * for future calls. + */ + + localCachePtr = (LocalCache *) ckalloc(sizeof(LocalCache) + + (localCt-1)*sizeof(Tcl_Obj *) + + numArgs*sizeof(Var)); + + namePtr = &localCachePtr->varName0; + varPtr = (Var *) (namePtr + localCt); + localPtr = procPtr->firstLocalPtr; + while (localPtr) { + if (TclIsVarTemporary(localPtr)) { + *namePtr = NULL; + } else { + *namePtr = TclCreateLiteral(iPtr, localPtr->name, + localPtr->nameLength, /* hash */ (unsigned int) -1, + &new, /* nsPtr */ NULL, 0, NULL); + Tcl_IncrRefCount(*namePtr); } - localPtr = firstLocalPtr; - codePtr->flags &= ~TCL_BYTECODE_RESOLVE_VARS; - goto doInitCompiledLocals; + + if (i < numArgs) { + varPtr->flags = (localPtr->flags & VAR_IS_ARGS); + varPtr->value.objPtr = localPtr->defValuePtr; + varPtr++; + i++; + } + namePtr++; + localPtr=localPtr->nextPtr; } + codePtr->localCachePtr = localCachePtr; + localCachePtr->refCount = 1; + localCachePtr->numVars = localCt; } - -/* - *---------------------------------------------------------------------- - * - * TclInitCompiledLocals -- - * - * This routine is invoked in order to initialize the compiled locals - * table for a new call frame. - * - * DEPRECATED: functionality has been inlined elsewhere; this function - * remains to insure binary compatibility with Itcl. - * - * Results: - * None. - * - * Side effects: - * May invoke various name resolvers in order to determine which - * variables are being referenced at runtime. - * - *---------------------------------------------------------------------- - */ -void -TclInitCompiledLocals( - Tcl_Interp *interp, /* Current interpreter. */ - CallFrame *framePtr, /* Call frame to initialize. */ - Namespace *nsPtr) /* Pointer to current namespace. */ +static int +InitArgsAndLocals( + register Tcl_Interp *interp,/* Interpreter in which procedure was + * invoked. */ + Tcl_Obj *procNameObj, /* Procedure name for error reporting. */ + int skip) /* Number of initial arguments to be skipped, + * i.e., words in the "command name". */ { - Var *varPtr = framePtr->compiledLocals; - Tcl_Obj *bodyPtr; - ByteCode *codePtr; - CompiledLocal *localPtr = framePtr->procPtr->firstLocalPtr; + CallFrame *framePtr = ((Interp *)interp)->varFramePtr; + register Proc *procPtr = framePtr->procPtr; + ByteCode *codePtr = procPtr->bodyPtr->internalRep.otherValuePtr; + register Var *varPtr, *defPtr; + int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax; + Tcl_Obj *const *argObjs; + + /* + * Make sure that the local cache of variable names and initial values has + * been initialised properly . + */ - bodyPtr = framePtr->procPtr->bodyPtr; - if (bodyPtr->typePtr != &tclByteCodeType) { - Tcl_Panic("body object for proc attached to frame is not a byte code type"); + if (localCt) { + if (!codePtr->localCachePtr) { + InitLocalCache(procPtr) ; + } + framePtr->localCachePtr = codePtr->localCachePtr; + framePtr->localCachePtr->refCount++; + defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt); + } else { + defPtr = NULL; } - codePtr = bodyPtr->internalRep.otherValuePtr; + + /* + * Create the "compiledLocals" array. Make sure it is large enough to hold + * all the procedure's compiled local variables, including its formal + * parameters. + */ + + varPtr = (Var*) TclStackAlloc(interp, (int)(localCt*sizeof(Var))); + framePtr->compiledLocals = varPtr; + framePtr->numCompiledLocals = localCt; + + /* + * Match and assign the call's actual parameters to the procedure's formal + * arguments. The formal arguments are described by the first numArgs + * entries in both the Proc structure's local variable list and the call + * frame's local variable array. + */ - InitCompiledLocals(interp, codePtr, localPtr, varPtr, nsPtr); + numArgs = procPtr->numArgs; + argCt = framePtr->objc - skip; /* Set it to the number of args to the + * procedure. */ + argObjs = framePtr->objv + skip; + if (numArgs == 0) { + if (argCt) { + goto incorrectArgs; + } else { + goto correctArgs; + } + } + imax = ((argCt < numArgs-1) ? argCt : numArgs-1); + for (i = 0; i < imax; i++, varPtr++, defPtr++) { + /* + * "Normal" arguments; last formal is special, depends on it being + * 'args'. + */ + + Tcl_Obj *objPtr = argObjs[i]; + + varPtr->flags = 0; + varPtr->value.objPtr = objPtr; + Tcl_IncrRefCount(objPtr); /* Local var is a reference. */ + } + for (; i < numArgs-1; i++, varPtr++, defPtr++) { + /* + * This loop is entered if argCt < (numArgs-1). Set default values; + * last formal is special. + */ + + Tcl_Obj *objPtr = defPtr->value.objPtr; + + if (objPtr) { + varPtr->flags = 0; + varPtr->value.objPtr = objPtr; + Tcl_IncrRefCount(objPtr); /* Local var reference. */ + } else { + goto incorrectArgs; + } + } + + /* + * When we get here, the last formal argument remains to be defined: + * defPtr and varPtr point to the last argument to be initialized. + */ + + + varPtr->flags = 0; + if (defPtr->flags & VAR_IS_ARGS) { + Tcl_Obj *listPtr = Tcl_NewListObj(argCt-i, argObjs+i); + + varPtr->value.objPtr = listPtr; + Tcl_IncrRefCount(listPtr); /* Local var is a reference. */ + } else if (argCt == numArgs) { + Tcl_Obj *objPtr = argObjs[i]; + + varPtr->value.objPtr = objPtr; + Tcl_IncrRefCount(objPtr); /* Local var is a reference. */ + } else if ((argCt < numArgs) && (defPtr->value.objPtr != NULL)) { + Tcl_Obj *objPtr = defPtr->value.objPtr; + + varPtr->value.objPtr = objPtr; + Tcl_IncrRefCount(objPtr); /* Local var is a reference. */ + } else { + goto incorrectArgs; + } + varPtr++; + + /* + * Initialise and resolve the remaining compiledLocals. In the absence of + * resolvers, they are undefined local vars: (flags=0, value=NULL). + */ + + correctArgs: + if (numArgs < localCt) { + if (!framePtr->nsPtr->compiledVarResProc && !((Interp *)interp)->resolverPtr) { + memset(varPtr, 0, (localCt - numArgs)*sizeof(Var)); + } else { + InitResolvedLocals(interp, codePtr, varPtr, framePtr->nsPtr); + } + } + + return TCL_OK; + + + incorrectArgs: + /* + * Initialise all compiled locals to avoid problems at DeleteLocalVars. + */ + + memset(varPtr, 0, ((framePtr->compiledLocals + localCt)-varPtr)*sizeof(Var)); + return ProcWrongNumArgs(interp, skip); } /* @@ -1437,7 +1516,8 @@ PushProcCallFrame( Namespace *nsPtr = procPtr->cmdPtr->nsPtr; CallFrame *framePtr, **framePtrPtr; int result; - + ByteCode *codePtr; + /* * If necessary (i.e. if we haven't got a suitable compilation already * cached) compile the procedure's body. The compiler will allocate frame @@ -1448,7 +1528,6 @@ PushProcCallFrame( if (procPtr->bodyPtr->typePtr == &tclByteCodeType) { Interp *iPtr = (Interp *) interp; - ByteCode *codePtr = procPtr->bodyPtr->internalRep.otherValuePtr; /* * When we've got bytecode, this is the check for validity. That is, @@ -1459,6 +1538,7 @@ PushProcCallFrame( * commands and/or resolver changes are considered). */ + codePtr = procPtr->bodyPtr->internalRep.otherValuePtr; if (((Interp *) *codePtr->interpHandle != iPtr) || (codePtr->compileEpoch != iPtr->compileEpoch) || (codePtr->nsPtr != nsPtr) diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index db14f0b..d444269 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.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: tclStubInit.c,v 1.140.2.1 2007/07/03 02:28:37 dgp Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.140.2.2 2007/09/04 17:43:53 dgp Exp $ */ #include "tclInt.h" @@ -323,6 +323,8 @@ TclIntStubs tclIntStubs = { TclGetNamespaceFromObj, /* 231 */ TclEvalObjEx, /* 232 */ TclGetSrcInfoForPc, /* 233 */ + TclVarHashCreateVar, /* 234 */ + TclInitVarHashTable, /* 235 */ }; TclIntPlatStubs tclIntPlatStubs = { diff --git a/generic/tclThreadStorage.c b/generic/tclThreadStorage.c index 9f25c32..6c50139 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 2006/11/13 22:39:56 kennykb Exp $ + * RCS: @(#) $Id: tclThreadStorage.c,v 1.12.2.1 2007/09/04 17:43:53 dgp Exp $ */ #include "tclInt.h" @@ -136,7 +136,8 @@ AllocThreadStorageEntry( hPtr = (Tcl_HashEntry *) TclpSysAlloc(sizeof(Tcl_HashEntry), 0); hPtr->key.oneWordValue = keyPtr; - + hPtr->clientData = NULL; + return hPtr; } diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 9aad7ea..713180f 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.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: tclTrace.c,v 1.37.2.4 2007/07/01 17:31:25 dgp Exp $ + * RCS: @(#) $Id: tclTrace.c,v 1.37.2.5 2007/09/04 17:43:53 dgp Exp $ */ #include "tclInt.h" @@ -1396,8 +1396,7 @@ int TclCheckExecutionTraces( Tcl_Interp *interp, /* The current interpreter. */ CONST char *command, /* Pointer to beginning of the current command - * string. If NULL, the string will be - * generated from (objc,objv) */ + * string. */ int numChars, /* The number of characters in 'command' which * are part of the command string. */ Command *cmdPtr, /* Points to command's Command struct. */ @@ -1413,24 +1412,11 @@ TclCheckExecutionTraces( int traceCode = TCL_OK; TraceCommandInfo* tcmdPtr; Tcl_InterpState state = NULL; - Tcl_Obj *commandPtr = NULL; if (cmdPtr->tracePtr == NULL) { return traceCode; } - /* - * Insure that we have a nul-terminated command string - */ - - if (!command) { - commandPtr = Tcl_NewListObj(objc, objv); - command = Tcl_GetStringFromObj(commandPtr, &numChars); - } else if ((numChars != -1) && (command[numChars] != '\0')) { - commandPtr = Tcl_NewStringObj(command, numChars); - command = TclGetString(commandPtr); - } - curLevel = iPtr->varFramePtr->level; active.nextPtr = iPtr->activeCmdTracePtr; @@ -1482,9 +1468,6 @@ TclCheckExecutionTraces( (void) Tcl_RestoreInterpState(interp, state); } - if (commandPtr) { - Tcl_DecrRefCount(commandPtr); - } return(traceCode); } @@ -1515,8 +1498,7 @@ int TclCheckInterpTraces( Tcl_Interp *interp, /* The current interpreter. */ CONST char *command, /* Pointer to beginning of the current command - * string. If NULL, the string will be - * generated from (objc,objv) */ + * string. */ int numChars, /* The number of characters in 'command' which * are part of the command string. */ Command *cmdPtr, /* Points to command's Command struct. */ @@ -1531,25 +1513,12 @@ TclCheckInterpTraces( int curLevel; int traceCode = TCL_OK; Tcl_InterpState state = NULL; - Tcl_Obj *commandPtr = NULL; if ((iPtr->tracePtr == NULL) || (iPtr->flags & INTERP_TRACE_IN_PROGRESS)) { return(traceCode); } - /* - * Insure that we have a nul-terminated command string - */ - - if (!command) { - commandPtr = Tcl_NewListObj(objc, objv); - command = Tcl_GetStringFromObj(commandPtr, &numChars); - } else if ((numChars != -1) && (command[numChars] != '\0')) { - commandPtr = Tcl_NewStringObj(command, numChars); - command = TclGetString(commandPtr); - } - curLevel = iPtr->numLevels; active.nextPtr = iPtr->activeInterpTracePtr; @@ -1648,9 +1617,6 @@ TclCheckInterpTraces( } } - if (commandPtr) { - Tcl_DecrRefCount(commandPtr); - } return(traceCode); } @@ -2441,8 +2407,8 @@ TclVarTraceExists( return NULL; } - if ((varPtr->tracePtr != NULL) - || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) { + if ((varPtr->flags & VAR_TRACED_READ) + || (arrayPtr && (arrayPtr->flags & VAR_TRACED_READ))) { TclCallVarTraces((Interp *)interp, arrayPtr, varPtr, varName, NULL, TCL_TRACE_READS, /* leaveErrMsg */ 0); } @@ -2484,6 +2450,34 @@ TclVarTraceExists( */ int +TclObjCallVarTraces( + Interp *iPtr, /* Interpreter containing variable. */ + register Var *arrayPtr, /* Pointer to array variable that contains the + * variable, or NULL if the variable isn't an + * element of an array. */ + Var *varPtr, /* Variable whose traces are to be invoked. */ + Tcl_Obj *part1Ptr, + Tcl_Obj *part2Ptr, /* Variable's two-part name. */ + int flags, /* Flags passed to trace functions: indicates + * what's happening to variable, plus maybe + * TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY */ + int leaveErrMsg, /* If true, and one of the traces indicates an + * error, then leave an error message and + * stack trace information in *iPTr. */ + int index) +{ + char *part1, *part2; + + if (!part1Ptr) { + part1Ptr = localName(iPtr->varFramePtr, index); + } + part1 = TclGetString(part1Ptr); + part2 = part2Ptr? TclGetString(part2Ptr) : NULL; + + return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg); +} + +int TclCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ register Var *arrayPtr, /* Pointer to array variable that contains the @@ -2508,7 +2502,9 @@ TclCallVarTraces( int code = TCL_OK; int disposeFlags = 0; Tcl_InterpState state = NULL; - + Tcl_HashEntry *hPtr; + int traceflags = flags & VAR_ALL_TRACES; + /* * If there are already similar trace functions active for the variable, * don't call them again. @@ -2518,9 +2514,11 @@ TclCallVarTraces( return code; } TclSetVarTraceActive(varPtr); - varPtr->refCount++; - if (arrayPtr != NULL) { - arrayPtr->refCount++; + if (TclIsVarInHash(varPtr)) { + VarHashRefCount(varPtr)++; + } + if (arrayPtr && TclIsVarInHash(arrayPtr)) { + VarHashRefCount(arrayPtr)++; } /* @@ -2572,10 +2570,12 @@ TclCallVarTraces( active.nextPtr = iPtr->activeVarTracePtr; iPtr->activeVarTracePtr = &active; Tcl_Preserve((ClientData) iPtr); - if (arrayPtr != NULL && !TclIsVarTraceActive(arrayPtr)) { + if (arrayPtr && !TclIsVarTraceActive(arrayPtr) && (arrayPtr->flags & traceflags)) { + hPtr = Tcl_FindHashEntry(&iPtr->varTraces, + (char *) arrayPtr); active.varPtr = arrayPtr; - for (tracePtr = arrayPtr->tracePtr; tracePtr != NULL; - tracePtr = active.nextTracePtr) { + for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr); + tracePtr != NULL; tracePtr = active.nextTracePtr) { active.nextTracePtr = tracePtr->nextPtr; if (!(tracePtr->flags & flags)) { continue; @@ -2616,36 +2616,40 @@ TclCallVarTraces( flags |= TCL_TRACE_DESTROYED; } active.varPtr = varPtr; - for (tracePtr = varPtr->tracePtr; tracePtr != NULL; - tracePtr = active.nextTracePtr) { - active.nextTracePtr = tracePtr->nextPtr; - if (!(tracePtr->flags & flags)) { - continue; - } - Tcl_Preserve((ClientData) tracePtr); - if (state == NULL) { - state = Tcl_SaveInterpState((Tcl_Interp *)iPtr, code); - } - if (Tcl_InterpDeleted((Tcl_Interp *)iPtr)) { - flags |= TCL_INTERP_DESTROYED; - } - result = (*tracePtr->traceProc)(tracePtr->clientData, - (Tcl_Interp *) iPtr, part1, part2, flags); - if (result != NULL) { - if (flags & TCL_TRACE_UNSETS) { - /* - * Ignore errors in unset traces. - */ - - DisposeTraceResult(tracePtr->flags, result); - } else { - disposeFlags = tracePtr->flags; - code = TCL_ERROR; + if (varPtr->flags & traceflags) { + hPtr = Tcl_FindHashEntry(&iPtr->varTraces, + (char *) varPtr); + for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr); + tracePtr != NULL; tracePtr = active.nextTracePtr) { + active.nextTracePtr = tracePtr->nextPtr; + if (!(tracePtr->flags & flags)) { + continue; + } + Tcl_Preserve((ClientData) tracePtr); + if (state == NULL) { + state = Tcl_SaveInterpState((Tcl_Interp *)iPtr, code); + } + if (Tcl_InterpDeleted((Tcl_Interp *)iPtr)) { + flags |= TCL_INTERP_DESTROYED; + } + result = (*tracePtr->traceProc)(tracePtr->clientData, + (Tcl_Interp *) iPtr, part1, part2, flags); + if (result != NULL) { + if (flags & TCL_TRACE_UNSETS) { + /* + * Ignore errors in unset traces. + */ + + DisposeTraceResult(tracePtr->flags, result); + } else { + disposeFlags = tracePtr->flags; + code = TCL_ERROR; + } + } + Tcl_Release((ClientData) tracePtr); + if (code == TCL_ERROR) { + goto done; } - } - Tcl_Release((ClientData) tracePtr); - if (code == TCL_ERROR) { - goto done; } } @@ -2718,14 +2722,16 @@ TclCallVarTraces( } } - if (arrayPtr != NULL) { - arrayPtr->refCount--; + if (arrayPtr && TclIsVarInHash(arrayPtr)) { + VarHashRefCount(arrayPtr)--; } if (copiedName) { Tcl_DStringFree(&nameCopy); } TclClearVarTraceActive(varPtr); - varPtr->refCount--; + if (TclIsVarInHash(varPtr)) { + VarHashRefCount(varPtr)--; + } iPtr->activeVarTracePtr = active.nextPtr; Tcl_Release((ClientData) iPtr); return code; @@ -2827,11 +2833,12 @@ Tcl_UntraceVar2( ClientData clientData) /* Arbitrary argument to pass to proc. */ { register VarTrace *tracePtr; - VarTrace *prevPtr; + VarTrace *prevPtr, *nextPtr; Var *varPtr, *arrayPtr; Interp *iPtr = (Interp *) interp; ActiveVarTrace *activePtr; - int flagMask; + int flagMask, allFlags = 0; + Tcl_HashEntry *hPtr; /* * Set up a mask to mask out the parts of the flags that we are not @@ -2841,7 +2848,7 @@ Tcl_UntraceVar2( flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY; varPtr = TclLookupVar(interp, part1, part2, flags & flagMask, /*msg*/ NULL, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); - if (varPtr == NULL) { + if (varPtr == NULL || !(varPtr->flags & VAR_ALL_TRACES & flags)) { return; } @@ -2856,15 +2863,19 @@ Tcl_UntraceVar2( flagMask |= TCL_TRACE_OLD_STYLE; #endif flags &= flagMask; - for (tracePtr = varPtr->tracePtr, prevPtr = NULL; ; + + hPtr = Tcl_FindHashEntry(&iPtr->varTraces, + (char *) varPtr); + for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr), prevPtr = NULL; ; prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) { if (tracePtr == NULL) { - return; + goto updateFlags; } if ((tracePtr->traceProc == proc) && (tracePtr->flags == flags) && (tracePtr->clientData == clientData)) { break; } + allFlags |= tracePtr->flags; } /* @@ -2879,19 +2890,32 @@ Tcl_UntraceVar2( activePtr->nextTracePtr = tracePtr->nextPtr; } } + nextPtr = tracePtr->nextPtr; if (prevPtr == NULL) { - varPtr->tracePtr = tracePtr->nextPtr; + if (nextPtr) { + Tcl_SetHashValue(hPtr, nextPtr); + } else { + Tcl_DeleteHashEntry(hPtr); + } } else { - prevPtr->nextPtr = tracePtr->nextPtr; + prevPtr->nextPtr = nextPtr; } Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC); - /* - * If this is the last trace on the variable, and the variable is unset - * and unused, then free up the variable. - */ - - if (TclIsVarUndefined(varPtr)) { + for (tracePtr = nextPtr; tracePtr != NULL; + tracePtr = tracePtr->nextPtr) { + allFlags |= tracePtr->flags; + } + + updateFlags: + varPtr->flags &= ~VAR_ALL_TRACES; + if (allFlags & VAR_ALL_TRACES) { + varPtr->flags |= (allFlags & VAR_ALL_TRACES); + } else if (TclIsVarUndefined(varPtr)) { + /* + * If this is the last trace on the variable, and the variable is + * unset and unused, then free up the variable. + */ TclCleanupVar(varPtr, NULL); } } @@ -2968,8 +2992,10 @@ Tcl_VarTraceInfo2( * next trace after that one. If NULL, this * call will return the first trace. */ { + Interp *iPtr = (Interp *) interp; register VarTrace *tracePtr; Var *varPtr, *arrayPtr; + Tcl_HashEntry *hPtr; varPtr = TclLookupVar(interp, part1, part2, flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY), /*msg*/ NULL, @@ -2982,19 +3008,25 @@ Tcl_VarTraceInfo2( * Find the relevant trace, if any, and return its clientData. */ - tracePtr = varPtr->tracePtr; - if (prevClientData != NULL) { - for ( ; tracePtr != NULL; tracePtr = tracePtr->nextPtr) { - if ((tracePtr->clientData == prevClientData) - && (tracePtr->traceProc == proc)) { - tracePtr = tracePtr->nextPtr; - break; + hPtr = Tcl_FindHashEntry(&iPtr->varTraces, + (char *) varPtr); + + if (hPtr) { + tracePtr = Tcl_GetHashValue(hPtr); + + if (prevClientData != NULL) { + for ( ; tracePtr != NULL; tracePtr = tracePtr->nextPtr) { + if ((tracePtr->clientData == prevClientData) + && (tracePtr->traceProc == proc)) { + tracePtr = tracePtr->nextPtr; + break; + } } } - } - for (; tracePtr!=NULL ; tracePtr=tracePtr->nextPtr) { - if (tracePtr->traceProc == proc) { - return tracePtr->clientData; + for (; tracePtr!=NULL ; tracePtr=tracePtr->nextPtr) { + if (tracePtr->traceProc == proc) { + return tracePtr->clientData; + } } } return NULL; @@ -3016,6 +3048,7 @@ Tcl_VarTraceInfo2( * A trace is set up on the variable given by varName, such that future * references to the variable will be intermediated by proc. See the * manual entry for complete details on the calling sequence for proc. + * The variable's flags are updated. * *---------------------------------------------------------------------- */ @@ -3053,7 +3086,7 @@ Tcl_TraceVar( * A trace is set up on the variable given by part1 and part2, such that * future references to the variable will be intermediated by proc. See * the manual entry for complete details on the calling sequence for - * proc. + * proc. The variable's flags are updated. * *---------------------------------------------------------------------- */ @@ -3126,8 +3159,11 @@ TraceVarEx( * caller to free if this function returns * TCL_ERROR. */ { + Interp *iPtr = (Interp *) interp; Var *varPtr, *arrayPtr; int flagMask; + Tcl_HashEntry *hPtr; + int new; /* * We strip 'flags' down to just the parts which are relevant to @@ -3164,8 +3200,18 @@ TraceVarEx( flagMask |= TCL_TRACE_OLD_STYLE; #endif tracePtr->flags = tracePtr->flags & flagMask; - tracePtr->nextPtr = varPtr->tracePtr; - varPtr->tracePtr = tracePtr; + + hPtr = Tcl_CreateHashEntry(&iPtr->varTraces, + (char *) varPtr, &new); + if (new) { + tracePtr->nextPtr = NULL; + } else { + tracePtr->nextPtr = (VarTrace *) Tcl_GetHashValue(hPtr); + } + Tcl_SetHashValue(hPtr, (char *) tracePtr); + + varPtr->flags |= (tracePtr->flags & VAR_ALL_TRACES); + return TCL_OK; } diff --git a/generic/tclVar.c b/generic/tclVar.c index 2492eca..2907591 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -11,16 +11,110 @@ * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. + * Copyright (c) 2007 Miguel Sofer * * 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.5 2007/06/28 18:09:20 dgp Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.135.2.6 2007/09/04 17:43:53 dgp Exp $ */ #include "tclInt.h" /* + * Prototypes for the variable hash key methods. + */ + +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); + +static Tcl_HashKeyType tclVarHashKeyType = { + TCL_HASH_KEY_TYPE_VERSION, /* version */ + 0, /* flags */ + HashVarKey, /* hashKeyProc */ + CompareVarKeys, /* compareKeysProc */ + AllocVarEntry, /* allocEntryProc */ + FreeVarEntry /* freeEntryProc */ +}; + +static inline Var * VarHashCreateVar(TclVarHashTable *tablePtr, + Tcl_Obj *key, int *newPtr); +static inline Var * VarHashFirstVar(TclVarHashTable *tablePtr, + Tcl_HashSearch *searchPtr); +static inline Var * VarHashNextVar(Tcl_HashSearch *searchPtr); +static inline void CleanupVar(Var *varPtr, Var *arrayPtr); + +#define VarHashGetValue(hPtr) \ + ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry))) + +static inline Var * +VarHashCreateVar( + TclVarHashTable *tablePtr, + Tcl_Obj *key, + int *newPtr) +{ + Tcl_HashEntry *hPtr = Tcl_CreateHashEntry((Tcl_HashTable *) tablePtr, + (char *) key, newPtr); + + if (hPtr) { + return VarHashGetValue(hPtr); + } else { + return NULL; + } +} + +#define VarHashFindVar(tablePtr, key) \ + VarHashCreateVar((tablePtr), (key), NULL) + +#define VarHashInvalidateEntry(varPtr) \ + ((varPtr)->flags |= VAR_DEAD_HASH) + +#define VarHashDeleteEntry(varPtr) \ + Tcl_DeleteHashEntry(&(((VarInHash *) varPtr)->entry)) + +#define VarHashFirstEntry(tablePtr, searchPtr) \ + Tcl_FirstHashEntry((Tcl_HashTable *) (tablePtr), (searchPtr)) + +#define VarHashNextEntry(searchPtr) \ + Tcl_NextHashEntry((searchPtr)) + +static inline Var * +VarHashFirstVar( + TclVarHashTable *tablePtr, + Tcl_HashSearch *searchPtr) +{ + Tcl_HashEntry *hPtr = VarHashFirstEntry(tablePtr, searchPtr); + + if (hPtr) { + return VarHashGetValue(hPtr); + } else { + return NULL; + } +} + +static inline Var * +VarHashNextVar( + Tcl_HashSearch *searchPtr) +{ + Tcl_HashEntry *hPtr = VarHashNextEntry(searchPtr); + + if (hPtr) { + return VarHashGetValue(hPtr); + } else { + return NULL; + } +} + +#define VarHashGetKey(varPtr) \ + (((VarInHash *)(varPtr))->entry.key.objPtr) + +#define VarHashDeleteTable(tablePtr) \ + Tcl_DeleteHashTable((Tcl_HashTable *) (tablePtr)) + +/* * The strings below are used to indicate what went wrong when a variable * access is denied. */ @@ -37,7 +131,7 @@ static const char *badNamespace = "parent namespace doesn't exist"; static const char *missingName = "missing variable name"; static const char *isArrayElement = "name refers to an element in an array"; - + /* * A test to see if we are in a call frame that has local variables. This is * true if we are inside a procedure body. @@ -49,19 +143,20 @@ static const char *isArrayElement = * Forward references to functions defined later in this file: */ -static void DeleteSearches(Var *arrayVarPtr); -static void DeleteArray(Interp *iPtr, const char *arrayName, +static void AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr, + Tcl_Obj *patternPtr, int includeLinks); +static void DeleteSearches(Interp *iPtr, Var *arrayVarPtr); +static void DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr, Var *varPtr, int flags); static int ObjMakeUpvar(Tcl_Interp *interp, CallFrame *framePtr, Tcl_Obj *otherP1Ptr, const char *otherP2, const int otherFlags, - const char *myName, int myFlags, int index); -static Var * NewVar(void); + Tcl_Obj *myNamePtr, int myFlags, int index); static ArraySearch * ParseSearchId(Tcl_Interp *interp, const Var *varPtr, - const char *varName, Tcl_Obj *handleObj); + Tcl_Obj *varNamePtr, Tcl_Obj *handleObj); static void UnsetVarStruct(Var *varPtr, Var *arrayPtr, - Interp *iPtr, const char *part1, - const char *part2, int flags, int reachable); + Interp *iPtr, Tcl_Obj *part1Ptr, + Tcl_Obj *part2Ptr, int flags); static int SetArraySearchObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* @@ -70,12 +165,13 @@ static int SetArraySearchObj(Tcl_Interp *interp, Tcl_Obj *objPtr); */ MODULE_SCOPE Var * TclLookupSimpleVar(Tcl_Interp *interp, - const char *varName, int flags, const int create, + Tcl_Obj *varNamePtr, int flags, const int create, const char **errMsgPtr, int *indexPtr); -MODULE_SCOPE int TclObjUnsetVar2(Tcl_Interp *interp, - Tcl_Obj *part1Ptr, const char *part2, int flags); static Tcl_DupInternalRepProc DupLocalVarName; +static Tcl_FreeInternalRepProc FreeLocalVarName; +static Tcl_UpdateStringProc PanicOnUpdateVarName; + static Tcl_FreeInternalRepProc FreeParsedVarName; static Tcl_DupInternalRepProc DupParsedVarName; static Tcl_UpdateStringProc UpdateParsedVarName; @@ -87,7 +183,9 @@ static Tcl_SetFromAnyProc PanicOnSetVarName; * Types of Tcl_Objs used to cache variable lookups. * * localVarName - INTERNALREP DEFINITION: - * longValue: index into locals table + * ptrAndLongRep.ptr: pointer to name obj in varFramePtr->localCache + * or NULL if it is this same obj + * ptrAndLongRep.value: index into locals table * * nsVarName - INTERNALREP DEFINITION: * twoPtrValue.ptr1: pointer to the namespace containing the reference @@ -102,7 +200,7 @@ static Tcl_SetFromAnyProc PanicOnSetVarName; static Tcl_ObjType localVarNameType = { "localVarName", - NULL, DupLocalVarName, PanicOnUpdateVarName, PanicOnSetVarName + FreeLocalVarName, DupLocalVarName, PanicOnUpdateVarName, PanicOnSetVarName }; /* @@ -145,6 +243,82 @@ Tcl_ObjType tclArraySearchType = { "array search", NULL, NULL, NULL, SetArraySearchObj }; + +Var * +TclVarHashCreateVar( + TclVarHashTable *tablePtr, + const char *key, + int *newPtr) +{ + Tcl_Obj *keyPtr; + Var *varPtr; + + keyPtr = Tcl_NewStringObj(key, -1); + Tcl_IncrRefCount(keyPtr); + varPtr = VarHashCreateVar(tablePtr, keyPtr, newPtr); + Tcl_DecrRefCount(keyPtr); + + return varPtr; +} + +/* + *---------------------------------------------------------------------- + * + * TclCleanupVar -- + * + * This function is called when it looks like it may be OK to free up a + * variable's storage. If the variable is in a hashtable, its Var + * structure and hash table entry will be freed along with those of its + * containing array, if any. This function is called, for example, when + * a trace on a variable deletes a variable. + * + * Results: + * None. + * + * Side effects: + * If the variable (or its containing array) really is dead and in a + * hashtable, then its Var structure, and possibly its hash table entry, + * is freed up. + * + *---------------------------------------------------------------------- + */ + +static inline void +CleanupVar( + Var *varPtr, /* Pointer to variable that may be a candidate + * for being expunged. */ + Var *arrayPtr) /* Array that contains the variable, or NULL + * if this variable isn't an array element. */ +{ + if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr) + && !TclIsVarTraced(varPtr) + && (VarHashRefCount(varPtr) == !TclIsVarDeadHash(varPtr))) { + if (VarHashRefCount(varPtr) == 0) { + ckfree((char *) varPtr); + } else { + VarHashDeleteEntry(varPtr); + } + } + if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) && + TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) && + (VarHashRefCount(arrayPtr) == !TclIsVarDeadHash(arrayPtr))) { + if (VarHashRefCount(arrayPtr) == 0) { + ckfree((char *) arrayPtr); + } else { + VarHashDeleteEntry(arrayPtr); + } + } +} + +void +TclCleanupVar( + Var *varPtr, /* Pointer to variable that may be a candidate + * for being expunged. */ + Var *arrayPtr) /* Array that contains the variable, or NULL + * if this variable isn't an array element. */ +{ + CleanupVar(varPtr, arrayPtr); +} /* *---------------------------------------------------------------------- @@ -153,8 +327,8 @@ Tcl_ObjType tclArraySearchType = { * * This function is used to locate a variable given its name(s). It has * been mostly superseded by TclObjLookupVar, it is now only used by the - * string-based interfaces. It is kept in tcl8.4 mainly because it is in - * the internal stubs table, so that some extension may be calling it. + * trace code. It is kept in tcl8.5 mainly because it is in the internal + * stubs table, so that some extension may be calling it. * * Results: * The return value is a pointer to the variable structure indicated by @@ -208,89 +382,17 @@ TclLookupVar( * address of array variable. Otherwise this * is set to NULL. */ { + Tcl_Obj *part1Ptr; Var *varPtr; - const char *elName; /* Name of array element or NULL; may be same - * as part2, or may be openParen+1. */ - int openParen, closeParen; /* If this function parses a name into array - * and index, these are the offsets to the - * parens around the index. Otherwise they are - * -1. */ - register const char *p; - const char *errMsg = NULL; - int index; -#define VAR_NAME_BUF_SIZE 26 - char buffer[VAR_NAME_BUF_SIZE]; - char *newVarName = buffer; - - varPtr = NULL; - *arrayPtrPtr = NULL; - openParen = closeParen = -1; - - /* - * Parse part1 into array name and index. - * Always check if part1 is an array element name and allow it only if - * part2 is not given. (If one does not care about creating array elements - * that can't be used from tcl, and prefer slightly better performance, - * one can put the following in an if (part2 == NULL) { ... } block and - * remove the part2's test and error reporting or move that code in array - * set.) - */ - elName = part2; - for (p = part1; *p ; p++) { - if (*p == '(') { - openParen = p - part1; - do { - p++; - } while (*p != '\0'); - p--; - if (*p == ')') { - if (part2 != NULL) { - if (flags & TCL_LEAVE_ERR_MSG) { - TclVarErrMsg(interp, part1, part2, msg, needArray); - } - return NULL; - } - closeParen = p - part1; - } else { - openParen = -1; - } - break; - } - } - if (openParen != -1) { - if (closeParen >= VAR_NAME_BUF_SIZE) { - newVarName = ckalloc((unsigned int) (closeParen+1)); - } - memcpy(newVarName, part1, (unsigned int) closeParen); - newVarName[openParen] = '\0'; - newVarName[closeParen] = '\0'; - part1 = newVarName; - elName = newVarName + openParen + 1; - } + part1Ptr = Tcl_NewStringObj(part1, -1); + Tcl_IncrRefCount(part1Ptr); - varPtr = TclLookupSimpleVar(interp, part1, flags, createPart1, - &errMsg, &index); - if (varPtr == NULL) { - if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) { - TclVarErrMsg(interp, part1, elName, msg, errMsg); - } - } else { - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } - if (elName != NULL) { - *arrayPtrPtr = varPtr; - varPtr = TclLookupArrayElement(interp, part1, elName, flags, - msg, createPart1, createPart2, varPtr); - } - } - if (newVarName != buffer) { - ckfree(newVarName); - } + varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, msg, + createPart1, createPart2, arrayPtrPtr); + TclDecrRefCount(part1Ptr); return varPtr; -#undef VAR_NAME_BUF_SIZE } /* @@ -357,6 +459,37 @@ TclObjLookupVar( * address of array variable. Otherwise this * is set to NULL. */ { + Tcl_Obj *part2Ptr; + Var *resPtr; + + if (part2) { + part2Ptr = Tcl_NewStringObj(part2, -1); + Tcl_IncrRefCount(part2Ptr); + } else { + part2Ptr = NULL; + } + + resPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, + flags, msg, createPart1, createPart2, arrayPtrPtr); + + if (part2Ptr) { + Tcl_DecrRefCount(part2Ptr); + } + + return resPtr; +} + +Var * +TclObjLookupVarEx( + Tcl_Interp *interp, + Tcl_Obj *part1Ptr, + Tcl_Obj *part2Ptr, + int flags, + const char *msg, + const int createPart1, + const int createPart2, + Var **arrayPtrPtr) +{ Interp *iPtr = (Interp *) interp; register Var *varPtr; /* Points to the variable's in-frame Var * structure. */ @@ -368,6 +501,8 @@ TclObjLookupVar( const char *errMsg = NULL; CallFrame *varFramePtr = iPtr->varFramePtr; Namespace *nsPtr; + char *part2 = part2Ptr? TclGetString(part2Ptr):NULL; + char *newPart2 = NULL; /* * If part1Ptr is a tclParsedVarNameType, separate it into the pre-parsed @@ -377,19 +512,23 @@ TclObjLookupVar( *arrayPtrPtr = NULL; if (typePtr == &tclParsedVarNameType) { if (part1Ptr->internalRep.twoPtrValue.ptr1 != NULL) { - if (part2 != NULL) { + if (part2Ptr != NULL) { /* * ERROR: part1Ptr is already an array element, cannot specify * a part2. */ if (flags & TCL_LEAVE_ERR_MSG) { - part1 = TclGetString(part1Ptr); - TclVarErrMsg(interp, part1, part2, msg, needArray); + TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, + needArray, -1); } return NULL; } - part2 = part1Ptr->internalRep.twoPtrValue.ptr2; + part2 = newPart2 = part1Ptr->internalRep.twoPtrValue.ptr2; + if (newPart2) { + part2Ptr = Tcl_NewStringObj(newPart2, -1); + Tcl_IncrRefCount(part2Ptr); + } part1Ptr = part1Ptr->internalRep.twoPtrValue.ptr1; typePtr = part1Ptr->typePtr; } @@ -397,23 +536,37 @@ TclObjLookupVar( } part1 = Tcl_GetStringFromObj(part1Ptr, &len1); - nsPtr = varFramePtr->nsPtr; - if (nsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) { + if (varFramePtr) { + nsPtr = varFramePtr->nsPtr; + if (nsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) { + goto doParse; + } + } else { + /* + * Some variables in the global ns have to be initialized before the + * root call frame is in place. + */ + + nsPtr = NULL; goto doParse; } if (typePtr == &localVarNameType) { - int localIndex = (int) part1Ptr->internalRep.longValue; + int localIndex = (int) part1Ptr->internalRep.ptrAndLongRep.value; if (HasLocalVars(varFramePtr) && !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) && (localIndex < varFramePtr->numCompiledLocals)) { /* - * use the cached index if the names coincide. + * Use the cached index if the names coincide. */ - varPtr = &(varFramePtr->compiledLocals[localIndex]); - if ((varPtr->name != NULL) && (strcmp(part1, varPtr->name) == 0)) { + Tcl_Obj *namePtr = (Tcl_Obj *) part1Ptr->internalRep.ptrAndLongRep.ptr; + Tcl_Obj *checkNamePtr = localName(iPtr->varFramePtr, localIndex); + + if ((!namePtr && (checkNamePtr == part1Ptr)) || + (namePtr && (checkNamePtr == namePtr))) { + varPtr = (Var *) &(varFramePtr->compiledLocals[localIndex]); goto donePart1; } } @@ -438,14 +591,14 @@ TclObjLookupVar( */ !TclIsVarUndefined(varPtr)))); - if (useReference && (varPtr->hPtr != NULL)) { + if (useReference && !TclIsVarDeadHash(varPtr)) { /* * A straight global or namespace reference, use it. It isn't so * simple to deal with 'implicit' namespace references, i.e., * those where the reference could be to either a namespace or a * global variable. Those we lookup again. * - * If (varPtr->hPtr == NULL), this might be a reference to a + * If TclIsVarDeadHash(varPtr), this might be a reference to a * variable in a deleted namespace, kept alive by e.g. part1Ptr. * We could conceivably be so unlucky that a new namespace was * created at the same address as the deleted one, so to be safe @@ -465,14 +618,14 @@ TclObjLookupVar( */ register int i; - char *newPart2; len2 = -1; for (i = 0; i < len1; i++) { if (*(part1 + i) == '(') { - if (part2 != NULL) { + if (part2Ptr != NULL) { if (flags & TCL_LEAVE_ERR_MSG) { - TclVarErrMsg(interp, part1, part2, msg, needArray); + TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, + needArray, -1); } } @@ -489,6 +642,8 @@ TclObjLookupVar( memcpy(newPart2, part2, (unsigned int) len2); *(newPart2+len2) = '\0'; part2 = newPart2; + part2Ptr = Tcl_NewStringObj(newPart2, -1); + Tcl_IncrRefCount(part2Ptr); /* * Free the internal rep of the original part1Ptr, now renamed @@ -528,11 +683,14 @@ TclObjLookupVar( TclFreeIntRep(part1Ptr); part1Ptr->typePtr = NULL; - varPtr = TclLookupSimpleVar(interp, part1, flags, createPart1, + varPtr = TclLookupSimpleVar(interp, part1Ptr, flags, createPart1, &errMsg, &index); if (varPtr == NULL) { if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) { - TclVarErrMsg(interp, part1, part2, msg, errMsg); + TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, errMsg, -1); + } + if (newPart2) { + Tcl_DecrRefCount(part2Ptr); } return NULL; } @@ -547,7 +705,13 @@ TclObjLookupVar( */ part1Ptr->typePtr = &localVarNameType; - part1Ptr->internalRep.longValue = (long) index; + if (part1Ptr != localName(iPtr->varFramePtr, index)) { + part1Ptr->internalRep.ptrAndLongRep.ptr = localName(iPtr->varFramePtr, index); + Tcl_IncrRefCount((Tcl_Obj *)part1Ptr->internalRep.ptrAndLongRep.ptr); + } else { + part1Ptr->internalRep.ptrAndLongRep.ptr = NULL; + } + part1Ptr->internalRep.ptrAndLongRep.value = (long) index; #if ENABLE_NS_VARNAME_CACHING } else if (index > -3) { /* @@ -577,8 +741,8 @@ TclObjLookupVar( if (varPtr == NULL) { if (flags & TCL_LEAVE_ERR_MSG) { part1 = TclGetString(part1Ptr); - TclVarErrMsg(interp, part1, part2, msg, - "Cached variable reference is NULL."); + TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, + "Cached variable reference is NULL.", -1); } return NULL; } @@ -587,15 +751,17 @@ TclObjLookupVar( varPtr = varPtr->value.linkPtr; } - if (part2 != NULL) { + if (part2Ptr != NULL) { /* * Array element sought: look it up. */ - part1 = TclGetString(part1Ptr); *arrayPtrPtr = varPtr; - varPtr = TclLookupArrayElement(interp, part1, part2, flags, msg, - createPart1, createPart2, varPtr); + varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, flags, msg, + createPart1, createPart2, varPtr, -1); + if (newPart2) { + Tcl_DecrRefCount(part2Ptr); + } } return varPtr; } @@ -659,7 +825,7 @@ TclObjLookupVar( Var * TclLookupSimpleVar( Tcl_Interp *interp, /* Interpreter to use for lookup. */ - const char *varName, /* This is a simple variable name that could + Tcl_Obj *varNamePtr, /* This is a simple variable name that could * represent a scalar or an array. */ int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * LOOKUP_FOR_UPVAR and TCL_LEAVE_ERR_MSG bits @@ -676,18 +842,18 @@ TclLookupSimpleVar( * variables are currently in use. Same as the * current procedure's frame, if any, unless * an "uplevel" is executing. */ - Tcl_HashTable *tablePtr; /* Points to the hashtable, if any, in which + TclVarHashTable *tablePtr; /* Points to the hashtable, if any, in which * to look up the variable. */ Tcl_Var var; /* Used to search for global names. */ Var *varPtr; /* Points to the Var structure returned for * the variable. */ Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr; ResolverScheme *resPtr; - Tcl_HashEntry *hPtr; int new, i, result; + const char *varName = TclGetString(varNamePtr); varPtr = NULL; - varNsPtr = NULL; /* set non-NULL if a nonlocal variable */ + varNsPtr = NULL; /* Set non-NULL if a nonlocal variable. */ *indexPtr = -3; if (flags & TCL_GLOBAL_ONLY) { @@ -771,15 +937,13 @@ TclLookupSimpleVar( * otherwise generate our own error! */ - var = Tcl_FindNamespaceVar(interp, varName, (Tcl_Namespace *) cxtNsPtr, - flags & ~TCL_LEAVE_ERR_MSG); - - if (var != (Tcl_Var) NULL) { - varPtr = (Var *) var; - } + varPtr = (Var *) Tcl_FindNamespaceVar(interp, varName, + (Tcl_Namespace *) cxtNsPtr, flags & ~TCL_LEAVE_ERR_MSG); if (varPtr == NULL) { - if (create) { /* var wasn't found so create it */ + Tcl_Obj *tailPtr; + + if (create) { /* Var wasn't found so create it. */ TclGetNamespaceForQualName(interp, varName, cxtNsPtr, flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail); if (varNsPtr == NULL) { @@ -789,12 +953,12 @@ TclLookupSimpleVar( if (tail == NULL) { *errMsgPtr = missingName; return NULL; + } else if (tail != varName) { + tailPtr = Tcl_NewStringObj(tail, -1); + } else { + tailPtr = varNamePtr; } - hPtr = Tcl_CreateHashEntry(&varNsPtr->varTable, tail, &new); - varPtr = NewVar(); - Tcl_SetHashValue(hPtr, varPtr); - varPtr->hPtr = hPtr; - varPtr->nsPtr = varNsPtr; + varPtr = VarHashCreateVar(&varNsPtr->varTable, tailPtr, &new); if (lookGlobal) { /* * The variable was created starting from the global @@ -806,58 +970,44 @@ TclLookupSimpleVar( } else { *indexPtr = -2; } - } else { /* var wasn't found and not to create it */ + } else { /* Var wasn't found and not to create it. */ *errMsgPtr = noSuchVar; return NULL; } } - } else { /* local var: look in frame varFramePtr */ + } else { /* Local var: look in frame varFramePtr. */ Proc *procPtr = varFramePtr->procPtr; int localCt = procPtr->numCompiledLocals; - CompiledLocal *localPtr = procPtr->firstLocalPtr; - Var *localVarPtr = varFramePtr->compiledLocals; - int varNameLen = strlen(varName); + Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0; - for (i=0 ; iname; + for (i=0 ; inameLength) && (strcmp(varName, localName) == 0)) { *indexPtr = i; - return localVarPtr; + return (Var *) &varFramePtr->compiledLocals[i]; } } - localVarPtr++; - localPtr = localPtr->nextPtr; } tablePtr = varFramePtr->varTablePtr; if (create) { if (tablePtr == NULL) { - tablePtr = (Tcl_HashTable *) - ckalloc(sizeof(Tcl_HashTable)); - Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS); + tablePtr = (TclVarHashTable *) + ckalloc(sizeof(TclVarHashTable)); + TclInitVarHashTable(tablePtr, NULL); varFramePtr->varTablePtr = tablePtr; } - hPtr = Tcl_CreateHashEntry(tablePtr, varName, &new); - if (new) { - varPtr = NewVar(); - Tcl_SetHashValue(hPtr, varPtr); - varPtr->hPtr = hPtr; - varPtr->nsPtr = NULL; /* a local variable */ - } else { - varPtr = (Var *) Tcl_GetHashValue(hPtr); - } + varPtr = VarHashCreateVar(tablePtr, varNamePtr, &new); } else { - hPtr = NULL; + varPtr = NULL; if (tablePtr != NULL) { - hPtr = Tcl_FindHashEntry(tablePtr, varName); + varPtr = VarHashFindVar(tablePtr, varNamePtr); } - if (hPtr == NULL) { + if (varPtr == NULL) { *errMsgPtr = noSuchVar; - return NULL; } - varPtr = (Var *) Tcl_GetHashValue(hPtr); } } return varPtr; @@ -903,8 +1053,9 @@ TclLookupSimpleVar( Var * TclLookupArrayElement( Tcl_Interp *interp, /* Interpreter to use for lookup. */ - const char *arrayName, /* This is the name of the array. */ - const char *elName, /* Name of element within array. */ + Tcl_Obj *arrayNamePtr, /* This is the name of the array, or NULL if + * index>= 0. */ + Tcl_Obj *elNamePtr, /* Name of element within array. */ const int flags, /* Only TCL_LEAVE_ERR_MSG bit matters. */ const char *msg, /* Verb to use in error messages, e.g. "read" * or "set". Only needed if TCL_LEAVE_ERR_MSG @@ -916,11 +1067,13 @@ TclLookupArrayElement( const int createElem, /* If 1, create hash table entry for the * element, if it doesn't already exist. If 0, * return error if it doesn't exist. */ - Var *arrayPtr) /* Pointer to the array's Var structure. */ + Var *arrayPtr, /* Pointer to the array's Var structure. */ + int index) /* If >=0, the index of the local array. */ { - Tcl_HashEntry *hPtr; int new; Var *varPtr; + TclVarHashTable *tablePtr; + Namespace *nsPtr; /* * We're dealing with an array element. Make sure the variable is an array @@ -930,7 +1083,8 @@ TclLookupArrayElement( if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) { if (!createArray) { if (flags & TCL_LEAVE_ERR_MSG) { - TclVarErrMsg(interp, arrayName, elName, msg, noSuchVar); + TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, + noSuchVar, index); } return NULL; } @@ -940,49 +1094,52 @@ TclLookupArrayElement( * deleted namespace! */ - if ((arrayPtr->flags & VAR_IN_HASHTABLE) && (arrayPtr->hPtr == NULL)) { + if (TclIsVarDeadHash(arrayPtr)) { if (flags & TCL_LEAVE_ERR_MSG) { - TclVarErrMsg(interp, arrayName, elName, msg, danglingVar); + TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, + danglingVar, index); } return NULL; } TclSetVarArray(arrayPtr); - TclClearVarUndefined(arrayPtr); - arrayPtr->value.tablePtr = (Tcl_HashTable *) - ckalloc(sizeof(Tcl_HashTable)); - Tcl_InitHashTable(arrayPtr->value.tablePtr, TCL_STRING_KEYS); + tablePtr = (TclVarHashTable *) ckalloc(sizeof(TclVarHashTable)); + arrayPtr->value.tablePtr = tablePtr; + + if (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr)) { + nsPtr = TclGetVarNsPtr(arrayPtr); + } else { + nsPtr = NULL; + } + TclInitVarHashTable(arrayPtr->value.tablePtr, nsPtr); } else if (!TclIsVarArray(arrayPtr)) { if (flags & TCL_LEAVE_ERR_MSG) { - TclVarErrMsg(interp, arrayName, elName, msg, needArray); + TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, needArray, + index); } return NULL; } if (createElem) { - hPtr = Tcl_CreateHashEntry(arrayPtr->value.tablePtr, elName, &new); + varPtr = VarHashCreateVar(arrayPtr->value.tablePtr, elNamePtr, &new); if (new) { - if (arrayPtr->searchPtr != NULL) { - DeleteSearches(arrayPtr); + if (arrayPtr->flags & VAR_SEARCH_ACTIVE) { + DeleteSearches((Interp *) interp, arrayPtr); } - varPtr = NewVar(); - Tcl_SetHashValue(hPtr, varPtr); - varPtr->hPtr = hPtr; - varPtr->nsPtr = arrayPtr->nsPtr; TclSetVarArrayElement(varPtr); } } else { - hPtr = Tcl_FindHashEntry(arrayPtr->value.tablePtr, elName); - if (hPtr == NULL) { + varPtr = VarHashFindVar(arrayPtr->value.tablePtr, elNamePtr); + if (varPtr == NULL) { if (flags & TCL_LEAVE_ERR_MSG) { - TclVarErrMsg(interp, arrayName, elName, msg, noSuchElement); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT", elName, - NULL); + TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, + noSuchElement, index); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT", + TclGetString(elNamePtr), NULL); } - return NULL; } } - return (Var *) Tcl_GetHashValue(hPtr); + return varPtr; } /* @@ -1097,17 +1254,25 @@ Tcl_GetVar2Ex( int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ { - Var *varPtr, *arrayPtr; + Tcl_Obj *part1Ptr, *part2Ptr, *resPtr; - /* Filter to pass through only the flags this interface supports. */ - flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG); - varPtr = TclLookupVar(interp, part1, part2, flags, "read", - /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr); - if (varPtr == NULL) { - return NULL; + part1Ptr = Tcl_NewStringObj(part1, -1); + Tcl_IncrRefCount(part1Ptr); + if (part2) { + part2Ptr = Tcl_NewStringObj(part2, -1); + Tcl_IncrRefCount(part2Ptr); + } else { + part2Ptr = NULL; + } + + resPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags); + + Tcl_DecrRefCount(part1Ptr); + if (part2Ptr) { + Tcl_DecrRefCount(part2Ptr); } - return TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags); + return resPtr; } /* @@ -1147,20 +1312,20 @@ Tcl_ObjGetVar2( * TCL_LEAVE_ERR_MSG bits. */ { Var *varPtr, *arrayPtr; - char *part1, *part2; - part1 = TclGetString(part1Ptr); - part2 = ((part2Ptr == NULL) ? NULL : TclGetString(part2Ptr)); + /* + * Filter to pass through only the flags this interface supports. + */ - /* Filter to pass through only the flags this interface supports. */ flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG); - varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "read", + varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read", /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { return NULL; } - return TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags); + return TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, + flags, -1); } /* @@ -1192,25 +1357,27 @@ TclPtrGetVar( register Var *varPtr, /* The variable to be read.*/ Var *arrayPtr, /* NULL for scalar variables, pointer to the * containing array otherwise. */ - const char *part1, /* Name of an array (if part2 is non-NULL) or + Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ - const char *part2, /* If non-NULL, gives the name of an element + Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ - const int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and + const int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ + int index) { Interp *iPtr = (Interp *) interp; const char *msg; /* - * Invoke any traces that have been set for the variable. + * Invoke any read traces that have been set for the variable. */ - if ((varPtr->tracePtr != NULL) - || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) { - if (TCL_ERROR == TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, + if ((varPtr->flags & VAR_TRACED_READ) + || (arrayPtr && (arrayPtr->flags & VAR_TRACED_READ))) { + if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr, + part1Ptr, part2Ptr, (flags & (TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY)) - | TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) { + | TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG), index)) { goto errorReturn; } } @@ -1224,7 +1391,7 @@ TclPtrGetVar( } if (flags & TCL_LEAVE_ERR_MSG) { - if (TclIsVarUndefined(varPtr) && (arrayPtr != NULL) + if (TclIsVarUndefined(varPtr) && arrayPtr && !TclIsVarUndefined(arrayPtr)) { msg = noSuchElement; } else if (TclIsVarArray(varPtr)) { @@ -1232,7 +1399,7 @@ TclPtrGetVar( } else { msg = noSuchVar; } - TclVarErrMsg(interp, part1, part2, "read", msg); + TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "read", msg, index); } /* @@ -1372,7 +1539,7 @@ Tcl_SetVar2( int flags) /* Various flags that tell how to set value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or - * TCL_LEAVE_ERR_MSG */ + * TCL_LEAVE_ERR_MSG. */ { register Tcl_Obj *valuePtr; Tcl_Obj *varValuePtr; @@ -1443,22 +1610,25 @@ Tcl_SetVar2Ex( * TCL_APPEND_VALUE, TCL_LIST_ELEMENT or * TCL_LEAVE_ERR_MSG. */ { - Var *varPtr, *arrayPtr; + Tcl_Obj *part1Ptr, *part2Ptr, *resPtr; - /* Filter to pass through only the flags this interface supports. */ - flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG - |TCL_APPEND_VALUE|TCL_LIST_ELEMENT); - varPtr = TclLookupVar(interp, part1, part2, flags, "set", - /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); - if (varPtr == NULL) { - if (newValuePtr->refCount == 0) { - Tcl_DecrRefCount(newValuePtr); - } - return NULL; + part1Ptr = Tcl_NewStringObj(part1, -1); + Tcl_IncrRefCount(part1Ptr); + if (part2) { + part2Ptr = Tcl_NewStringObj(part2, -1); + Tcl_IncrRefCount(part2Ptr); + } else { + part2Ptr = NULL; + } + + resPtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags); + + Tcl_DecrRefCount(part1Ptr); + if (part2Ptr) { + Tcl_DecrRefCount(part2Ptr); } - return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, - newValuePtr, flags); + return resPtr; } /* @@ -1502,15 +1672,14 @@ Tcl_ObjSetVar2( * TCL_LEAVE_ERR_MSG. */ { Var *varPtr, *arrayPtr; - char *part1, *part2; - part1 = TclGetString(part1Ptr); - part2 = ((part2Ptr == NULL) ? NULL : TclGetString(part2Ptr)); + /* + * Filter to pass through only the flags this interface supports. + */ - /* Filter to pass through only the flags this interface supports. */ flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG |TCL_APPEND_VALUE|TCL_LIST_ELEMENT); - varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "set", + varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { if (newValuePtr->refCount == 0) { @@ -1519,8 +1688,8 @@ Tcl_ObjSetVar2( return NULL; } - return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, - newValuePtr, flags); + return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, + newValuePtr, flags, -1); } /* @@ -1556,13 +1725,15 @@ TclPtrSetVar( Var *arrayPtr, /* Reference to the array containing the * variable, or NULL if the variable is a * scalar. */ - const char *part1, /* Name of an array (if part2 is non-NULL) or - * the name of a variable. */ - const char *part2, /* If non-NULL, gives the name of an element + Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or + * the name of a variable. NULL if index >= 0*/ + Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ Tcl_Obj *newValuePtr, /* New value for variable. */ - const int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and + const int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ + int index) /* Index of local var where part1 is to be + * found. */ { Interp *iPtr = (Interp *) interp; Tcl_Obj *oldValuePtr; @@ -1577,12 +1748,14 @@ TclPtrSetVar( * allocation and is meaningless anyway). */ - if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) { + if (TclIsVarDeadHash(varPtr)) { if (flags & TCL_LEAVE_ERR_MSG) { if (TclIsVarArrayElement(varPtr)) { - TclVarErrMsg(interp, part1, part2, "set", danglingElement); + TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", + danglingElement, index); } else { - TclVarErrMsg(interp, part1, part2, "set", danglingVar); + TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", + danglingVar, index); } } goto earlyError; @@ -1592,9 +1765,9 @@ TclPtrSetVar( * It's an error to try to set an array variable itself. */ - if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) { + if (TclIsVarArray(varPtr)) { if (flags & TCL_LEAVE_ERR_MSG) { - TclVarErrMsg(interp, part1, part2, "set", isArray); + TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", isArray, index); } goto earlyError; } @@ -1605,10 +1778,11 @@ TclPtrSetVar( * instructions. */ - if ((flags & TCL_TRACE_READS) && ((varPtr->tracePtr != NULL) - || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) { - if (TCL_ERROR == TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, - TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) { + if ((flags & TCL_TRACE_READS) && ((varPtr->flags & VAR_TRACED_READ) + || (arrayPtr && (arrayPtr->flags & VAR_TRACED_READ)))) { + if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr, + part1Ptr, part2Ptr, + TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG), index)) { goto earlyError; } } @@ -1620,33 +1794,39 @@ TclPtrSetVar( * otherwise we must create a new copy to modify: this is "copy on write". */ + oldValuePtr = varPtr->value.objPtr; if (flags & TCL_LIST_ELEMENT && !(flags & TCL_APPEND_VALUE)) { - TclSetVarUndefined(varPtr); + varPtr->value.objPtr = NULL; } - oldValuePtr = varPtr->value.objPtr; if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) { +#if 0 + /* + * Can't happen now! + */ + if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) { - TclDecrRefCount(oldValuePtr); /* discard old value */ + TclDecrRefCount(oldValuePtr); /* Discard old value. */ varPtr->value.objPtr = NULL; oldValuePtr = NULL; } - if (flags & TCL_LIST_ELEMENT) { /* append list element */ +#endif + if (flags & TCL_LIST_ELEMENT) { /* Append list element. */ if (oldValuePtr == NULL) { TclNewObj(oldValuePtr); varPtr->value.objPtr = oldValuePtr; - Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */ + Tcl_IncrRefCount(oldValuePtr); /* Since var is referenced. */ } else if (Tcl_IsShared(oldValuePtr)) { varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr); TclDecrRefCount(oldValuePtr); oldValuePtr = varPtr->value.objPtr; - Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */ + Tcl_IncrRefCount(oldValuePtr); /* Since var is referenced. */ } result = Tcl_ListObjAppendElement(interp, oldValuePtr, newValuePtr); if (result != TCL_OK) { goto earlyError; } - } else { /* append string */ + } else { /* Append string. */ /* * We append newValuePtr's bytes but don't change its ref count if * non-zero; if newValuePtr has a zero refCount and we are not @@ -1657,11 +1837,11 @@ TclPtrSetVar( varPtr->value.objPtr = newValuePtr; Tcl_IncrRefCount(newValuePtr); } else { - if (Tcl_IsShared(oldValuePtr)) { /* append to copy */ + if (Tcl_IsShared(oldValuePtr)) { /* Append to copy. */ 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); if (newValuePtr->refCount == 0) { @@ -1676,26 +1856,22 @@ TclPtrSetVar( */ varPtr->value.objPtr = newValuePtr; - Tcl_IncrRefCount(newValuePtr); /* var is another ref */ + Tcl_IncrRefCount(newValuePtr); /* Var is another ref. */ if (oldValuePtr != NULL) { - TclDecrRefCount(oldValuePtr); /* discard old value */ + TclDecrRefCount(oldValuePtr); /* Discard old value. */ } } - TclSetVarScalar(varPtr); - TclClearVarUndefined(varPtr); - if (arrayPtr != NULL) { - TclClearVarUndefined(arrayPtr); - } /* * Invoke any write traces for the variable. */ - if ((varPtr->tracePtr != NULL) - || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) { - if (TCL_ERROR == TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, - (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) - | TCL_TRACE_WRITES, (flags & TCL_LEAVE_ERR_MSG))) { + 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)) { goto cleanup; } } @@ -1778,20 +1954,16 @@ TclIncrObjVar2( * TCL_LEAVE_ERR_MSG. */ { Var *varPtr, *arrayPtr; - char *part1, *part2; - part1 = TclGetString(part1Ptr); - part2 = ((part2Ptr == NULL)? NULL : TclGetString(part2Ptr)); - - varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "read", + varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read", 1, 1, &arrayPtr); if (varPtr == NULL) { Tcl_AddObjErrorInfo(interp, "\n (reading value of variable to increment)", -1); return NULL; } - return TclPtrIncrObjVar(interp, varPtr, arrayPtr, part1, part2, - incrPtr, flags); + return TclPtrIncrObjVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, + incrPtr, flags, -1); } /* @@ -1827,25 +1999,31 @@ TclPtrIncrObjVar( Var *arrayPtr, /* Reference to the array containing the * variable, or NULL if the variable is a * scalar. */ - const char *part1, /* Points to an object holding the name of an + Tcl_Obj *part1Ptr, /* Points to an object holding the name of an * array (if part2 is non-NULL) or the name of * a variable. */ - const char *part2, /* If non-null, points to an object holding + Tcl_Obj *part2Ptr, /* If non-null, points to an object holding * the name of an element in the array * part1Ptr. */ - Tcl_Obj *incrPtr, /* Increment value */ + Tcl_Obj *incrPtr, /* Increment value. */ /* TODO: Which of these flag values really make sense? */ - const int flags) /* Various flags that tell how to incr value: + const int flags, /* Various flags that tell how to incr value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, * TCL_LEAVE_ERR_MSG. */ + int index) { register Tcl_Obj *varValuePtr, *newValuePtr = NULL; int duplicated, code; - varPtr->refCount++; - varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags); - varPtr->refCount--; + if (TclIsVarInHash(varPtr)) { + VarHashRefCount(varPtr)++; + } + varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, + flags, index); + if (TclIsVarInHash(varPtr)) { + VarHashRefCount(varPtr)--; + } if (varValuePtr == NULL) { varValuePtr = Tcl_NewIntObj(0); } @@ -1857,8 +2035,8 @@ TclPtrIncrObjVar( } code = TclIncrObj(interp, varValuePtr, incrPtr); if (code == TCL_OK) { - newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, - varValuePtr, flags); + newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, + part2Ptr, varValuePtr, flags, index); } else if (duplicated) { Tcl_DecrRefCount(varValuePtr); } @@ -1931,15 +2109,26 @@ Tcl_UnsetVar2( * TCL_LEAVE_ERR_MSG. */ { int result; - Tcl_Obj *part1Ptr; + Tcl_Obj *part1Ptr, *part2Ptr = NULL; part1Ptr = Tcl_NewStringObj(part1, -1); Tcl_IncrRefCount(part1Ptr); - /* Filter to pass through only the flags this interface supports. */ + if (part2) { + part2Ptr = Tcl_NewStringObj(part2, -1); + Tcl_IncrRefCount(part2Ptr); + } + + /* + * Filter to pass through only the flags this interface supports. + */ + flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG); - result = TclObjUnsetVar2(interp, part1Ptr, part2, flags); - TclDecrRefCount(part1Ptr); + result = TclObjUnsetVar2(interp, part1Ptr, part2Ptr, flags); + Tcl_DecrRefCount(part1Ptr); + if (part2Ptr) { + Tcl_DecrRefCount(part2Ptr); + } return result; } @@ -1969,7 +2158,7 @@ TclObjUnsetVar2( Tcl_Interp *interp, /* Command interpreter in which varName is to * be looked up. */ Tcl_Obj *part1Ptr, /* Name of variable or array. */ - const char *part2, /* Name of element within array or NULL. */ + Tcl_Obj *part2Ptr, /* Name of element within array or NULL. */ int flags) /* OR-ed combination of any of * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_LEAVE_ERR_MSG. */ @@ -1978,10 +2167,8 @@ TclObjUnsetVar2( Interp *iPtr = (Interp *) interp; Var *arrayPtr; int result; - char *part1; - part1 = TclGetString(part1Ptr); - varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "unset", + varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "unset", /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); if (varPtr == NULL) { return TCL_ERROR; @@ -1996,9 +2183,11 @@ TclObjUnsetVar2( * the variable's name. */ - varPtr->refCount++; + if (TclIsVarInHash(varPtr)) { + VarHashRefCount(varPtr)++; + } - UnsetVarStruct(varPtr, arrayPtr, iPtr, part1, part2, flags, 1); + UnsetVarStruct(varPtr, arrayPtr, iPtr, part1Ptr, part2Ptr, flags); /* * It's an error to unset an undefined variable. @@ -2006,8 +2195,8 @@ TclObjUnsetVar2( if (result != TCL_OK) { if (flags & TCL_LEAVE_ERR_MSG) { - TclVarErrMsg(interp, part1, part2, "unset", - ((arrayPtr == NULL) ? noSuchVar : noSuchElement)); + TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset", + ((arrayPtr == NULL) ? noSuchVar : noSuchElement), -1); } } @@ -2030,8 +2219,10 @@ TclObjUnsetVar2( * its value object, if any, was decremented above. */ - varPtr->refCount--; - TclCleanupVar(varPtr, arrayPtr); + if (TclIsVarInHash(varPtr)) { + VarHashRefCount(varPtr)--; + CleanupVar(varPtr, arrayPtr); + } return result; } @@ -2059,23 +2250,21 @@ UnsetVarStruct( Var *varPtr, Var *arrayPtr, Interp *iPtr, - const char *part1, /* NULL if it is to be computed on demand, only for - * variables in a hashtable */ - const char *part2, - int flags, - int reachable) /* indicates if the variable is accessible by name */ + Tcl_Obj *part1Ptr, + Tcl_Obj *part2Ptr, + int flags) { Var dummyVar; - Var *dummyVarPtr; - ActiveVarTrace *activePtr; - Tcl_Obj *part1Ptr = NULL; - int traced = !TclIsVarUntraced(varPtr) - || (arrayPtr && !TclIsVarUntraced(arrayPtr)); + int traced = TclIsVarTraced(varPtr) + || (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET)); - if (arrayPtr && arrayPtr->searchPtr) { - DeleteSearches(arrayPtr); + if (arrayPtr && (arrayPtr->flags & VAR_SEARCH_ACTIVE)) { + DeleteSearches(iPtr, arrayPtr); + } else if (varPtr->flags & VAR_SEARCH_ACTIVE) { + 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 @@ -2088,17 +2277,9 @@ UnsetVarStruct( * gotten recreated by a trace). */ - if (reachable && (traced || TclIsVarArray(varPtr))) { - dummyVar = *varPtr; - dummyVarPtr = &dummyVar; - TclSetVarUndefined(varPtr); - TclSetVarScalar(varPtr); - varPtr->value.objPtr = NULL; /* dummyVar points to any value object */ - varPtr->tracePtr = NULL; - varPtr->searchPtr = NULL; - } else { - dummyVarPtr = varPtr; - } + dummyVar = *varPtr; + dummyVar.flags &= ~VAR_ALL_HASH; + TclSetVarUndefined(varPtr); /* * Call trace functions for the variable being deleted. Then delete its @@ -2106,97 +2287,107 @@ UnsetVarStruct( * still pending. Special tricks: * 1. We need to increment varPtr's refCount around this: TclCallVarTraces * will use dummyVar so it won't increment varPtr's refCount itself. - * 2. Turn off the VAR_TRACE_ACTIVE flag in dummyVar: we want to - * call unset traces even if other traces are pending. + * 2. Turn off the VAR_TRACE_ACTIVE flag in dummyVar: we want to call + * unset traces even if other traces are pending. */ if (traced) { - /* - * Get the variable's name if NULL was passed; - */ + VarTrace *tracePtr = NULL; + Tcl_HashEntry *tPtr = NULL; - if (part1 == NULL) { - Tcl_Interp *interp = (Tcl_Interp *) iPtr; - TclNewObj(part1Ptr); - Tcl_IncrRefCount(part1Ptr); - Tcl_GetVariableFullName(interp, (Tcl_Var) dummyVarPtr, part1Ptr); - part1 = TclGetString(part1Ptr); + if (TclIsVarTraced(&dummyVar)) { + /* + * Transfer any existing traces on var, IF there are unset traces. + * Otherwise just delete them. + */ + + int isNew; + Tcl_HashEntry *tPtr = + Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); + + tracePtr = Tcl_GetHashValue(tPtr); + varPtr->flags &= ~VAR_ALL_TRACES; + Tcl_DeleteHashEntry(tPtr); + if (dummyVar.flags & VAR_TRACED_UNSET) { + tPtr = Tcl_CreateHashEntry(&iPtr->varTraces, + (char *) &dummyVar, &isNew); + Tcl_SetHashValue(tPtr, tracePtr); + } else { + tPtr = NULL; + } } - - dummyVarPtr->flags &= ~VAR_TRACE_ACTIVE; - TclCallVarTraces(iPtr, arrayPtr, dummyVarPtr, part1, part2, (flags - & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) - | TCL_TRACE_UNSETS, /* leaveErrMsg */ 0); - while (dummyVarPtr->tracePtr != NULL) { - VarTrace *tracePtr = dummyVarPtr->tracePtr; - dummyVarPtr->tracePtr = tracePtr->nextPtr; - Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC); - } - for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; - activePtr = activePtr->nextPtr) { - if (activePtr->varPtr == varPtr) { - activePtr->nextTracePtr = NULL; + + if ((dummyVar.flags & VAR_TRACED_UNSET) + || (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET))) { + dummyVar.flags &= ~VAR_TRACE_ACTIVE; + TclObjCallVarTraces(iPtr, arrayPtr, (Var *) &dummyVar, + part1Ptr, part2Ptr, + (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))| TCL_TRACE_UNSETS, + /* leaveErrMsg */ 0, -1); + if (tPtr) { + Tcl_DeleteHashEntry(tPtr); } } - if (part1Ptr) { - Tcl_DecrRefCount(part1Ptr); - part1 = NULL; + + if (tracePtr) { + ActiveVarTrace *activePtr; + + while (tracePtr) { + VarTrace *prevPtr = tracePtr; + + tracePtr = tracePtr->nextPtr; + Tcl_EventuallyFree((ClientData) prevPtr, TCL_DYNAMIC); + } + for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; + activePtr = activePtr->nextPtr) { + if (activePtr->varPtr == varPtr) { + activePtr->nextTracePtr = NULL; + } + } + dummyVar.flags &= ~VAR_ALL_TRACES; } } - if (TclIsVarScalar(dummyVarPtr) - && (dummyVarPtr->value.objPtr != NULL)) { + if (TclIsVarScalar(&dummyVar) && (dummyVar.value.objPtr != NULL)) { /* - * Decrement the ref count of the var's value + * Decrement the ref count of the var's value. */ - - Tcl_Obj *objPtr = dummyVarPtr->value.objPtr; + + Tcl_Obj *objPtr = dummyVar.value.objPtr; + TclDecrRefCount(objPtr); - dummyVarPtr->value.objPtr = NULL; - } else if (TclIsVarLink(varPtr)) { - /* - * For global/upvar variables referenced in procedures, decrement the - * reference count on the variable referred to, and free the - * referenced variable if it's no longer needed. - */ - Var *linkPtr = varPtr->value.linkPtr; - linkPtr->refCount--; - if ((linkPtr->refCount == 0) && TclIsVarUndefined(linkPtr) - && (linkPtr->tracePtr == NULL) - && (linkPtr->flags & VAR_IN_HASHTABLE)) { - if (linkPtr->hPtr != NULL) { - Tcl_DeleteHashEntry(linkPtr->hPtr); - } - ckfree((char *) linkPtr); - } - } else if (TclIsVarArray(dummyVarPtr) && !TclIsVarUndefined(dummyVarPtr)) { + } else if (TclIsVarArray(&dummyVar)) { /* * If the variable is an array, delete all of its elements. This must * be done after calling and deleting the traces on the array, above * (that's the way traces are defined). If the array name is not * present and is required for a trace on some element, it will be - * computed at DeleteArray. + * computed at DeleteArray. */ - - DeleteArray(iPtr, part1, dummyVarPtr, (flags - & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) - | TCL_TRACE_UNSETS); - } - if (dummyVarPtr == varPtr) { - TclSetVarUndefined(varPtr); - TclSetVarScalar(varPtr); + DeleteArray(iPtr, part1Ptr, (Var *) &dummyVar, (flags + & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS); + } else if (TclIsVarLink(&dummyVar)) { + /* + * For global/upvar variables referenced in procedures, decrement the + * reference count on the variable referred to, and free the + * referenced variable if it's no longer needed. + */ + + Var *linkPtr = dummyVar.value.linkPtr; + + if (TclIsVarInHash(linkPtr)) { + VarHashRefCount(linkPtr)--; + CleanupVar(linkPtr, NULL); + } } - + /* * If the variable was a namespace variable, decrement its reference * count. */ - if (TclIsVarNamespaceVar(varPtr)) { - TclClearVarNamespaceVar(varPtr); - varPtr->refCount--; - } + TclClearVarNamespaceVar(varPtr); } /* @@ -2245,17 +2436,17 @@ Tcl_UnsetObjCmd( i = 1; name = TclGetString(objv[i]); if (name[0] == '-') { - if (strcmp("-nocomplain", name) == 0) { + if (strcmp("-nocomplain", name) == 0) { i++; - if (i == objc) { + if (i == objc) { return TCL_OK; } - flags = 0; - name = TclGetString(objv[i]); - } - if (strcmp("--", name) == 0) { - i++; - } + flags = 0; + name = TclGetString(objv[i]); + } + if (strcmp("--", name) == 0) { + i++; + } } for (; i < objc; i++) { @@ -2293,10 +2484,8 @@ Tcl_AppendObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Var *varPtr, *arrayPtr; - char *part1; - register Tcl_Obj *varValuePtr = NULL; - /* Initialized to avoid compiler warning. */ + /* Initialized to avoid compiler warning. */ int i; if (objc < 2) { @@ -2310,9 +2499,8 @@ Tcl_AppendObjCmd( return TCL_ERROR; } } else { - varPtr = TclObjLookupVar(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG, + varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); - part1 = TclGetString(objv[1]); if (varPtr == NULL) { return TCL_ERROR; } @@ -2324,8 +2512,8 @@ Tcl_AppendObjCmd( * variable again. */ - varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL, - objv[i], (TCL_APPEND_VALUE | TCL_LEAVE_ERR_MSG)); + varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, objv[1], NULL, + objv[i], (TCL_APPEND_VALUE | TCL_LEAVE_ERR_MSG), -1); if (varValuePtr == NULL) { return TCL_ERROR; } @@ -2363,7 +2551,6 @@ Tcl_LappendObjCmd( Tcl_Obj *varValuePtr, *newValuePtr; int numElems, createdNewObj; Var *varPtr, *arrayPtr; - char *part1; int result; if (objc < 2) { @@ -2389,7 +2576,7 @@ Tcl_LappendObjCmd( if (result != TCL_OK) { return result; } - } + } } else { /* * We have arguments to append. We used to call Tcl_SetVar2 to append @@ -2409,21 +2596,24 @@ Tcl_LappendObjCmd( * and unused. */ - varPtr = TclObjLookupVar(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG, + varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { return TCL_ERROR; } - varPtr->refCount++; - if (arrayPtr != NULL) { - arrayPtr->refCount++; + if (TclIsVarInHash(varPtr)) { + VarHashRefCount(varPtr)++; } - part1 = TclGetString(objv[1]); - varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, NULL, - TCL_LEAVE_ERR_MSG); - varPtr->refCount--; - if (arrayPtr != NULL) { - arrayPtr->refCount--; + if (arrayPtr && TclIsVarInHash(arrayPtr)) { + VarHashRefCount(arrayPtr)++; + } + varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, objv[1], NULL, + TCL_LEAVE_ERR_MSG, -1); + if (TclIsVarInHash(varPtr)) { + VarHashRefCount(varPtr)--; + } + if (arrayPtr && TclIsVarInHash(arrayPtr)) { + VarHashRefCount(arrayPtr)--; } if (varValuePtr == NULL) { @@ -2447,7 +2637,7 @@ Tcl_LappendObjCmd( } if (result != TCL_OK) { if (createdNewObj) { - TclDecrRefCount(varValuePtr); /* free unneeded obj. */ + TclDecrRefCount(varValuePtr); /* Free unneeded obj. */ } return result; } @@ -2458,8 +2648,8 @@ Tcl_LappendObjCmd( * and we didn't create the variable. */ - newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL, - varValuePtr, TCL_LEAVE_ERR_MSG); + newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, objv[1], NULL, + varValuePtr, TCL_LEAVE_ERR_MSG, -1); if (newValuePtr == NULL) { return TCL_ERROR; } @@ -2519,7 +2709,6 @@ Tcl_ArrayObjCmd( Tcl_HashEntry *hPtr; Tcl_Obj *varNamePtr; int notArray; - char *varName; int index, result; if (objc < 3) { @@ -2529,7 +2718,7 @@ Tcl_ArrayObjCmd( if (Tcl_GetIndexFromObj(interp, objv[1], arrayOptions, "option", 0, &index) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } /* @@ -2537,8 +2726,7 @@ Tcl_ArrayObjCmd( */ varNamePtr = objv[2]; - varName = TclGetString(varNamePtr); - varPtr = TclObjLookupVar(interp, varNamePtr, NULL, /*flags*/ 0, + varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL, /*flags*/ 0, /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); /* @@ -2546,11 +2734,11 @@ Tcl_ArrayObjCmd( * array get, etc. */ - if (varPtr != NULL && varPtr->tracePtr != NULL + if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY) && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) { - if (TCL_ERROR == TclCallVarTraces(iPtr, arrayPtr, varPtr, varName, + if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNamePtr, NULL, (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY| - TCL_TRACE_ARRAY), /* leaveErrMsg */ 1)) { + TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1)) { return TCL_ERROR; } } @@ -2578,7 +2766,7 @@ Tcl_ArrayObjCmd( if (notArray) { goto error; } - searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]); + searchPtr = ParseSearchId(interp, varPtr, varNamePtr, objv[3]); if (searchPtr == NULL) { return TCL_ERROR; } @@ -2586,7 +2774,7 @@ Tcl_ArrayObjCmd( Var *varPtr2; if (searchPtr->nextEntry != NULL) { - varPtr2 = (Var *) Tcl_GetHashValue(searchPtr->nextEntry); + varPtr2 = VarHashGetValue(searchPtr->nextEntry); if (!TclIsVarUndefined(varPtr2)) { break; } @@ -2610,14 +2798,20 @@ Tcl_ArrayObjCmd( if (notArray) { goto error; } - searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]); + searchPtr = ParseSearchId(interp, varPtr, varNamePtr, objv[3]); if (searchPtr == NULL) { return TCL_ERROR; } - if (varPtr->searchPtr == searchPtr) { - varPtr->searchPtr = searchPtr->nextPtr; + hPtr = Tcl_FindHashEntry(&iPtr->varSearches,(char *) varPtr); + if (searchPtr == Tcl_GetHashValue(hPtr)) { + if (searchPtr->nextPtr) { + Tcl_SetHashValue(hPtr, searchPtr->nextPtr); + } else { + varPtr->flags &= ~VAR_SEARCH_ACTIVE; + Tcl_DeleteHashEntry(hPtr); + } } else { - for (prevPtr=varPtr->searchPtr ;; prevPtr=prevPtr->nextPtr) { + for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) { if (prevPtr->nextPtr == searchPtr) { prevPtr->nextPtr = searchPtr->nextPtr; break; @@ -2630,6 +2824,7 @@ Tcl_ArrayObjCmd( case ARRAY_NEXTELEMENT: { ArraySearch *searchPtr; Tcl_HashEntry *hPtr; + Var *varPtr2; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId"); @@ -2638,13 +2833,11 @@ Tcl_ArrayObjCmd( if (notArray) { goto error; } - searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]); + searchPtr = ParseSearchId(interp, varPtr, varNamePtr, objv[3]); if (searchPtr == NULL) { return TCL_ERROR; } while (1) { - Var *varPtr2; - hPtr = searchPtr->nextEntry; if (hPtr == NULL) { hPtr = Tcl_NextHashEntry(&searchPtr->search); @@ -2654,17 +2847,18 @@ Tcl_ArrayObjCmd( } else { searchPtr->nextEntry = NULL; } - varPtr2 = (Var *) Tcl_GetHashValue(hPtr); + varPtr2 = VarHashGetValue(hPtr); if (!TclIsVarUndefined(varPtr2)) { break; } } - Tcl_SetObjResult(interp, Tcl_NewStringObj( - Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), -1)); + Tcl_SetObjResult(interp, VarHashGetKey(varPtr2)); break; } case ARRAY_STARTSEARCH: { ArraySearch *searchPtr; + int new; + char *varName = TclGetString(varNamePtr); if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "arrayName"); @@ -2674,21 +2868,25 @@ Tcl_ArrayObjCmd( goto error; } searchPtr = (ArraySearch *) ckalloc(sizeof(ArraySearch)); - if (varPtr->searchPtr == NULL) { + hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, + (char *) varPtr, &new); + if (new) { searchPtr->id = 1; Tcl_AppendResult(interp, "s-1-", varName, NULL); + varPtr->flags |= VAR_SEARCH_ACTIVE; + searchPtr->nextPtr = NULL; } else { char string[TCL_INTEGER_SPACE]; - searchPtr->id = varPtr->searchPtr->id + 1; + searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1; TclFormatInt(string, searchPtr->id); Tcl_AppendResult(interp, "s-", string, "-", varName, NULL); + searchPtr->nextPtr = Tcl_GetHashValue(hPtr); } searchPtr->varPtr = varPtr; - searchPtr->nextEntry = Tcl_FirstHashEntry(varPtr->value.tablePtr, + searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr, &searchPtr->search); - searchPtr->nextPtr = varPtr->searchPtr; - varPtr->searchPtr = searchPtr; + Tcl_SetHashValue(hPtr, searchPtr); break; } @@ -2725,37 +2923,34 @@ Tcl_ArrayObjCmd( TclNewObj(nameLstPtr); Tcl_IncrRefCount(nameLstPtr); if ((pattern != NULL) && TclMatchIsTrivial(pattern)) { - hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, pattern); - if (hPtr == NULL) { + varPtr2 = VarHashFindVar(varPtr->value.tablePtr, objv[3]); + if (varPtr2 == NULL) { goto searchDone; } - varPtr2 = (Var *) Tcl_GetHashValue(hPtr); if (TclIsVarUndefined(varPtr2)) { goto searchDone; } result = Tcl_ListObjAppendElement(interp, nameLstPtr, - Tcl_NewStringObj(pattern, -1)); + VarHashGetKey(varPtr2)); if (result != TCL_OK) { TclDecrRefCount(nameLstPtr); return result; } goto searchDone; } - for (hPtr=Tcl_FirstHashEntry(varPtr->value.tablePtr, &search); - hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) { - varPtr2 = (Var *) Tcl_GetHashValue(hPtr); + for (varPtr2 = VarHashFirstVar(varPtr->value.tablePtr, &search); + varPtr2; varPtr2 = VarHashNextVar(&search)) { if (TclIsVarUndefined(varPtr2)) { continue; } - name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr); + namePtr = VarHashGetKey(varPtr2); + name = TclGetString(namePtr); if ((objc == 4) && !Tcl_StringMatch(name, pattern)) { - continue; /* element name doesn't match pattern */ + continue; /* Element name doesn't match pattern. */ } - namePtr = Tcl_NewStringObj(name, -1); result = Tcl_ListObjAppendElement(interp, nameLstPtr, namePtr); if (result != TCL_OK) { - TclDecrRefCount(namePtr); /* free unneeded name obj */ TclDecrRefCount(nameLstPtr); return result; } @@ -2767,15 +2962,16 @@ Tcl_ArrayObjCmd( * while we're working. */ - varPtr->refCount++; + if (TclIsVarInHash(varPtr)) { + VarHashRefCount(varPtr)++; + } /* - * Get the array values corresponding to each element name + * Get the array values corresponding to each element name. */ TclNewObj(tmpResPtr); - result = Tcl_ListObjGetElements(interp, nameLstPtr, - &count, &namePtrPtr); + result = Tcl_ListObjGetElements(interp, nameLstPtr, &count, &namePtrPtr); if (result != TCL_OK) { goto errorInArrayGet; } @@ -2791,7 +2987,7 @@ Tcl_ArrayObjCmd( * the modification modify the complete array? */ - if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) { + if (TclIsVarArray(varPtr)) { /* * The array itself looks OK, the variable was undefined: * forget it. @@ -2808,15 +3004,19 @@ Tcl_ArrayObjCmd( goto errorInArrayGet; } } - varPtr->refCount--; + if (TclIsVarInHash(varPtr)) { + VarHashRefCount(varPtr)--; + } Tcl_SetObjResult(interp, tmpResPtr); TclDecrRefCount(nameLstPtr); break; errorInArrayGet: - varPtr->refCount--; + if (TclIsVarInHash(varPtr)) { + VarHashRefCount(varPtr)--; + } TclDecrRefCount(nameLstPtr); - TclDecrRefCount(tmpResPtr); /* free unneeded temp result */ + TclDecrRefCount(tmpResPtr); /* Free unneeded temp result. */ return result; } case ARRAY_NAMES: { @@ -2852,11 +3052,10 @@ Tcl_ArrayObjCmd( TclNewObj(resultPtr); if (((enum options) mode)==OPT_GLOB && pattern!=NULL && TclMatchIsTrivial(pattern)) { - hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, pattern); - if ((hPtr != NULL) && - !TclIsVarUndefined((Var *) Tcl_GetHashValue(hPtr))) { + varPtr2 = VarHashFindVar(varPtr->value.tablePtr, objv[3]); + if ((varPtr2 != NULL) && !TclIsVarUndefined(varPtr2)) { result = Tcl_ListObjAppendElement(interp, resultPtr, - Tcl_NewStringObj(pattern, -1)); + VarHashGetKey(varPtr2)); if (result != TCL_OK) { TclDecrRefCount(resultPtr); return result; @@ -2865,13 +3064,13 @@ Tcl_ArrayObjCmd( Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } - for (hPtr=Tcl_FirstHashEntry(varPtr->value.tablePtr, &search); - hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) { - varPtr2 = (Var *) Tcl_GetHashValue(hPtr); + for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search); + varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) { if (TclIsVarUndefined(varPtr2)) { continue; } - name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr); + namePtr = VarHashGetKey(varPtr2); + name = TclGetString(namePtr); if (objc > 3) { switch ((enum options) mode) { case OPT_EXACT: @@ -2893,11 +3092,9 @@ Tcl_ArrayObjCmd( } } - namePtr = Tcl_NewStringObj(name, -1); result = Tcl_ListObjAppendElement(interp, resultPtr, namePtr); if (result != TCL_OK) { - TclDecrRefCount(resultPtr); - TclDecrRefCount(namePtr); /* free unneeded name obj */ + TclDecrRefCount(namePtr); /* Free unneeded name obj. */ return result; } } @@ -2914,7 +3111,6 @@ Tcl_ArrayObjCmd( Tcl_HashSearch search; Var *varPtr2; char *pattern = NULL; - char *name; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?"); @@ -2934,22 +3130,22 @@ Tcl_ArrayObjCmd( } else { pattern = TclGetString(objv[3]); if (TclMatchIsTrivial(pattern)) { - hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, pattern); - if (hPtr != NULL && - !TclIsVarUndefined((Var *)Tcl_GetHashValue(hPtr))){ - return TclObjUnsetVar2(interp, varNamePtr, pattern, 0); + varPtr2 = VarHashFindVar(varPtr->value.tablePtr, objv[3]); + if (varPtr2 != NULL && !TclIsVarUndefined(varPtr2)) { + return TclObjUnsetVar2(interp, varNamePtr, objv[3], 0); } return TCL_OK; } - for (hPtr=Tcl_FirstHashEntry(varPtr->value.tablePtr, &search); - hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) { - varPtr2 = (Var *) Tcl_GetHashValue(hPtr); + for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search); + varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) { + Tcl_Obj *namePtr; + if (TclIsVarUndefined(varPtr2)) { continue; } - name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr); - if (Tcl_StringMatch(name, pattern) && - TclObjUnsetVar2(interp, varNamePtr, name, + namePtr = VarHashGetKey(varPtr2); + if (Tcl_StringMatch(TclGetString(namePtr), pattern) && + TclObjUnsetVar2(interp, varNamePtr, namePtr, 0) != TCL_OK) { return TCL_ERROR; } @@ -2975,9 +3171,8 @@ Tcl_ArrayObjCmd( */ if (!notArray) { - for (hPtr=Tcl_FirstHashEntry(varPtr->value.tablePtr, &search); - hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) { - varPtr2 = (Var *) Tcl_GetHashValue(hPtr); + for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search); + varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) { if (TclIsVarUndefined(varPtr2)) { continue; } @@ -2995,7 +3190,7 @@ Tcl_ArrayObjCmd( goto error; } - stats = Tcl_HashStats(varPtr->value.tablePtr); + stats = Tcl_HashStats((Tcl_HashTable *) varPtr->value.tablePtr); if (stats != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1)); ckfree((void *)stats); @@ -3009,7 +3204,8 @@ Tcl_ArrayObjCmd( return TCL_OK; error: - Tcl_AppendResult(interp, "\"", varName, "\" isn't an array", NULL); + Tcl_AppendResult(interp, "\"", TclGetString(varNamePtr), + "\" isn't an array", NULL); return TCL_ERROR; } @@ -3039,26 +3235,19 @@ TclArraySet( * NULL, create an empty array. */ { Var *varPtr, *arrayPtr; - int result, i, nameLen; - char *varName, *p; - - varName = Tcl_GetStringFromObj(arrayNameObj, &nameLen); - p = varName + nameLen - 1; - if (*p == ')') { - while (--p >= varName) { - if (*p == '(') { - TclVarErrMsg(interp, varName, NULL, "set", needArray); - return TCL_ERROR; - } - } - } + int result, i; - varPtr = TclObjLookupVar(interp, arrayNameObj, NULL, + varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL, /*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "set", /*createPart1*/ 1, - /*createPart2*/ 0, &arrayPtr); + /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { return TCL_ERROR; } + if (arrayPtr) { + CleanupVar(varPtr, arrayPtr); + TclObjVarErrMsg(interp, arrayNameObj, NULL, "set", needArray, -1); + return TCL_ERROR; + } if (arrayElemObj == NULL) { goto ensureArray; @@ -3098,13 +3287,12 @@ TclArraySet( * by the array. This isn't the case though. */ - char *part2 = TclGetString(keyPtr); - Var *elemVarPtr = TclLookupArrayElement(interp, varName, - part2, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr); + Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj, + keyPtr, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1); if ((elemVarPtr == NULL) || - (TclPtrSetVar(interp, elemVarPtr, varPtr, varName, - part2, valuePtr, TCL_LEAVE_ERR_MSG) == NULL)) { + (TclPtrSetVar(interp, elemVarPtr, varPtr, arrayNameObj, + keyPtr, valuePtr, TCL_LEAVE_ERR_MSG, -1) == NULL)) { Tcl_DictObjDone(&search); return TCL_ERROR; } @@ -3112,9 +3300,10 @@ TclArraySet( return TCL_OK; } else { /* - * Not a dictionary, so assume (and convert to, for - * backward-compatability reasons) a list. + * Not a dictionary, so assume (and convert to, for backward- + * -compatability reasons) a list. */ + int elemLen; Tcl_Obj **elemPtrs, *copyListObj; @@ -3140,13 +3329,12 @@ TclArraySet( copyListObj = TclListObjCopy(NULL, arrayElemObj); for (i=0 ; ivalue.tablePtr = (Tcl_HashTable *) - ckalloc(sizeof(Tcl_HashTable)); - Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS); + varPtr->value.tablePtr = (TclVarHashTable *) + ckalloc(sizeof(TclVarHashTable)); + TclInitVarHashTable(varPtr->value.tablePtr, TclGetVarNsPtr(varPtr)); return TCL_OK; } @@ -3216,7 +3404,7 @@ ObjMakeUpvar( const char *otherP2, /* Two-part name of variable in framePtr. */ const int otherFlags, /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of "other" variable. */ - const char *myName, /* Name of variable which will refer to + Tcl_Obj *myNamePtr, /* Name of variable which will refer to * otherP1/otherP2. Must be a scalar. */ int myFlags, /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of myName. */ @@ -3236,7 +3424,7 @@ ObjMakeUpvar( if (framePtr == NULL) { framePtr = iPtr->rootFramePtr; } - + varFramePtr = iPtr->varFramePtr; if (!(otherFlags & TCL_NAMESPACE_ONLY)) { iPtr->varFramePtr = framePtr; @@ -3259,19 +3447,22 @@ ObjMakeUpvar( */ if (index < 0) { - if (((arrayPtr ? arrayPtr->nsPtr : otherPtr->nsPtr) == NULL) + if ((0 == (arrayPtr + ? (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr)) + : (TclIsVarInHash(otherPtr) && TclGetVarNsPtr(otherPtr)))) && ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) || (varFramePtr == NULL) || !HasLocalVars(varFramePtr) - || (strstr(myName, "::") != NULL))) { + || (strstr(TclGetString(myNamePtr), "::") != NULL))) { Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"", - myName, "\": upvar won't create namespace variable that " - "refers to procedure variable", NULL); + TclGetString(myNamePtr), "\": upvar won't create " + "namespace variable that refers to procedure variable", + NULL); return TCL_ERROR; } } - return TclPtrMakeUpvar(interp, otherPtr, myName, myFlags, index); + return TclPtrObjMakeUpvar(interp, otherPtr, myNamePtr, myFlags, index); } /* @@ -3298,7 +3489,7 @@ int TclPtrMakeUpvar( Tcl_Interp *interp, /* Interpreter containing variables. Used for * error messages, too. */ - Var *otherPtr, /* Pointer to the variable being linked-to */ + Var *otherPtr, /* Pointer to the variable being linked-to. */ const char *myName, /* Name of variable which will refer to * otherP1/otherP2. Must be a scalar. */ int myFlags, /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: @@ -3306,18 +3497,48 @@ TclPtrMakeUpvar( int index) /* If the variable to be linked is an indexed * scalar, this is its index. Otherwise, -1 */ { + Tcl_Obj *myNamePtr; + int result; + + if (myName) { + myNamePtr = Tcl_NewStringObj(myName, -1); + Tcl_IncrRefCount(myNamePtr); + } else { + myNamePtr = NULL; + } + result = TclPtrObjMakeUpvar(interp, otherPtr, myNamePtr, myFlags, index); + if (myNamePtr) { + Tcl_DecrRefCount(myNamePtr); + } + return result; +} + +int +TclPtrObjMakeUpvar( + Tcl_Interp *interp, /* Interpreter containing variables. Used for + * error messages, too. */ + Var *otherPtr, /* Pointer to the variable being linked-to. */ + Tcl_Obj *myNamePtr, /* Name of variable which will refer to + * otherP1/otherP2. Must be a scalar. */ + int myFlags, /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: + * indicates scope of myName. */ + int index) /* If the variable to be linked is an indexed + * scalar, this is its index. Otherwise, -1 */ +{ Interp *iPtr = (Interp *) interp; CallFrame *varFramePtr = iPtr->varFramePtr; Var *varPtr; const char *errMsg; - const char *p; - + const char *p; + const char *myName; + if (index >= 0) { if (!HasLocalVars(varFramePtr)) { Tcl_Panic("ObjMakeUpvar called with an index outside from a proc"); } - varPtr = &(varFramePtr->compiledLocals[index]); - myName = varPtr->name; + varPtr = (Var *) &(varFramePtr->compiledLocals[index]); + myNamePtr = localName(iPtr->varFramePtr, index); + myName = myNamePtr? TclGetString(myNamePtr) : NULL; } else { /* * Do not permit the new variable to look like an array reference, as @@ -3326,6 +3547,7 @@ TclPtrMakeUpvar( * (and must remain consistent) with the code in TclObjLookupVar(). */ + myName = TclGetString(myNamePtr); p = strstr(myName, "("); if (p != NULL) { p += strlen(p)-1; @@ -3350,10 +3572,10 @@ TclPtrMakeUpvar( * - Bug #631741 - do not use special namespace or interp resolvers. */ - varPtr = TclLookupSimpleVar(interp, myName, (myFlags|LOOKUP_FOR_UPVAR), - /* create */ 1, &errMsg, &index); + varPtr = TclLookupSimpleVar(interp, myNamePtr, + (myFlags|LOOKUP_FOR_UPVAR), /* create */ 1, &errMsg, &index); if (varPtr == NULL) { - TclVarErrMsg(interp, myName, NULL, "create", errMsg); + TclObjVarErrMsg(interp, myNamePtr, NULL, "create", errMsg, -1); return TCL_ERROR; } } @@ -3364,7 +3586,7 @@ TclPtrMakeUpvar( return TCL_ERROR; } - if (varPtr->tracePtr != NULL) { + if (TclIsVarTraced(varPtr)) { Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName, "\" has traces: can't use for upvar", NULL); return TCL_ERROR; @@ -3381,9 +3603,11 @@ TclPtrMakeUpvar( if (linkPtr == otherPtr) { return TCL_OK; } - linkPtr->refCount--; - if (TclIsVarUndefined(linkPtr)) { - TclCleanupVar(linkPtr, NULL); + if (TclIsVarInHash(linkPtr)) { + VarHashRefCount(linkPtr)--; + if (TclIsVarUndefined(linkPtr)) { + CleanupVar(linkPtr, NULL); + } } } else { Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName, @@ -3392,9 +3616,10 @@ TclPtrMakeUpvar( } } TclSetVarLink(varPtr); - TclClearVarUndefined(varPtr); varPtr->value.linkPtr = otherPtr; - otherPtr->refCount++; + if (TclIsVarInHash(otherPtr)) { + VarHashRefCount(otherPtr)++; + } return TCL_OK; } @@ -3469,7 +3694,7 @@ Tcl_UpVar2( { int result; CallFrame *framePtr; - Tcl_Obj *part1Ptr; + Tcl_Obj *part1Ptr, *localNamePtr; if (TclGetFrame(interp, frameName, &framePtr) == -1) { return TCL_ERROR; @@ -3477,10 +3702,13 @@ Tcl_UpVar2( part1Ptr = Tcl_NewStringObj(part1, -1); Tcl_IncrRefCount(part1Ptr); - result = ObjMakeUpvar(interp, framePtr, part1Ptr, part2, 0, - localName, flags, -1); - TclDecrRefCount(part1Ptr); + localNamePtr = Tcl_NewStringObj(localName, -1); + Tcl_IncrRefCount(localNamePtr); + result = ObjMakeUpvar(interp, framePtr, part1Ptr, part2, 0, + localNamePtr, flags, -1); + Tcl_DecrRefCount(part1Ptr); + Tcl_DecrRefCount(localNamePtr); return result; } @@ -3513,26 +3741,35 @@ Tcl_GetVariableFullName( { Interp *iPtr = (Interp *) interp; register Var *varPtr = (Var *) variable; - char *name; + Tcl_Obj *namePtr; + Namespace *nsPtr; /* * Add the full name of the containing namespace (if any), followed by the * "::" separator, then the variable name. */ - if (varPtr != NULL) { + if (varPtr) { if (!TclIsVarArrayElement(varPtr)) { - if (varPtr->nsPtr != NULL) { - Tcl_AppendToObj(objPtr, varPtr->nsPtr->fullName, -1); - if (varPtr->nsPtr != iPtr->globalNsPtr) { + nsPtr = TclGetVarNsPtr(varPtr); + if (nsPtr) { + Tcl_AppendToObj(objPtr, nsPtr->fullName, -1); + if (nsPtr != iPtr->globalNsPtr) { Tcl_AppendToObj(objPtr, "::", 2); } } - if (varPtr->name != NULL) { - Tcl_AppendToObj(objPtr, varPtr->name, -1); - } else if (varPtr->hPtr != NULL) { - name = Tcl_GetHashKey(varPtr->hPtr->tablePtr, varPtr->hPtr); - Tcl_AppendToObj(objPtr, name, -1); + if (TclIsVarInHash(varPtr)) { + if (!TclIsVarDeadHash(varPtr)) { + namePtr = VarHashGetKey(varPtr); + Tcl_AppendObjToObj(objPtr, namePtr); + } + } else if (iPtr->varFramePtr->procPtr) { + int index = varPtr - iPtr->varFramePtr->compiledLocals; + + if (index < iPtr->varFramePtr->numCompiledLocals) { + namePtr = localName(iPtr->varFramePtr, index); + Tcl_AppendObjToObj(objPtr, namePtr); + } } } } @@ -3563,7 +3800,7 @@ Tcl_GlobalObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; - register Tcl_Obj *objPtr; + register Tcl_Obj *objPtr, *tailPtr; char *varName; register char *tail; int result, i; @@ -3605,12 +3842,24 @@ Tcl_GlobalObjCmd( tail++; } + if (tail == varName) { + tailPtr = objPtr; + } else { + tailPtr = Tcl_NewStringObj(tail, -1); + Tcl_IncrRefCount(tailPtr); + } + /* * Link to the variable "varName" in the global :: namespace. */ result = ObjMakeUpvar(interp, NULL, objPtr, NULL, - TCL_GLOBAL_ONLY, /*myName*/ tail, /*myFlags*/ 0, -1); + TCL_GLOBAL_ONLY, /*myName*/ tailPtr, /*myFlags*/ 0, -1); + + if (tail != varName) { + Tcl_DecrRefCount(tailPtr); + } + if (result != TCL_OK) { return result; } @@ -3664,7 +3913,7 @@ Tcl_VariableObjCmd( Var *varPtr, *arrayPtr; Tcl_Obj *varValuePtr; int i, result; - Tcl_Obj *varNamePtr; + Tcl_Obj *varNamePtr, *tailPtr; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "?name value...? name ?value?"); @@ -3679,7 +3928,7 @@ Tcl_VariableObjCmd( varNamePtr = objv[i]; varName = TclGetString(varNamePtr); - varPtr = TclObjLookupVar(interp, varNamePtr, NULL, + varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL, (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "define", /*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr); @@ -3689,7 +3938,8 @@ Tcl_VariableObjCmd( * non-NULL, it is, so throw up an error and return. */ - TclVarErrMsg(interp, varName, NULL, "define", isArrayElement); + TclObjVarErrMsg(interp, varNamePtr, NULL, "define", + isArrayElement, -1); return TCL_ERROR; } @@ -3703,10 +3953,7 @@ Tcl_VariableObjCmd( * destroyed or until the variable is unset. */ - if (!TclIsVarNamespaceVar(varPtr)) { - TclSetVarNamespaceVar(varPtr); - varPtr->refCount++; - } + TclSetVarNamespaceVar(varPtr); /* * If a value was specified, set the variable to that value. @@ -3715,9 +3962,9 @@ Tcl_VariableObjCmd( * unchanged; just create the local link if we're in a Tcl procedure). */ - if (i+1 < objc) { /* a value was specified */ - varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, varName, NULL, - objv[i+1], (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG)); + if (i+1 < objc) { /* A value was specified. */ + varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, varNamePtr, + NULL, objv[i+1], TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG,-1); if (varValuePtr == NULL) { return TCL_ERROR; } @@ -3750,9 +3997,21 @@ Tcl_VariableObjCmd( * current namespace. */ + if (tail == varName) { + tailPtr = varNamePtr; + } else { + tailPtr = Tcl_NewStringObj(tail, -1); + Tcl_IncrRefCount(tailPtr); + } + result = ObjMakeUpvar(interp, NULL, varNamePtr, /*otherP2*/ NULL, /*otherFlags*/ TCL_NAMESPACE_ONLY, - /*myName*/ tail, /*myFlags*/ 0, -1); + /*myName*/ tailPtr, /*myFlags*/ 0, -1); + + if (tail != varName) { + Tcl_DecrRefCount(tailPtr); + } + if (result != TCL_OK) { return result; } @@ -3787,7 +4046,6 @@ Tcl_UpvarObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { CallFrame *framePtr; - char *localName; int result; if (objc < 3) { @@ -3819,9 +4077,8 @@ Tcl_UpvarObjCmd( */ for (; objc>0 ; objc-=2, objv+=2) { - localName = TclGetString(objv[1]); result = ObjMakeUpvar(interp, framePtr, /* othervarName */ objv[0], - NULL, 0, /* myVarName */ localName, /*flags*/ 0, -1); + NULL, 0, /* myVarName */ objv[1], /*flags*/ 0, -1); if (result != TCL_OK) { return TCL_ERROR; } @@ -3832,44 +4089,6 @@ Tcl_UpvarObjCmd( /* *---------------------------------------------------------------------- * - * NewVar -- - * - * Create a new heap-allocated variable that will eventually be entered - * into a hashtable. - * - * Results: - * The return value is a pointer to the new variable structure. It is - * marked as a scalar variable (and not a link or array variable). Its - * value initially is NULL. The variable is not part of any hash table - * yet. Since it will be in a hashtable and not in a call frame, its name - * field is set NULL. It is initially marked as undefined. - * - * Side effects: - * Storage gets allocated. - * - *---------------------------------------------------------------------- - */ - -static Var * -NewVar(void) -{ - register Var *varPtr; - - varPtr = (Var *) ckalloc(sizeof(Var)); - varPtr->value.objPtr = NULL; - varPtr->name = NULL; - varPtr->nsPtr = NULL; - varPtr->hPtr = NULL; - varPtr->refCount = 0; - varPtr->tracePtr = NULL; - varPtr->searchPtr = NULL; - varPtr->flags = (VAR_SCALAR | VAR_UNDEFINED | VAR_IN_HASHTABLE); - return varPtr; -} - -/* - *---------------------------------------------------------------------- - * * SetArraySearchObj -- * * This function converts the given tcl object into one that has the @@ -3959,17 +4178,19 @@ static ArraySearch * ParseSearchId( Tcl_Interp *interp, /* Interpreter containing variable. */ const Var *varPtr, /* Array variable search is for. */ - const char *varName, /* Name of array variable that search is + Tcl_Obj *varNamePtr, /* Name of array variable that search is * supposed to be for. */ Tcl_Obj *handleObj) /* Object containing id of search. Must have * form "search-num-var" where "num" is a * decimal number and "var" is a variable * name. */ { + Interp *iPtr = (Interp *) interp; register char *string; register size_t offset; int id; ArraySearch *searchPtr; + char *varName = TclGetString(varNamePtr); /* * Parse the id. @@ -4012,10 +4233,15 @@ ParseSearchId( * this list every time. */ - for (searchPtr = varPtr->searchPtr; searchPtr != NULL; - searchPtr = searchPtr->nextPtr) { - if (searchPtr->id == id) { - return searchPtr; + if (varPtr->flags & VAR_SEARCH_ACTIVE) { + Tcl_HashEntry *hPtr = + Tcl_FindHashEntry(&iPtr->varSearches,(char *) varPtr); + + for (searchPtr = (ArraySearch *) Tcl_GetHashValue(hPtr); + searchPtr != NULL; searchPtr = searchPtr->nextPtr) { + if (searchPtr->id == id) { + return searchPtr; + } } } Tcl_AppendResult(interp, "couldn't find search \"", string, "\"", NULL); @@ -4042,15 +4268,22 @@ ParseSearchId( static void DeleteSearches( + Interp *iPtr, register Var *arrayVarPtr) /* Variable whose searches are to be * deleted. */ { - ArraySearch *searchPtr; - - while (arrayVarPtr->searchPtr != NULL) { - searchPtr = arrayVarPtr->searchPtr; - arrayVarPtr->searchPtr = searchPtr->nextPtr; - ckfree((char *) searchPtr); + ArraySearch *searchPtr, *nextPtr; + Tcl_HashEntry *sPtr; + + if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) { + sPtr = Tcl_FindHashEntry(&iPtr->varSearches, (char *) arrayVarPtr); + for (searchPtr = (ArraySearch *) Tcl_GetHashValue(sPtr); + searchPtr != NULL; searchPtr = nextPtr) { + nextPtr = searchPtr->nextPtr; + ckfree((char *) searchPtr); + } + arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE; + Tcl_DeleteHashEntry(sPtr); } } @@ -4076,12 +4309,12 @@ void TclDeleteNamespaceVars( Namespace *nsPtr) { - Tcl_HashTable *tablePtr = &nsPtr->varTable; + TclVarHashTable *tablePtr = &nsPtr->varTable; Tcl_Interp *interp = nsPtr->interp; Interp *iPtr = (Interp *)interp; Tcl_HashSearch search; - Tcl_HashEntry *hPtr; int flags = 0; + Var *varPtr; /* * Determine what flags to pass to the trace callback functions. @@ -4093,30 +4326,36 @@ TclDeleteNamespaceVars( flags = TCL_NAMESPACE_ONLY; } - for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL; - hPtr = Tcl_FirstHashEntry(tablePtr, &search)) { - register Var *varPtr = (Var *) Tcl_GetHashValue(hPtr); - varPtr->refCount++; /* Make sure we get to remove from hash */ - UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ NULL, NULL, flags, 1); - varPtr->refCount--; + for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL; + varPtr = VarHashFirstVar(tablePtr, &search)) { + VarHashRefCount(varPtr)++; /* Make sure we get to remove from + * hash. */ + UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ VarHashGetKey(varPtr), + NULL, flags); /* * Remove the variable from the table and force it undefined in case * an unset trace brought it back from the dead. */ - Tcl_DeleteHashEntry(hPtr); - varPtr->hPtr = NULL; - TclSetVarUndefined(varPtr); - TclSetVarScalar(varPtr); - while (varPtr->tracePtr != NULL) { - VarTrace *tracePtr = varPtr->tracePtr; - varPtr->tracePtr = tracePtr->nextPtr; - Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC); + if (TclIsVarTraced(varPtr)) { + Tcl_HashEntry *tPtr = Tcl_FindHashEntry(&iPtr->varTraces, + (char *) varPtr); + VarTrace *tracePtr = (VarTrace *) Tcl_GetHashValue(tPtr); + + while (tracePtr) { + VarTrace *prevPtr = tracePtr; + + tracePtr = tracePtr->nextPtr; + Tcl_EventuallyFree((ClientData) prevPtr, TCL_DYNAMIC); + } + Tcl_DeleteHashEntry(tPtr); + varPtr->flags &= ~VAR_ALL_TRACES; } - TclCleanupVar(varPtr, NULL); + VarHashRefCount(varPtr)--; + VarHashDeleteEntry(varPtr); } - Tcl_DeleteHashTable(tablePtr); + VarHashDeleteTable(tablePtr); } /* @@ -4142,16 +4381,15 @@ TclDeleteNamespaceVars( void TclDeleteVars( Interp *iPtr, /* Interpreter to which variables belong. */ - Tcl_HashTable *tablePtr) /* Hash table containing variables to + TclVarHashTable *tablePtr) /* Hash table containing variables to * delete. */ { Tcl_Interp *interp = (Tcl_Interp *) iPtr; Tcl_HashSearch search; - Tcl_HashEntry *hPtr; register Var *varPtr; int flags; Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); - + /* * Determine what flags to pass to the trace callback functions. */ @@ -4163,24 +4401,17 @@ TclDeleteVars( flags |= TCL_NAMESPACE_ONLY; } - for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL; - hPtr = Tcl_NextHashEntry(&search)) { - varPtr = (Var *) Tcl_GetHashValue(hPtr); - - UnsetVarStruct(varPtr, NULL, iPtr, NULL, NULL, flags, 0); - varPtr->hPtr = NULL; - + for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL; + varPtr = VarHashNextVar(&search)) { /* - * Recycle the variable's memory space if there aren't any upvar's - * pointing to it. If there are upvars to this variable, then the - * variable will get freed when the last upvar goes away. + * Lie about the validity of the hashtable entry. In this way the + * variables will be deleted by VarHashDeleteTable. */ - if (varPtr->refCount == 0) { - ckfree((char *) varPtr); /* this Var must be VAR_IN_HASHTABLE */ - } + VarHashInvalidateEntry(varPtr); + UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), NULL, flags); } - Tcl_DeleteHashTable(tablePtr); + VarHashDeleteTable(tablePtr); } /* @@ -4213,77 +4444,14 @@ TclDeleteCompiledLocalVars( { register Var *varPtr; int numLocals, i; + Tcl_Obj **namePtrPtr; numLocals = framePtr->numCompiledLocals; varPtr = framePtr->compiledLocals; - for (i=0 ; iname, NULL, TCL_TRACE_UNSETS, 0); - varPtr++; -#else - if (!TclIsVarUntraced(varPtr)) { - ActiveVarTrace *activePtr; - - varPtr->flags &= ~VAR_TRACE_ACTIVE; - TclCallVarTraces(iPtr, NULL, varPtr, varPtr->name, NULL, - TCL_TRACE_UNSETS, /* leaveErrMsg */ 0); - while (varPtr->tracePtr != NULL) { - VarTrace *tracePtr = varPtr->tracePtr; - varPtr->tracePtr = tracePtr->nextPtr; - Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC); - } - for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; - activePtr = activePtr->nextPtr) { - if (activePtr->varPtr == varPtr) { - activePtr->nextTracePtr = NULL; - } - } - } - - if (TclIsVarScalar(varPtr) - && (varPtr->value.objPtr != NULL)) { - /* - * Decrement the ref count of the var's value - */ - - Tcl_Obj *objPtr = varPtr->value.objPtr; - TclDecrRefCount(objPtr); - varPtr->value.objPtr = NULL; - } else if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) { - /* - * If the variable is an array, delete all of its elements. This must - * be done after calling the traces on the array, above (that's the - * way traces are defined). If the array is traced, its name is - * already in part1. If not, and the name is required for some - * element, it will be computed at DeleteArray. - */ - - DeleteArray(iPtr, varPtr->name, varPtr, TCL_TRACE_UNSETS); - } else if (TclIsVarLink(varPtr)) { - /* - * For global/upvar variables referenced in procedures, decrement the - * reference count on the variable referred to, and free the - * referenced variable if it's no longer needed. - */ - Var *linkPtr = varPtr->value.linkPtr; - linkPtr->refCount--; - if ((linkPtr->refCount == 0) && TclIsVarUndefined(linkPtr) - && (linkPtr->tracePtr == NULL) - && (linkPtr->flags & VAR_IN_HASHTABLE)) { - if (linkPtr->hPtr != NULL) { - Tcl_DeleteHashEntry(linkPtr->hPtr); - } - ckfree((char *) linkPtr); - } - } - - TclSetVarUndefined(varPtr); - TclSetVarScalar(varPtr); - varPtr->tracePtr = NULL; - varPtr->searchPtr = NULL; - - varPtr++; -#endif + namePtrPtr = &localName(framePtr, 0); + for (i=0 ; ivalue.tablePtr, &search); - hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - elPtr = (Var *) Tcl_GetHashValue(hPtr); + if (varPtr->flags & VAR_SEARCH_ACTIVE) { + DeleteSearches(iPtr, varPtr); + } + for (elPtr = VarHashFirstVar(varPtr->value.tablePtr, &search); + elPtr != NULL; elPtr = VarHashNextVar(&search)) { if (TclIsVarScalar(elPtr) && (elPtr->value.objPtr != NULL)) { objPtr = elPtr->value.objPtr; TclDecrRefCount(objPtr); elPtr->value.objPtr = NULL; } - elPtr->hPtr = NULL; - if (elPtr->tracePtr != NULL) { + + /* + * Lie about the validity of the hashtable entry. In this way the + * variables will be deleted by VarHashDeleteTable. + */ + + VarHashInvalidateEntry(elPtr); + if (TclIsVarTraced(elPtr)) { /* - * Compute the array name if it was not supplied + * Compute the array name if it was not supplied. */ - if (arrayName == NULL) { - Tcl_Interp *interp = varPtr->nsPtr->interp; - TclNewObj(arrayNamePtr); - Tcl_IncrRefCount(arrayNamePtr); - Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, arrayNamePtr); - arrayName = TclGetString(arrayNamePtr); + if (elPtr->flags & VAR_TRACED_UNSET) { + Tcl_Obj *elNamePtr = VarHashGetKey(elPtr); + + elPtr->flags &= ~VAR_TRACE_ACTIVE; + TclObjCallVarTraces(iPtr, NULL, elPtr, arrayNamePtr, + elNamePtr, flags,/* leaveErrMsg */ 0, -1); } - - elPtr->flags &= ~VAR_TRACE_ACTIVE; - TclCallVarTraces(iPtr, NULL, elPtr, arrayName, - Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), flags, - /* leaveErrMsg */ 0); - while (elPtr->tracePtr != NULL) { - VarTrace *tracePtr = elPtr->tracePtr; - - elPtr->tracePtr = tracePtr->nextPtr; - Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC); + tPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) elPtr); + tracePtr = (VarTrace *) Tcl_GetHashValue(tPtr); + while (tracePtr) { + VarTrace *prevPtr = tracePtr; + + tracePtr = tracePtr->nextPtr; + Tcl_EventuallyFree((ClientData) prevPtr, TCL_DYNAMIC); } + Tcl_DeleteHashEntry(tPtr); + elPtr->flags &= ~VAR_ALL_TRACES; for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; activePtr = activePtr->nextPtr) { if (activePtr->varPtr == elPtr) { @@ -4365,7 +4541,6 @@ DeleteArray( } } TclSetVarUndefined(elPtr); - TclSetVarScalar(elPtr); /* * Even though array elements are not supposed to be namespace @@ -4374,73 +4549,16 @@ DeleteArray( * the corresponding Var struct, and is otherwise harmless. */ - if (TclIsVarNamespaceVar(elPtr)) { - TclClearVarNamespaceVar(elPtr); - elPtr->refCount--; - } - if (elPtr->refCount == 0) { - ckfree((char *) elPtr); /* element Vars are VAR_IN_HASHTABLE */ - } - } - if (arrayNamePtr) { - Tcl_DecrRefCount(arrayNamePtr); + TclClearVarNamespaceVar(elPtr); } - Tcl_DeleteHashTable(varPtr->value.tablePtr); + VarHashDeleteTable(varPtr->value.tablePtr); ckfree((char *) varPtr->value.tablePtr); } /* *---------------------------------------------------------------------- * - * TclCleanupVar -- - * - * This function is called when it looks like it may be OK to free up a - * variable's storage. If the variable is in a hashtable, its Var - * structure and hash table entry will be freed along with those of its - * containing array, if any. This function is called, for example, when - * a trace on a variable deletes a variable. - * - * Results: - * None. - * - * Side effects: - * If the variable (or its containing array) really is dead and in a - * hashtable, then its Var structure, and possibly its hash table entry, - * is freed up. - * - *---------------------------------------------------------------------- - */ - -void -TclCleanupVar( - Var *varPtr, /* Pointer to variable that may be a candidate - * for being expunged. */ - Var *arrayPtr) /* Array that contains the variable, or NULL - * if this variable isn't an array element. */ -{ - if (TclIsVarUndefined(varPtr) && (varPtr->refCount == 0) - && (varPtr->tracePtr == NULL) - && (varPtr->flags & VAR_IN_HASHTABLE)) { - if (varPtr->hPtr != NULL) { - Tcl_DeleteHashEntry(varPtr->hPtr); - } - ckfree((char *) varPtr); - } - if (arrayPtr != NULL) { - if (TclIsVarUndefined(arrayPtr) && (arrayPtr->refCount == 0) - && (arrayPtr->tracePtr == NULL) - && (arrayPtr->flags & VAR_IN_HASHTABLE)) { - if (arrayPtr->hPtr != NULL) { - Tcl_DeleteHashEntry(arrayPtr->hPtr); - } - ckfree((char *) arrayPtr); - } - } -} -/* - *---------------------------------------------------------------------- - * - * TclVarErrMsg -- + * TclTclObjVarErrMsg -- * * Generate a reasonable error message describing why a variable * operation failed. @@ -4465,10 +4583,43 @@ TclVarErrMsg( * e.g. "read", "set", or "unset". */ const char *reason) /* String describing why operation failed. */ { + Tcl_Obj *part1Ptr = NULL, *part2Ptr = NULL; + + part1Ptr = Tcl_NewStringObj(part1, -1); + Tcl_IncrRefCount(part1Ptr); + if (part2) { + part2Ptr = Tcl_NewStringObj(part2, -1); + Tcl_IncrRefCount(part2Ptr); + } else { + part2 = NULL; + } + + TclObjVarErrMsg(interp, part1Ptr, part2Ptr, operation, reason, -1); + + Tcl_DecrRefCount(part1Ptr); + if (part2Ptr) { + Tcl_DecrRefCount(part2Ptr); + } +} + +void +TclObjVarErrMsg( + Tcl_Interp *interp, /* Interpreter in which to record message. */ + Tcl_Obj *part1Ptr, /* (may be NULL, if index >= 0) */ + Tcl_Obj *part2Ptr, /* Variable's two-part name. */ + const char *operation, /* String describing operation that failed, + * e.g. "read", "set", or "unset". */ + const char *reason, /* String describing why operation failed. */ + int index) +{ Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "can't ", operation, " \"", part1, NULL); - if (part2 != NULL) { - Tcl_AppendResult(interp, "(", part2, ")", NULL); + if (!part1Ptr) { + part1Ptr = localName(((Interp*)interp)->varFramePtr, index); + } + Tcl_AppendResult(interp, "can't ", operation, " \"", + TclGetString(part1Ptr), NULL); + if (part2Ptr) { + Tcl_AppendResult(interp, "(", TclGetString(part2Ptr), ")", NULL); } Tcl_AppendResult(interp, "\": ", reason, NULL); } @@ -4507,15 +4658,35 @@ PanicOnSetVarName( * localVarName - * * INTERNALREP DEFINITION: - * longValue = index into locals table + * ptrAndLongRep.ptr: pointer to name obj in varFramePtr->localCache + * or NULL if it is this same obj + * ptrAndLongRep.value: index into locals table */ static void +FreeLocalVarName( + Tcl_Obj *objPtr) +{ + Tcl_Obj *namePtr = (Tcl_Obj *) objPtr->internalRep.ptrAndLongRep.ptr; + if (namePtr) { + Tcl_DecrRefCount(namePtr); + } +} + +static void DupLocalVarName( Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) { - dupPtr->internalRep.longValue = srcPtr->internalRep.longValue; + Tcl_Obj *namePtr = srcPtr->internalRep.ptrAndLongRep.ptr; + + if (!namePtr) { + namePtr = srcPtr; + } + dupPtr->internalRep.ptrAndLongRep.ptr = namePtr; + Tcl_IncrRefCount(namePtr); + + dupPtr->internalRep.ptrAndLongRep.value = srcPtr->internalRep.ptrAndLongRep.value; dupPtr->typePtr = &localVarNameType; } @@ -4534,9 +4705,11 @@ FreeNsVarName( { register Var *varPtr = objPtr->internalRep.twoPtrValue.ptr2; - varPtr->refCount--; - if (TclIsVarUndefined(varPtr) && (varPtr->refCount == 0)) { - TclCleanupVar(varPtr, NULL); + if (TclIsVarInHash(varPtr)) { + varPtr->refCount--; + if (TclIsVarUndefined(varPtr) && (varPtr->refCount == 0)) { + CleanupVar(varPtr, NULL); + } } } @@ -4550,7 +4723,9 @@ DupNsVarName( dupPtr->internalRep.twoPtrValue.ptr1 = nsPtr; dupPtr->internalRep.twoPtrValue.ptr2 = varPtr; - varPtr->refCount++; + if (TclIsVarInHash(varPtr)) { + varPtr->refCount++; + } dupPtr->typePtr = &tclNsVarNameType; } #endif @@ -4636,6 +4811,705 @@ UpdateParsedVarName( } /* + *---------------------------------------------------------------------- + * + * Tcl_FindNamespaceVar -- MOVED OVER from tclNamesp.c + * + * Searches for a namespace variable, a variable not local to a + * procedure. The variable can be either a scalar or an array, but may + * not be an element of an array. + * + * Results: + * Returns a token for the variable if it is found. Otherwise, if it + * can't be found or there is an error, returns NULL and leaves an error + * message in the interpreter's result object if "flags" contains + * TCL_LEAVE_ERR_MSG. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_Var +Tcl_FindNamespaceVar( + Tcl_Interp *interp, /* The interpreter in which to find the + * variable. */ + const char *name, /* Variable's name. If it starts with "::", + * will be looked up in global namespace. + * Else, looked up first in contextNsPtr + * (current namespace if contextNsPtr is + * NULL), then in global namespace. */ + Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag set. + * Otherwise, points to namespace in which to + * resolve name. If NULL, look up name in the + * current namespace. */ + int flags) /* An OR'd combination of flags: + * TCL_GLOBAL_ONLY (look up name only in + * global namespace), TCL_NAMESPACE_ONLY (look + * up only in contextNsPtr, or the current + * namespace if contextNsPtr is NULL), and + * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY + * and TCL_NAMESPACE_ONLY are given, + * TCL_GLOBAL_ONLY is ignored. */ +{ + Interp *iPtr = (Interp *) interp; + ResolverScheme *resPtr; + Namespace *nsPtr[2], *cxtNsPtr; + const char *simpleName; + Var *varPtr; + register int search; + int result; + Tcl_Var var; + Tcl_Obj *simpleNamePtr; + + /* + * If this namespace has a variable resolver, then give it first crack at + * the variable resolution. It may return a Tcl_Var value, it may signal + * to continue onward, or it may signal an error. + */ + + if ((flags & TCL_GLOBAL_ONLY) != 0) { + cxtNsPtr = (Namespace *) TclGetGlobalNamespace(interp); + } else if (contextNsPtr != NULL) { + cxtNsPtr = (Namespace *) contextNsPtr; + } else { + cxtNsPtr = (Namespace *) TclGetCurrentNamespace(interp); + } + + if (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) { + resPtr = iPtr->resolverPtr; + + if (cxtNsPtr->varResProc) { + result = (*cxtNsPtr->varResProc)(interp, name, + (Tcl_Namespace *) cxtNsPtr, flags, &var); + } else { + result = TCL_CONTINUE; + } + + while (result == TCL_CONTINUE && resPtr) { + if (resPtr->varResProc) { + result = (*resPtr->varResProc)(interp, name, + (Tcl_Namespace *) cxtNsPtr, flags, &var); + } + resPtr = resPtr->nextPtr; + } + + if (result == TCL_OK) { + return var; + } else if (result != TCL_CONTINUE) { + return (Tcl_Var) NULL; + } + } + + /* + * Find the namespace(s) that contain the variable. + */ + + TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr, + flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName); + + /* + * Look for the variable in the variable table of its namespace. Be sure + * to check both possible search paths: from the specified namespace + * context and from the global namespace. + */ + + varPtr = NULL; + simpleNamePtr = Tcl_NewStringObj(simpleName, -1); + Tcl_IncrRefCount(simpleNamePtr); + for (search = 0; (search < 2) && (varPtr == NULL); search++) { + if ((nsPtr[search] != NULL) && (simpleName != NULL)) { + varPtr = VarHashFindVar(&nsPtr[search]->varTable, simpleNamePtr); + } + } + Tcl_DecrRefCount(simpleNamePtr); + if (varPtr != NULL) { + return (Tcl_Var) varPtr; + } else if (flags & TCL_LEAVE_ERR_MSG) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "unknown variable \"", name, "\"", NULL); + } + return (Tcl_Var) NULL; +} + +/* + *---------------------------------------------------------------------- + * + * InfoVarsCmd -- (moved over from tclCmdIL.c) + * + * Called to implement the "info vars" command that returns the list of + * variables in the interpreter that match an optional pattern. The + * pattern, if any, consists of an optional sequence of namespace names + * separated by "::" qualifiers, which is followed by a glob-style + * pattern that restricts which variables are returned. Handles the + * following syntax: + * + * info vars ?pattern? + * + * Results: + * Returns TCL_OK if successful and TCL_ERROR if there is an error. + * + * Side effects: + * Returns a result in the interpreter's result object. If there is an + * error, the result is an error message. + * + *---------------------------------------------------------------------- + */ + +int +TclInfoVarsCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + Interp *iPtr = (Interp *) interp; + char *varName, *pattern; + const char *simplePattern; + Tcl_HashSearch search; + Var *varPtr; + Namespace *nsPtr; + Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); + Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + Tcl_Obj *listPtr, *elemObjPtr; + int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ + Tcl_Obj *simplePatternPtr = NULL, *varNamePtr; + + /* + * Get the pattern and find the "effective namespace" in which to list + * variables. We only use this effective namespace if there's no active + * Tcl procedure frame. + */ + + if (objc == 1) { + simplePattern = NULL; + nsPtr = currNsPtr; + specificNsInPattern = 0; + } else if (objc == 2) { + /* + * From the pattern, get the effective namespace and the simple + * pattern (no namespace qualifiers or ::'s) at the end. If an error + * was found while parsing the pattern, return it. Otherwise, if the + * namespace wasn't found, just leave nsPtr NULL: we will return an + * empty list since no variables there can be found. + */ + + Namespace *dummy1NsPtr, *dummy2NsPtr; + + pattern = TclGetString(objv[1]); + TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL, + /*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr, + &simplePattern); + + if (nsPtr != NULL) { /* We successfully found the pattern's ns. */ + specificNsInPattern = (strcmp(simplePattern, pattern) != 0); + if (simplePattern == pattern) { + simplePatternPtr = objv[1]; + } else { + simplePatternPtr = Tcl_NewStringObj(simplePattern, -1); + } + Tcl_IncrRefCount(simplePatternPtr); + } + } else { + Tcl_WrongNumArgs(interp, 1, objv, "?pattern?"); + return TCL_ERROR; + } + + /* + * If the namespace specified in the pattern wasn't found, just return. + */ + + if (nsPtr == NULL) { + return TCL_OK; + } + + listPtr = Tcl_NewListObj(0, NULL); + + if (!(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC) + || specificNsInPattern) { + /* + * There is no frame pointer, the frame pointer was pushed only to + * activate a namespace, or we are in a procedure call frame but a + * specific namespace was specified. Create a list containing only the + * variables in the effective namespace's variable table. + */ + + if (simplePattern && TclMatchIsTrivial(simplePattern)) { + /* + * If we can just do hash lookups, that simplifies things a lot. + */ + + varPtr = VarHashFindVar(&nsPtr->varTable, simplePatternPtr); + if (varPtr) { + if (!TclIsVarUndefined(varPtr) + || TclIsVarNamespaceVar(varPtr)) { + if (specificNsInPattern) { + elemObjPtr = Tcl_NewObj(); + Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, + elemObjPtr); + } else { + elemObjPtr = VarHashGetKey(varPtr); + } + Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); + } + } else if ((nsPtr != globalNsPtr) && !specificNsInPattern) { + varPtr = VarHashFindVar(&globalNsPtr->varTable, + simplePatternPtr); + if (varPtr) { + if (!TclIsVarUndefined(varPtr) + || TclIsVarNamespaceVar(varPtr)) { + Tcl_ListObjAppendElement(interp, listPtr, + VarHashGetKey(varPtr)); + } + } + } + } else { + /* + * Have to scan the tables of variables. + */ + + varPtr = VarHashFirstVar(&nsPtr->varTable, &search); + while (varPtr) { + if (!TclIsVarUndefined(varPtr) + || TclIsVarNamespaceVar(varPtr)) { + varNamePtr = VarHashGetKey(varPtr); + varName = TclGetString(varNamePtr); + if ((simplePattern == NULL) + || Tcl_StringMatch(varName, simplePattern)) { + if (specificNsInPattern) { + elemObjPtr = Tcl_NewObj(); + Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, + elemObjPtr); + } else { + elemObjPtr = varNamePtr; + } + Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); + } + } + varPtr = VarHashNextVar(&search); + } + + /* + * If the effective namespace isn't the global :: namespace, and a + * specific namespace wasn't requested in the pattern (i.e., the + * pattern only specifies variable names), then add in all global + * :: variables that match the simple pattern. Of course, add in + * only those variables that aren't hidden by a variable in the + * effective namespace. + */ + + if ((nsPtr != globalNsPtr) && !specificNsInPattern) { + varPtr = VarHashFirstVar(&globalNsPtr->varTable,&search); + while (varPtr) { + if (!TclIsVarUndefined(varPtr) + || TclIsVarNamespaceVar(varPtr)) { + varNamePtr = VarHashGetKey(varPtr); + varName = TclGetString(varNamePtr); + if ((simplePattern == NULL) + || Tcl_StringMatch(varName, simplePattern)) { + if (VarHashFindVar(&nsPtr->varTable, + varNamePtr) == NULL) { + Tcl_ListObjAppendElement(interp, listPtr, + varNamePtr); + } + } + } + varPtr = VarHashNextVar(&search); + } + } + } + } else if (((Interp *)interp)->varFramePtr->procPtr != NULL) { + AppendLocals(interp, listPtr, simplePatternPtr, 1); + } + + if (simplePatternPtr) { + Tcl_DecrRefCount(simplePatternPtr); + } + Tcl_SetObjResult(interp, listPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * InfoGlobalsCmd -- (moved over from tclCmdIL.c) + * + * Called to implement the "info globals" command that returns the list + * of global variables matching an optional pattern. Handles the + * following syntax: + * + * info globals ?pattern? + * + * Results: + * Returns TCL_OK if successful and TCL_ERROR if there is an error. + * + * Side effects: + * Returns a result in the interpreter's result object. If there is an + * error, the result is an error message. + * + *---------------------------------------------------------------------- + */ + +int +TclInfoGlobalsCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + char *varName, *pattern; + Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); + Tcl_HashSearch search; + Var *varPtr; + Tcl_Obj *listPtr, *varNamePtr, *patternPtr; + + if (objc == 1) { + pattern = NULL; + } else if (objc == 2) { + pattern = TclGetString(objv[1]); + + /* + * Strip leading global-namespace qualifiers. [Bug 1057461] + */ + + if (pattern[0] == ':' && pattern[1] == ':') { + while (*pattern == ':') { + pattern++; + } + } + } else { + Tcl_WrongNumArgs(interp, 1, objv, "?pattern?"); + return TCL_ERROR; + } + + /* + * Scan through the global :: namespace's variable table and create a list + * of all global variables that match the pattern. + */ + + listPtr = Tcl_NewListObj(0, NULL); + if (pattern != NULL && TclMatchIsTrivial(pattern)) { + if (pattern == TclGetString(objv[1])) { + patternPtr = objv[1]; + } else { + patternPtr = Tcl_NewStringObj(pattern, -1); + } + Tcl_IncrRefCount(patternPtr); + + varPtr = VarHashFindVar(&globalNsPtr->varTable, patternPtr); + if (varPtr) { + if (!TclIsVarUndefined(varPtr)) { + Tcl_ListObjAppendElement(interp, listPtr, + VarHashGetKey(varPtr)); + } + } + Tcl_DecrRefCount(patternPtr); + } else { + for (varPtr = VarHashFirstVar(&globalNsPtr->varTable, &search); + varPtr != NULL; + varPtr = VarHashNextVar(&search)) { + if (TclIsVarUndefined(varPtr)) { + continue; + } + varNamePtr = VarHashGetKey(varPtr); + varName = TclGetString(varNamePtr); + if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) { + Tcl_ListObjAppendElement(interp, listPtr, varNamePtr); + } + } + } + Tcl_SetObjResult(interp, listPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclInfoLocalsCmd -- (moved over from tclCmdIl.c) + * + * Called to implement the "info locals" command to return a list of + * local variables that match an optional pattern. Handles the following + * syntax: + * + * info locals ?pattern? + * + * Results: + * Returns TCL_OK if successful and TCL_ERROR if there is an error. + * + * Side effects: + * Returns a result in the interpreter's result object. If there is an + * error, the result is an error message. + * + *---------------------------------------------------------------------- + */ + +int +TclInfoLocalsCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + Interp *iPtr = (Interp *) interp; + Tcl_Obj *patternPtr; + Tcl_Obj *listPtr; + + if (objc == 1) { + patternPtr = NULL; + } else if (objc == 2) { + patternPtr = objv[1]; + } else { + Tcl_WrongNumArgs(interp, 1, objv, "?pattern?"); + return TCL_ERROR; + } + + if (!(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC )) { + return TCL_OK; + } + + /* + * Return a list containing names of first the compiled locals (i.e. the + * ones stored in the call frame), then the variables in the local hash + * table (if one exists). + */ + + listPtr = Tcl_NewListObj(0, NULL); + AppendLocals(interp, listPtr, patternPtr, 0); + Tcl_SetObjResult(interp, listPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * AppendLocals -- + * + * Append the local variables for the current frame to the specified list + * object. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +AppendLocals( + Tcl_Interp *interp, /* Current interpreter. */ + Tcl_Obj *listPtr, /* List object to append names to. */ + Tcl_Obj *patternPtr, /* Pattern to match against. */ + int includeLinks) /* 1 if upvars should be included, else 0. */ +{ + Interp *iPtr = (Interp *) interp; + Var *varPtr; + int i, localVarCt; + Tcl_Obj **varNamePtr; + char *varName; + TclVarHashTable *localVarTablePtr; + Tcl_HashSearch search; + const char *pattern = patternPtr? TclGetString(patternPtr) : NULL; + Tcl_Obj *objNamePtr; + + localVarCt = iPtr->varFramePtr->numCompiledLocals; + varPtr = iPtr->varFramePtr->compiledLocals; + localVarTablePtr = iPtr->varFramePtr->varTablePtr; + varNamePtr = &iPtr->varFramePtr->localCachePtr->varName0; + + for (i = 0; i < localVarCt; i++, varNamePtr++) { + /* + * Skip nameless (temporary) variables and undefined variables. + */ + + if (*varNamePtr && !TclIsVarUndefined(varPtr) + && (includeLinks || !TclIsVarLink(varPtr))) { + varName = TclGetString(*varNamePtr); + if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) { + Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr); + } + } + varPtr++; + } + + /* + * Do nothing if no local variables. + */ + + if (localVarTablePtr == NULL) { + return; + } + + /* + * Check for the simple and fast case. + */ + + if ((pattern != NULL) && TclMatchIsTrivial(pattern)) { + varPtr = VarHashFindVar(localVarTablePtr, patternPtr); + if (varPtr != NULL) { + if (!TclIsVarUndefined(varPtr) + && (includeLinks || !TclIsVarLink(varPtr))) { + Tcl_ListObjAppendElement(interp, listPtr, + VarHashGetKey(varPtr)); + } + } + return; + } + + /* + * Scan over and process all local variables. + */ + + for (varPtr = VarHashFirstVar(localVarTablePtr, &search); + varPtr != NULL; + varPtr = VarHashNextVar(&search)) { + if (!TclIsVarUndefined(varPtr) + && (includeLinks || !TclIsVarLink(varPtr))) { + objNamePtr = VarHashGetKey(varPtr); + varName = TclGetString(objNamePtr); + if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) { + Tcl_ListObjAppendElement(interp, listPtr, objNamePtr); + } + } + } +} + +/* + * Hash table implementation - first, just copy and adapt the obj key stuff + */ + +void +TclInitVarHashTable( + TclVarHashTable *tablePtr, + Namespace *nsPtr) +{ + Tcl_InitCustomHashTable(&tablePtr->table, + TCL_CUSTOM_TYPE_KEYS, &tclVarHashKeyType); + tablePtr->nsPtr = nsPtr; +} + +static Tcl_HashEntry * +AllocVarEntry( + Tcl_HashTable *tablePtr, /* Hash table. */ + void *keyPtr) /* Key to store in the hash table entry. */ +{ + Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr; + Tcl_HashEntry *hPtr; + Var *varPtr; + + varPtr = (Var *) ckalloc(sizeof(VarInHash)); + varPtr->flags = VAR_IN_HASHTABLE; + varPtr->value.objPtr = NULL; + VarHashRefCount(varPtr) = 1; + + hPtr = &(((VarInHash *)varPtr)->entry); + Tcl_SetHashValue(hPtr, varPtr); + hPtr->key.objPtr = objPtr; + Tcl_IncrRefCount(objPtr); + + return hPtr; +} + +static void +FreeVarEntry( + Tcl_HashEntry *hPtr) +{ + Var *varPtr = VarHashGetValue(hPtr); + Tcl_Obj *objPtr = hPtr->key.objPtr; + + if (TclIsVarUndefined(varPtr) && !TclIsVarTraced(varPtr) + && (VarHashRefCount(varPtr) == 1)) { + ckfree((char *) varPtr); + } else { + VarHashInvalidateEntry(varPtr); + TclSetVarUndefined(varPtr); + VarHashRefCount(varPtr)--; + } + Tcl_DecrRefCount(objPtr); +} + +static int +CompareVarKeys( + void *keyPtr, /* New key to compare. */ + Tcl_HashEntry *hPtr) /* Existing key to compare. */ +{ + Tcl_Obj *objPtr1 = (Tcl_Obj *) keyPtr; + Tcl_Obj *objPtr2 = hPtr->key.objPtr; + register const char *p1, *p2; + register int l1, l2; + + /* + * If the object pointers are the same then they match. + */ + + if (objPtr1 == objPtr2) { + return 1; + } + + /* + * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being + * in a register. + */ + + p1 = TclGetString(objPtr1); + l1 = objPtr1->length; + p2 = TclGetString(objPtr2); + l2 = objPtr2->length; + + /* + * Only compare if the string representations are of the same length. + */ + + if (l1 == l2) { + for (;; p1++, p2++, l1--) { + if (*p1 != *p2) { + break; + } + if (l1 == 0) { + return 1; + } + } + } + + return 0; +} + +static unsigned int +HashVarKey( + Tcl_HashTable *tablePtr, /* Hash table. */ + void *keyPtr) /* Key from which to compute hash value. */ +{ + Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr; + const char *string = TclGetString(objPtr); + int length = objPtr->length; + unsigned int result = 0; + int i; + + /* + * I tried a zillion different hash functions and asked many other people + * for advice. Many people had their own favorite functions, all + * different, but no-one had much idea why they were good ones. I chose + * the one below (multiply by 9 and add new character) because of the + * following reasons: + * + * 1. Multiplying by 10 is perfect for keys that are decimal strings, and + * multiplying by 9 is just about as good. + * 2. Times-9 is (shift-left-3) plus (old). This means that each + * character's bits hang around in the low-order bits of the hash value + * for ever, plus they spread fairly rapidly up to the high-order bits + * to fill out the hash value. This seems works well both for decimal + * and *non-decimal strings. + */ + + for (i=0 ; i= 0} { if {([string index $line 0] eq "#") \ || ([llength $line] != 2)} { diff --git a/library/platform/pkgIndex.tcl b/library/platform/pkgIndex.tcl index d141612..68924cb 100644 --- a/library/platform/pkgIndex.tcl +++ b/library/platform/pkgIndex.tcl @@ -1,3 +1,3 @@ -package ifneeded platform 1.0.2 [list source [file join $dir platform.tcl]] +package ifneeded platform 1.0.3 [list source [file join $dir platform.tcl]] package ifneeded platform::shell 1.1.3 [list source [file join $dir shell.tcl]] diff --git a/library/platform/platform.tcl b/library/platform/platform.tcl index 27b565a..143cdc5 100644 --- a/library/platform/platform.tcl +++ b/library/platform/platform.tcl @@ -220,20 +220,22 @@ proc ::platform::patterns {id} { switch -glob -- $id { solaris*-* { - if {![regexp {solaris([^-]*)-(.*)} $id -> v cpu]} {return $id} - if {$v eq ""} {return $id} - foreach {major minor} [split $v .] break - incr minor -1 - for {set j $minor} {$j >= 6} {incr j -1} { - lappend res solaris${major}.${j}-${cpu} + if {[regexp {solaris([^-]*)-(.*)} $id -> v cpu]} { + if {$v eq ""} {return $id} + foreach {major minor} [split $v .] break + incr minor -1 + for {set j $minor} {$j >= 6} {incr j -1} { + lappend res solaris${major}.${j}-${cpu} + } } } linux*-* { - if {![regexp {linux-glibc([^-]*)-(.*)} $id -> v cpu]} {return $id} - foreach {major minor} [split $v .] break - incr minor -1 - for {set j $minor} {$j >= 0} {incr j -1} { - lappend res linux-glibc${major}.${j}-${cpu} + if {[regexp {linux-glibc([^-]*)-(.*)} $id -> v cpu]} { + foreach {major minor} [split $v .] break + incr minor -1 + for {set j $minor} {$j >= 0} {incr j -1} { + lappend res linux-glibc${major}.${j}-${cpu} + } } } macosx-powerpc - @@ -249,7 +251,7 @@ proc ::platform::patterns {id} { # ### ### ### ######### ######### ######### ## Ready -package provide platform 1.0.2 +package provide platform 1.0.3 # ### ### ### ######### ######### ######### ## Demo application diff --git a/library/tzdata/Africa/Cairo b/library/tzdata/Africa/Cairo index 13cc929..0ae874f 100644 --- a/library/tzdata/Africa/Cairo +++ b/library/tzdata/Africa/Cairo @@ -116,189 +116,189 @@ set TZData(:Africa/Cairo) { {1146175200 10800 1 EEST} {1158872400 7200 0 EET} {1177624800 10800 1 EEST} - {1190926800 7200 0 EET} + {1189112400 7200 0 EET} {1209074400 10800 1 EEST} - {1222376400 7200 0 EET} + {1220562000 7200 0 EET} {1240524000 10800 1 EEST} - {1253826000 7200 0 EET} + {1252011600 7200 0 EET} {1272578400 10800 1 EEST} - {1285880400 7200 0 EET} + {1283461200 7200 0 EET} {1304028000 10800 1 EEST} - {1317330000 7200 0 EET} + {1314910800 7200 0 EET} {1335477600 10800 1 EEST} - {1348779600 7200 0 EET} + {1346965200 7200 0 EET} {1366927200 10800 1 EEST} - {1380229200 7200 0 EET} + {1378414800 7200 0 EET} {1398376800 10800 1 EEST} - {1411678800 7200 0 EET} + {1409864400 7200 0 EET} {1429826400 10800 1 EEST} - {1443128400 7200 0 EET} + {1441314000 7200 0 EET} {1461880800 10800 1 EEST} - {1475182800 7200 0 EET} + {1472763600 7200 0 EET} {1493330400 10800 1 EEST} - {1506632400 7200 0 EET} + {1504818000 7200 0 EET} {1524780000 10800 1 EEST} - {1538082000 7200 0 EET} + {1536267600 7200 0 EET} {1556229600 10800 1 EEST} - {1569531600 7200 0 EET} + {1567717200 7200 0 EET} {1587679200 10800 1 EEST} - {1600981200 7200 0 EET} + {1599166800 7200 0 EET} {1619733600 10800 1 EEST} - {1633035600 7200 0 EET} + {1630616400 7200 0 EET} {1651183200 10800 1 EEST} - {1664485200 7200 0 EET} + {1662066000 7200 0 EET} {1682632800 10800 1 EEST} - {1695934800 7200 0 EET} + {1694120400 7200 0 EET} {1714082400 10800 1 EEST} - {1727384400 7200 0 EET} + {1725570000 7200 0 EET} {1745532000 10800 1 EEST} - {1758834000 7200 0 EET} + {1757019600 7200 0 EET} {1776981600 10800 1 EEST} - {1790283600 7200 0 EET} + {1788469200 7200 0 EET} {1809036000 10800 1 EEST} - {1822338000 7200 0 EET} + {1819918800 7200 0 EET} {1840485600 10800 1 EEST} - {1853787600 7200 0 EET} + {1851973200 7200 0 EET} {1871935200 10800 1 EEST} - {1885237200 7200 0 EET} + {1883422800 7200 0 EET} {1903384800 10800 1 EEST} - {1916686800 7200 0 EET} + {1914872400 7200 0 EET} {1934834400 10800 1 EEST} - {1948136400 7200 0 EET} + {1946322000 7200 0 EET} {1966888800 10800 1 EEST} - {1980190800 7200 0 EET} + {1977771600 7200 0 EET} {1998338400 10800 1 EEST} - {2011640400 7200 0 EET} + {2009221200 7200 0 EET} {2029788000 10800 1 EEST} - {2043090000 7200 0 EET} + {2041275600 7200 0 EET} {2061237600 10800 1 EEST} - {2074539600 7200 0 EET} + {2072725200 7200 0 EET} {2092687200 10800 1 EEST} - {2105989200 7200 0 EET} + {2104174800 7200 0 EET} {2124136800 10800 1 EEST} - {2137438800 7200 0 EET} + {2135624400 7200 0 EET} {2156191200 10800 1 EEST} - {2169493200 7200 0 EET} + {2167074000 7200 0 EET} {2187640800 10800 1 EEST} - {2200942800 7200 0 EET} + {2198523600 7200 0 EET} {2219090400 10800 1 EEST} - {2232392400 7200 0 EET} + {2230578000 7200 0 EET} {2250540000 10800 1 EEST} - {2263842000 7200 0 EET} + {2262027600 7200 0 EET} {2281989600 10800 1 EEST} - {2295291600 7200 0 EET} + {2293477200 7200 0 EET} {2313439200 10800 1 EEST} - {2326741200 7200 0 EET} + {2324926800 7200 0 EET} {2345493600 10800 1 EEST} - {2358795600 7200 0 EET} + {2356376400 7200 0 EET} {2376943200 10800 1 EEST} - {2390245200 7200 0 EET} + {2388430800 7200 0 EET} {2408392800 10800 1 EEST} - {2421694800 7200 0 EET} + {2419880400 7200 0 EET} {2439842400 10800 1 EEST} - {2453144400 7200 0 EET} + {2451330000 7200 0 EET} {2471292000 10800 1 EEST} - {2484594000 7200 0 EET} + {2482779600 7200 0 EET} {2503346400 10800 1 EEST} - {2516648400 7200 0 EET} + {2514229200 7200 0 EET} {2534796000 10800 1 EEST} - {2548098000 7200 0 EET} + {2545678800 7200 0 EET} {2566245600 10800 1 EEST} - {2579547600 7200 0 EET} + {2577733200 7200 0 EET} {2597695200 10800 1 EEST} - {2610997200 7200 0 EET} + {2609182800 7200 0 EET} {2629144800 10800 1 EEST} - {2642446800 7200 0 EET} + {2640632400 7200 0 EET} {2660594400 10800 1 EEST} - {2673896400 7200 0 EET} + {2672082000 7200 0 EET} {2692648800 10800 1 EEST} - {2705950800 7200 0 EET} + {2703531600 7200 0 EET} {2724098400 10800 1 EEST} - {2737400400 7200 0 EET} + {2735586000 7200 0 EET} {2755548000 10800 1 EEST} - {2768850000 7200 0 EET} + {2767035600 7200 0 EET} {2786997600 10800 1 EEST} - {2800299600 7200 0 EET} + {2798485200 7200 0 EET} {2818447200 10800 1 EEST} - {2831749200 7200 0 EET} + {2829934800 7200 0 EET} {2850501600 10800 1 EEST} - {2863803600 7200 0 EET} + {2861384400 7200 0 EET} {2881951200 10800 1 EEST} - {2895253200 7200 0 EET} + {2892834000 7200 0 EET} {2913400800 10800 1 EEST} - {2926702800 7200 0 EET} + {2924888400 7200 0 EET} {2944850400 10800 1 EEST} - {2958152400 7200 0 EET} + {2956338000 7200 0 EET} {2976300000 10800 1 EEST} - {2989602000 7200 0 EET} + {2987787600 7200 0 EET} {3007749600 10800 1 EEST} - {3021051600 7200 0 EET} + {3019237200 7200 0 EET} {3039804000 10800 1 EEST} - {3053106000 7200 0 EET} + {3050686800 7200 0 EET} {3071253600 10800 1 EEST} - {3084555600 7200 0 EET} + {3082136400 7200 0 EET} {3102703200 10800 1 EEST} - {3116005200 7200 0 EET} + {3114190800 7200 0 EET} {3134152800 10800 1 EEST} - {3147454800 7200 0 EET} + {3145640400 7200 0 EET} {3165602400 10800 1 EEST} - {3178904400 7200 0 EET} + {3177090000 7200 0 EET} {3197052000 10800 1 EEST} - {3210354000 7200 0 EET} + {3208539600 7200 0 EET} {3229106400 10800 1 EEST} - {3242408400 7200 0 EET} + {3239989200 7200 0 EET} {3260556000 10800 1 EEST} - {3273858000 7200 0 EET} + {3272043600 7200 0 EET} {3292005600 10800 1 EEST} - {3305307600 7200 0 EET} + {3303493200 7200 0 EET} {3323455200 10800 1 EEST} - {3336757200 7200 0 EET} + {3334942800 7200 0 EET} {3354904800 10800 1 EEST} - {3368206800 7200 0 EET} + {3366392400 7200 0 EET} {3386959200 10800 1 EEST} - {3400261200 7200 0 EET} + {3397842000 7200 0 EET} {3418408800 10800 1 EEST} - {3431710800 7200 0 EET} + {3429291600 7200 0 EET} {3449858400 10800 1 EEST} - {3463160400 7200 0 EET} + {3461346000 7200 0 EET} {3481308000 10800 1 EEST} - {3494610000 7200 0 EET} + {3492795600 7200 0 EET} {3512757600 10800 1 EEST} - {3526059600 7200 0 EET} + {3524245200 7200 0 EET} {3544207200 10800 1 EEST} - {3557509200 7200 0 EET} + {3555694800 7200 0 EET} {3576261600 10800 1 EEST} - {3589563600 7200 0 EET} + {3587144400 7200 0 EET} {3607711200 10800 1 EEST} - {3621013200 7200 0 EET} + {3619198800 7200 0 EET} {3639160800 10800 1 EEST} - {3652462800 7200 0 EET} + {3650648400 7200 0 EET} {3670610400 10800 1 EEST} - {3683912400 7200 0 EET} + {3682098000 7200 0 EET} {3702060000 10800 1 EEST} - {3715362000 7200 0 EET} + {3713547600 7200 0 EET} {3734114400 10800 1 EEST} - {3747416400 7200 0 EET} + {3744997200 7200 0 EET} {3765564000 10800 1 EEST} - {3778866000 7200 0 EET} + {3776446800 7200 0 EET} {3797013600 10800 1 EEST} - {3810315600 7200 0 EET} + {3808501200 7200 0 EET} {3828463200 10800 1 EEST} - {3841765200 7200 0 EET} + {3839950800 7200 0 EET} {3859912800 10800 1 EEST} - {3873214800 7200 0 EET} + {3871400400 7200 0 EET} {3891362400 10800 1 EEST} - {3904664400 7200 0 EET} + {3902850000 7200 0 EET} {3923416800 10800 1 EEST} - {3936718800 7200 0 EET} + {3934299600 7200 0 EET} {3954866400 10800 1 EEST} - {3968168400 7200 0 EET} + {3965749200 7200 0 EET} {3986316000 10800 1 EEST} - {3999618000 7200 0 EET} + {3997803600 7200 0 EET} {4017765600 10800 1 EEST} - {4031067600 7200 0 EET} + {4029253200 7200 0 EET} {4049215200 10800 1 EEST} - {4062517200 7200 0 EET} + {4060702800 7200 0 EET} {4080664800 10800 1 EEST} - {4093966800 7200 0 EET} + {4092152400 7200 0 EET} } diff --git a/library/tzdata/America/Grand_Turk b/library/tzdata/America/Grand_Turk index 197ef99..a455dd5 100644 --- a/library/tzdata/America/Grand_Turk +++ b/library/tzdata/America/Grand_Turk @@ -4,246 +4,246 @@ set TZData(:America/Grand_Turk) { {-9223372036854775808 -17072 0 LMT} {-2524504528 -18432 0 KMT} {-1827687168 -18000 0 EST} - {294210000 -14400 1 EDT} - {309931200 -18000 0 EST} - {325659600 -14400 1 EDT} - {341380800 -18000 0 EST} - {357109200 -14400 1 EDT} - {372830400 -18000 0 EST} - {388558800 -14400 1 EDT} - {404884800 -18000 0 EST} - {420008400 -14400 1 EDT} - {436334400 -18000 0 EST} - {452062800 -14400 1 EDT} - {467784000 -18000 0 EST} - {483512400 -14400 1 EDT} - {499233600 -18000 0 EST} - {514962000 -14400 1 EDT} - {530683200 -18000 0 EST} - {544597200 -14400 1 EDT} - {562132800 -18000 0 EST} - {576046800 -14400 1 EDT} - {594187200 -18000 0 EST} - {607496400 -14400 1 EDT} - {625636800 -18000 0 EST} - {638946000 -14400 1 EDT} - {657086400 -18000 0 EST} - {671000400 -14400 1 EDT} - {688536000 -18000 0 EST} - {702450000 -14400 1 EDT} - {719985600 -18000 0 EST} - {733899600 -14400 1 EDT} - {752040000 -18000 0 EST} - {765349200 -14400 1 EDT} - {783489600 -18000 0 EST} - {796798800 -14400 1 EDT} - {814939200 -18000 0 EST} - {828853200 -14400 1 EDT} - {846388800 -18000 0 EST} - {860302800 -14400 1 EDT} - {877838400 -18000 0 EST} - {891752400 -14400 1 EDT} - {909288000 -18000 0 EST} - {923202000 -14400 1 EDT} - {941342400 -18000 0 EST} - {954651600 -14400 1 EDT} - {972792000 -18000 0 EST} - {986101200 -14400 1 EDT} - {1004241600 -18000 0 EST} - {1018155600 -14400 1 EDT} - {1035691200 -18000 0 EST} - {1049605200 -14400 1 EDT} - {1067140800 -18000 0 EST} - {1081054800 -14400 1 EDT} - {1099195200 -18000 0 EST} - {1112504400 -14400 1 EDT} - {1130644800 -18000 0 EST} - {1143954000 -14400 1 EDT} - {1162094400 -18000 0 EST} - {1175403600 -14400 1 EDT} - {1193544000 -18000 0 EST} - {1207458000 -14400 1 EDT} - {1224993600 -18000 0 EST} - {1238907600 -14400 1 EDT} - {1256443200 -18000 0 EST} - {1270357200 -14400 1 EDT} - {1288497600 -18000 0 EST} - {1301806800 -14400 1 EDT} - {1319947200 -18000 0 EST} - {1333256400 -14400 1 EDT} - {1351396800 -18000 0 EST} - {1365310800 -14400 1 EDT} - {1382846400 -18000 0 EST} - {1396760400 -14400 1 EDT} - {1414296000 -18000 0 EST} - {1428210000 -14400 1 EDT} - {1445745600 -18000 0 EST} - {1459659600 -14400 1 EDT} - {1477800000 -18000 0 EST} - {1491109200 -14400 1 EDT} - {1509249600 -18000 0 EST} - {1522558800 -14400 1 EDT} - {1540699200 -18000 0 EST} - {1554613200 -14400 1 EDT} - {1572148800 -18000 0 EST} - {1586062800 -14400 1 EDT} - {1603598400 -18000 0 EST} - {1617512400 -14400 1 EDT} - {1635652800 -18000 0 EST} - {1648962000 -14400 1 EDT} - {1667102400 -18000 0 EST} - {1680411600 -14400 1 EDT} - {1698552000 -18000 0 EST} - {1712466000 -14400 1 EDT} - {1730001600 -18000 0 EST} - {1743915600 -14400 1 EDT} - {1761451200 -18000 0 EST} - {1775365200 -14400 1 EDT} - {1792900800 -18000 0 EST} - {1806814800 -14400 1 EDT} - {1824955200 -18000 0 EST} - {1838264400 -14400 1 EDT} - {1856404800 -18000 0 EST} - {1869714000 -14400 1 EDT} - {1887854400 -18000 0 EST} - {1901768400 -14400 1 EDT} - {1919304000 -18000 0 EST} - {1933218000 -14400 1 EDT} - {1950753600 -18000 0 EST} - {1964667600 -14400 1 EDT} - {1982808000 -18000 0 EST} - {1996117200 -14400 1 EDT} - {2014257600 -18000 0 EST} - {2027566800 -14400 1 EDT} - {2045707200 -18000 0 EST} - {2059016400 -14400 1 EDT} - {2077156800 -18000 0 EST} - {2091070800 -14400 1 EDT} - {2108606400 -18000 0 EST} - {2122520400 -14400 1 EDT} - {2140056000 -18000 0 EST} - {2153970000 -14400 1 EDT} - {2172110400 -18000 0 EST} - {2185419600 -14400 1 EDT} - {2203560000 -18000 0 EST} - {2216869200 -14400 1 EDT} - {2235009600 -18000 0 EST} - {2248923600 -14400 1 EDT} - {2266459200 -18000 0 EST} - {2280373200 -14400 1 EDT} - {2297908800 -18000 0 EST} - {2311822800 -14400 1 EDT} - {2329358400 -18000 0 EST} - {2343272400 -14400 1 EDT} - {2361412800 -18000 0 EST} - {2374722000 -14400 1 EDT} - {2392862400 -18000 0 EST} - {2406171600 -14400 1 EDT} - {2424312000 -18000 0 EST} - {2438226000 -14400 1 EDT} - {2455761600 -18000 0 EST} - {2469675600 -14400 1 EDT} - {2487211200 -18000 0 EST} - {2501125200 -14400 1 EDT} - {2519265600 -18000 0 EST} - {2532574800 -14400 1 EDT} - {2550715200 -18000 0 EST} - {2564024400 -14400 1 EDT} - {2582164800 -18000 0 EST} - {2596078800 -14400 1 EDT} - {2613614400 -18000 0 EST} - {2627528400 -14400 1 EDT} - {2645064000 -18000 0 EST} - {2658978000 -14400 1 EDT} - {2676513600 -18000 0 EST} - {2690427600 -14400 1 EDT} - {2708568000 -18000 0 EST} - {2721877200 -14400 1 EDT} - {2740017600 -18000 0 EST} - {2753326800 -14400 1 EDT} - {2771467200 -18000 0 EST} - {2785381200 -14400 1 EDT} - {2802916800 -18000 0 EST} - {2816830800 -14400 1 EDT} - {2834366400 -18000 0 EST} - {2848280400 -14400 1 EDT} - {2866420800 -18000 0 EST} - {2879730000 -14400 1 EDT} - {2897870400 -18000 0 EST} - {2911179600 -14400 1 EDT} - {2929320000 -18000 0 EST} - {2942629200 -14400 1 EDT} - {2960769600 -18000 0 EST} - {2974683600 -14400 1 EDT} - {2992219200 -18000 0 EST} - {3006133200 -14400 1 EDT} - {3023668800 -18000 0 EST} - {3037582800 -14400 1 EDT} - {3055723200 -18000 0 EST} - {3069032400 -14400 1 EDT} - {3087172800 -18000 0 EST} - {3100482000 -14400 1 EDT} - {3118622400 -18000 0 EST} - {3132536400 -14400 1 EDT} - {3150072000 -18000 0 EST} - {3163986000 -14400 1 EDT} - {3181521600 -18000 0 EST} - {3195435600 -14400 1 EDT} - {3212971200 -18000 0 EST} - {3226885200 -14400 1 EDT} - {3245025600 -18000 0 EST} - {3258334800 -14400 1 EDT} - {3276475200 -18000 0 EST} - {3289784400 -14400 1 EDT} - {3307924800 -18000 0 EST} - {3321838800 -14400 1 EDT} - {3339374400 -18000 0 EST} - {3353288400 -14400 1 EDT} - {3370824000 -18000 0 EST} - {3384738000 -14400 1 EDT} - {3402878400 -18000 0 EST} - {3416187600 -14400 1 EDT} - {3434328000 -18000 0 EST} - {3447637200 -14400 1 EDT} - {3465777600 -18000 0 EST} - {3479691600 -14400 1 EDT} - {3497227200 -18000 0 EST} - {3511141200 -14400 1 EDT} - {3528676800 -18000 0 EST} - {3542590800 -14400 1 EDT} - {3560126400 -18000 0 EST} - {3574040400 -14400 1 EDT} - {3592180800 -18000 0 EST} - {3605490000 -14400 1 EDT} - {3623630400 -18000 0 EST} - {3636939600 -14400 1 EDT} - {3655080000 -18000 0 EST} - {3668994000 -14400 1 EDT} - {3686529600 -18000 0 EST} - {3700443600 -14400 1 EDT} - {3717979200 -18000 0 EST} - {3731893200 -14400 1 EDT} - {3750033600 -18000 0 EST} - {3763342800 -14400 1 EDT} - {3781483200 -18000 0 EST} - {3794792400 -14400 1 EDT} - {3812932800 -18000 0 EST} - {3826242000 -14400 1 EDT} - {3844382400 -18000 0 EST} - {3858296400 -14400 1 EDT} - {3875832000 -18000 0 EST} - {3889746000 -14400 1 EDT} - {3907281600 -18000 0 EST} - {3921195600 -14400 1 EDT} - {3939336000 -18000 0 EST} - {3952645200 -14400 1 EDT} - {3970785600 -18000 0 EST} - {3984094800 -14400 1 EDT} - {4002235200 -18000 0 EST} - {4016149200 -14400 1 EDT} - {4033684800 -18000 0 EST} - {4047598800 -14400 1 EDT} - {4065134400 -18000 0 EST} - {4079048400 -14400 1 EDT} - {4096584000 -18000 0 EST} + {294217200 -14400 1 EDT} + {309938400 -18000 0 EST} + {325666800 -14400 1 EDT} + {341388000 -18000 0 EST} + {357116400 -14400 1 EDT} + {372837600 -18000 0 EST} + {388566000 -14400 1 EDT} + {404892000 -18000 0 EST} + {420015600 -14400 1 EDT} + {436341600 -18000 0 EST} + {452070000 -14400 1 EDT} + {467791200 -18000 0 EST} + {483519600 -14400 1 EDT} + {499240800 -18000 0 EST} + {514969200 -14400 1 EDT} + {530690400 -18000 0 EST} + {544604400 -14400 1 EDT} + {562140000 -18000 0 EST} + {576054000 -14400 1 EDT} + {594194400 -18000 0 EST} + {607503600 -14400 1 EDT} + {625644000 -18000 0 EST} + {638953200 -14400 1 EDT} + {657093600 -18000 0 EST} + {671007600 -14400 1 EDT} + {688543200 -18000 0 EST} + {702457200 -14400 1 EDT} + {719992800 -18000 0 EST} + {733906800 -14400 1 EDT} + {752047200 -18000 0 EST} + {765356400 -14400 1 EDT} + {783496800 -18000 0 EST} + {796806000 -14400 1 EDT} + {814946400 -18000 0 EST} + {828860400 -14400 1 EDT} + {846396000 -18000 0 EST} + {860310000 -14400 1 EDT} + {877845600 -18000 0 EST} + {891759600 -14400 1 EDT} + {909295200 -18000 0 EST} + {923209200 -14400 1 EDT} + {941349600 -18000 0 EST} + {954658800 -14400 1 EDT} + {972799200 -18000 0 EST} + {986108400 -14400 1 EDT} + {1004248800 -18000 0 EST} + {1018162800 -14400 1 EDT} + {1035698400 -18000 0 EST} + {1049612400 -14400 1 EDT} + {1067148000 -18000 0 EST} + {1081062000 -14400 1 EDT} + {1099202400 -18000 0 EST} + {1112511600 -14400 1 EDT} + {1130652000 -18000 0 EST} + {1143961200 -14400 1 EDT} + {1162101600 -18000 0 EST} + {1173596400 -14400 1 EDT} + {1194156000 -18000 0 EST} + {1205046000 -14400 1 EDT} + {1225605600 -18000 0 EST} + {1236495600 -14400 1 EDT} + {1257055200 -18000 0 EST} + {1268550000 -14400 1 EDT} + {1289109600 -18000 0 EST} + {1299999600 -14400 1 EDT} + {1320559200 -18000 0 EST} + {1331449200 -14400 1 EDT} + {1352008800 -18000 0 EST} + {1362898800 -14400 1 EDT} + {1383458400 -18000 0 EST} + {1394348400 -14400 1 EDT} + {1414908000 -18000 0 EST} + {1425798000 -14400 1 EDT} + {1446357600 -18000 0 EST} + {1457852400 -14400 1 EDT} + {1478412000 -18000 0 EST} + {1489302000 -14400 1 EDT} + {1509861600 -18000 0 EST} + {1520751600 -14400 1 EDT} + {1541311200 -18000 0 EST} + {1552201200 -14400 1 EDT} + {1572760800 -18000 0 EST} + {1583650800 -14400 1 EDT} + {1604210400 -18000 0 EST} + {1615705200 -14400 1 EDT} + {1636264800 -18000 0 EST} + {1647154800 -14400 1 EDT} + {1667714400 -18000 0 EST} + {1678604400 -14400 1 EDT} + {1699164000 -18000 0 EST} + {1710054000 -14400 1 EDT} + {1730613600 -18000 0 EST} + {1741503600 -14400 1 EDT} + {1762063200 -18000 0 EST} + {1772953200 -14400 1 EDT} + {1793512800 -18000 0 EST} + {1805007600 -14400 1 EDT} + {1825567200 -18000 0 EST} + {1836457200 -14400 1 EDT} + {1857016800 -18000 0 EST} + {1867906800 -14400 1 EDT} + {1888466400 -18000 0 EST} + {1899356400 -14400 1 EDT} + {1919916000 -18000 0 EST} + {1930806000 -14400 1 EDT} + {1951365600 -18000 0 EST} + {1962860400 -14400 1 EDT} + {1983420000 -18000 0 EST} + {1994310000 -14400 1 EDT} + {2014869600 -18000 0 EST} + {2025759600 -14400 1 EDT} + {2046319200 -18000 0 EST} + {2057209200 -14400 1 EDT} + {2077768800 -18000 0 EST} + {2088658800 -14400 1 EDT} + {2109218400 -18000 0 EST} + {2120108400 -14400 1 EDT} + {2140668000 -18000 0 EST} + {2152162800 -14400 1 EDT} + {2172722400 -18000 0 EST} + {2183612400 -14400 1 EDT} + {2204172000 -18000 0 EST} + {2215062000 -14400 1 EDT} + {2235621600 -18000 0 EST} + {2246511600 -14400 1 EDT} + {2267071200 -18000 0 EST} + {2277961200 -14400 1 EDT} + {2298520800 -18000 0 EST} + {2309410800 -14400 1 EDT} + {2329970400 -18000 0 EST} + {2341465200 -14400 1 EDT} + {2362024800 -18000 0 EST} + {2372914800 -14400 1 EDT} + {2393474400 -18000 0 EST} + {2404364400 -14400 1 EDT} + {2424924000 -18000 0 EST} + {2435814000 -14400 1 EDT} + {2456373600 -18000 0 EST} + {2467263600 -14400 1 EDT} + {2487823200 -18000 0 EST} + {2499318000 -14400 1 EDT} + {2519877600 -18000 0 EST} + {2530767600 -14400 1 EDT} + {2551327200 -18000 0 EST} + {2562217200 -14400 1 EDT} + {2582776800 -18000 0 EST} + {2593666800 -14400 1 EDT} + {2614226400 -18000 0 EST} + {2625116400 -14400 1 EDT} + {2645676000 -18000 0 EST} + {2656566000 -14400 1 EDT} + {2677125600 -18000 0 EST} + {2688620400 -14400 1 EDT} + {2709180000 -18000 0 EST} + {2720070000 -14400 1 EDT} + {2740629600 -18000 0 EST} + {2751519600 -14400 1 EDT} + {2772079200 -18000 0 EST} + {2782969200 -14400 1 EDT} + {2803528800 -18000 0 EST} + {2814418800 -14400 1 EDT} + {2834978400 -18000 0 EST} + {2846473200 -14400 1 EDT} + {2867032800 -18000 0 EST} + {2877922800 -14400 1 EDT} + {2898482400 -18000 0 EST} + {2909372400 -14400 1 EDT} + {2929932000 -18000 0 EST} + {2940822000 -14400 1 EDT} + {2961381600 -18000 0 EST} + {2972271600 -14400 1 EDT} + {2992831200 -18000 0 EST} + {3003721200 -14400 1 EDT} + {3024280800 -18000 0 EST} + {3035775600 -14400 1 EDT} + {3056335200 -18000 0 EST} + {3067225200 -14400 1 EDT} + {3087784800 -18000 0 EST} + {3098674800 -14400 1 EDT} + {3119234400 -18000 0 EST} + {3130124400 -14400 1 EDT} + {3150684000 -18000 0 EST} + {3161574000 -14400 1 EDT} + {3182133600 -18000 0 EST} + {3193023600 -14400 1 EDT} + {3213583200 -18000 0 EST} + {3225078000 -14400 1 EDT} + {3245637600 -18000 0 EST} + {3256527600 -14400 1 EDT} + {3277087200 -18000 0 EST} + {3287977200 -14400 1 EDT} + {3308536800 -18000 0 EST} + {3319426800 -14400 1 EDT} + {3339986400 -18000 0 EST} + {3350876400 -14400 1 EDT} + {3371436000 -18000 0 EST} + {3382930800 -14400 1 EDT} + {3403490400 -18000 0 EST} + {3414380400 -14400 1 EDT} + {3434940000 -18000 0 EST} + {3445830000 -14400 1 EDT} + {3466389600 -18000 0 EST} + {3477279600 -14400 1 EDT} + {3497839200 -18000 0 EST} + {3508729200 -14400 1 EDT} + {3529288800 -18000 0 EST} + {3540178800 -14400 1 EDT} + {3560738400 -18000 0 EST} + {3572233200 -14400 1 EDT} + {3592792800 -18000 0 EST} + {3603682800 -14400 1 EDT} + {3624242400 -18000 0 EST} + {3635132400 -14400 1 EDT} + {3655692000 -18000 0 EST} + {3666582000 -14400 1 EDT} + {3687141600 -18000 0 EST} + {3698031600 -14400 1 EDT} + {3718591200 -18000 0 EST} + {3730086000 -14400 1 EDT} + {3750645600 -18000 0 EST} + {3761535600 -14400 1 EDT} + {3782095200 -18000 0 EST} + {3792985200 -14400 1 EDT} + {3813544800 -18000 0 EST} + {3824434800 -14400 1 EDT} + {3844994400 -18000 0 EST} + {3855884400 -14400 1 EDT} + {3876444000 -18000 0 EST} + {3887334000 -14400 1 EDT} + {3907893600 -18000 0 EST} + {3919388400 -14400 1 EDT} + {3939948000 -18000 0 EST} + {3950838000 -14400 1 EDT} + {3971397600 -18000 0 EST} + {3982287600 -14400 1 EDT} + {4002847200 -18000 0 EST} + {4013737200 -14400 1 EDT} + {4034296800 -18000 0 EST} + {4045186800 -14400 1 EDT} + {4065746400 -18000 0 EST} + {4076636400 -14400 1 EDT} + {4097196000 -18000 0 EST} } diff --git a/library/tzdata/America/Indiana/Petersburg b/library/tzdata/America/Indiana/Petersburg index f450fbb..6992bfc 100755 --- a/library/tzdata/America/Indiana/Petersburg +++ b/library/tzdata/America/Indiana/Petersburg @@ -59,189 +59,189 @@ set TZData(:America/Indiana/Petersburg) { {1143964800 -18000 1 CDT} {1162105200 -21600 0 CST} {1173600000 -18000 1 CDT} - {1194159600 -21600 0 CST} - {1205049600 -18000 1 CDT} - {1225609200 -21600 0 CST} - {1236499200 -18000 1 CDT} - {1257058800 -21600 0 CST} - {1268553600 -18000 1 CDT} - {1289113200 -21600 0 CST} - {1300003200 -18000 1 CDT} - {1320562800 -21600 0 CST} - {1331452800 -18000 1 CDT} - {1352012400 -21600 0 CST} - {1362902400 -18000 1 CDT} - {1383462000 -21600 0 CST} - {1394352000 -18000 1 CDT} - {1414911600 -21600 0 CST} - {1425801600 -18000 1 CDT} - {1446361200 -21600 0 CST} - {1457856000 -18000 1 CDT} - {1478415600 -21600 0 CST} - {1489305600 -18000 1 CDT} - {1509865200 -21600 0 CST} - {1520755200 -18000 1 CDT} - {1541314800 -21600 0 CST} - {1552204800 -18000 1 CDT} - {1572764400 -21600 0 CST} - {1583654400 -18000 1 CDT} - {1604214000 -21600 0 CST} - {1615708800 -18000 1 CDT} - {1636268400 -21600 0 CST} - {1647158400 -18000 1 CDT} - {1667718000 -21600 0 CST} - {1678608000 -18000 1 CDT} - {1699167600 -21600 0 CST} - {1710057600 -18000 1 CDT} - {1730617200 -21600 0 CST} - {1741507200 -18000 1 CDT} - {1762066800 -21600 0 CST} - {1772956800 -18000 1 CDT} - {1793516400 -21600 0 CST} - {1805011200 -18000 1 CDT} - {1825570800 -21600 0 CST} - {1836460800 -18000 1 CDT} - {1857020400 -21600 0 CST} - {1867910400 -18000 1 CDT} - {1888470000 -21600 0 CST} - {1899360000 -18000 1 CDT} - {1919919600 -21600 0 CST} - {1930809600 -18000 1 CDT} - {1951369200 -21600 0 CST} - {1962864000 -18000 1 CDT} - {1983423600 -21600 0 CST} - {1994313600 -18000 1 CDT} - {2014873200 -21600 0 CST} - {2025763200 -18000 1 CDT} - {2046322800 -21600 0 CST} - {2057212800 -18000 1 CDT} - {2077772400 -21600 0 CST} - {2088662400 -18000 1 CDT} - {2109222000 -21600 0 CST} - {2120112000 -18000 1 CDT} - {2140671600 -21600 0 CST} - {2152166400 -18000 1 CDT} - {2172726000 -21600 0 CST} - {2183616000 -18000 1 CDT} - {2204175600 -21600 0 CST} - {2215065600 -18000 1 CDT} - {2235625200 -21600 0 CST} - {2246515200 -18000 1 CDT} - {2267074800 -21600 0 CST} - {2277964800 -18000 1 CDT} - {2298524400 -21600 0 CST} - {2309414400 -18000 1 CDT} - {2329974000 -21600 0 CST} - {2341468800 -18000 1 CDT} - {2362028400 -21600 0 CST} - {2372918400 -18000 1 CDT} - {2393478000 -21600 0 CST} - {2404368000 -18000 1 CDT} - {2424927600 -21600 0 CST} - {2435817600 -18000 1 CDT} - {2456377200 -21600 0 CST} - {2467267200 -18000 1 CDT} - {2487826800 -21600 0 CST} - {2499321600 -18000 1 CDT} - {2519881200 -21600 0 CST} - {2530771200 -18000 1 CDT} - {2551330800 -21600 0 CST} - {2562220800 -18000 1 CDT} - {2582780400 -21600 0 CST} - {2593670400 -18000 1 CDT} - {2614230000 -21600 0 CST} - {2625120000 -18000 1 CDT} - {2645679600 -21600 0 CST} - {2656569600 -18000 1 CDT} - {2677129200 -21600 0 CST} - {2688624000 -18000 1 CDT} - {2709183600 -21600 0 CST} - {2720073600 -18000 1 CDT} - {2740633200 -21600 0 CST} - {2751523200 -18000 1 CDT} - {2772082800 -21600 0 CST} - {2782972800 -18000 1 CDT} - {2803532400 -21600 0 CST} - {2814422400 -18000 1 CDT} - {2834982000 -21600 0 CST} - {2846476800 -18000 1 CDT} - {2867036400 -21600 0 CST} - {2877926400 -18000 1 CDT} - {2898486000 -21600 0 CST} - {2909376000 -18000 1 CDT} - {2929935600 -21600 0 CST} - {2940825600 -18000 1 CDT} - {2961385200 -21600 0 CST} - {2972275200 -18000 1 CDT} - {2992834800 -21600 0 CST} - {3003724800 -18000 1 CDT} - {3024284400 -21600 0 CST} - {3035779200 -18000 1 CDT} - {3056338800 -21600 0 CST} - {3067228800 -18000 1 CDT} - {3087788400 -21600 0 CST} - {3098678400 -18000 1 CDT} - {3119238000 -21600 0 CST} - {3130128000 -18000 1 CDT} - {3150687600 -21600 0 CST} - {3161577600 -18000 1 CDT} - {3182137200 -21600 0 CST} - {3193027200 -18000 1 CDT} - {3213586800 -21600 0 CST} - {3225081600 -18000 1 CDT} - {3245641200 -21600 0 CST} - {3256531200 -18000 1 CDT} - {3277090800 -21600 0 CST} - {3287980800 -18000 1 CDT} - {3308540400 -21600 0 CST} - {3319430400 -18000 1 CDT} - {3339990000 -21600 0 CST} - {3350880000 -18000 1 CDT} - {3371439600 -21600 0 CST} - {3382934400 -18000 1 CDT} - {3403494000 -21600 0 CST} - {3414384000 -18000 1 CDT} - {3434943600 -21600 0 CST} - {3445833600 -18000 1 CDT} - {3466393200 -21600 0 CST} - {3477283200 -18000 1 CDT} - {3497842800 -21600 0 CST} - {3508732800 -18000 1 CDT} - {3529292400 -21600 0 CST} - {3540182400 -18000 1 CDT} - {3560742000 -21600 0 CST} - {3572236800 -18000 1 CDT} - {3592796400 -21600 0 CST} - {3603686400 -18000 1 CDT} - {3624246000 -21600 0 CST} - {3635136000 -18000 1 CDT} - {3655695600 -21600 0 CST} - {3666585600 -18000 1 CDT} - {3687145200 -21600 0 CST} - {3698035200 -18000 1 CDT} - {3718594800 -21600 0 CST} - {3730089600 -18000 1 CDT} - {3750649200 -21600 0 CST} - {3761539200 -18000 1 CDT} - {3782098800 -21600 0 CST} - {3792988800 -18000 1 CDT} - {3813548400 -21600 0 CST} - {3824438400 -18000 1 CDT} - {3844998000 -21600 0 CST} - {3855888000 -18000 1 CDT} - {3876447600 -21600 0 CST} - {3887337600 -18000 1 CDT} - {3907897200 -21600 0 CST} - {3919392000 -18000 1 CDT} - {3939951600 -21600 0 CST} - {3950841600 -18000 1 CDT} - {3971401200 -21600 0 CST} - {3982291200 -18000 1 CDT} - {4002850800 -21600 0 CST} - {4013740800 -18000 1 CDT} - {4034300400 -21600 0 CST} - {4045190400 -18000 1 CDT} - {4065750000 -21600 0 CST} - {4076640000 -18000 1 CDT} - {4097199600 -21600 0 CST} + {1194163200 -18000 0 EST} + {1205046000 -14400 1 EDT} + {1225605600 -18000 0 EST} + {1236495600 -14400 1 EDT} + {1257055200 -18000 0 EST} + {1268550000 -14400 1 EDT} + {1289109600 -18000 0 EST} + {1299999600 -14400 1 EDT} + {1320559200 -18000 0 EST} + {1331449200 -14400 1 EDT} + {1352008800 -18000 0 EST} + {1362898800 -14400 1 EDT} + {1383458400 -18000 0 EST} + {1394348400 -14400 1 EDT} + {1414908000 -18000 0 EST} + {1425798000 -14400 1 EDT} + {1446357600 -18000 0 EST} + {1457852400 -14400 1 EDT} + {1478412000 -18000 0 EST} + {1489302000 -14400 1 EDT} + {1509861600 -18000 0 EST} + {1520751600 -14400 1 EDT} + {1541311200 -18000 0 EST} + {1552201200 -14400 1 EDT} + {1572760800 -18000 0 EST} + {1583650800 -14400 1 EDT} + {1604210400 -18000 0 EST} + {1615705200 -14400 1 EDT} + {1636264800 -18000 0 EST} + {1647154800 -14400 1 EDT} + {1667714400 -18000 0 EST} + {1678604400 -14400 1 EDT} + {1699164000 -18000 0 EST} + {1710054000 -14400 1 EDT} + {1730613600 -18000 0 EST} + {1741503600 -14400 1 EDT} + {1762063200 -18000 0 EST} + {1772953200 -14400 1 EDT} + {1793512800 -18000 0 EST} + {1805007600 -14400 1 EDT} + {1825567200 -18000 0 EST} + {1836457200 -14400 1 EDT} + {1857016800 -18000 0 EST} + {1867906800 -14400 1 EDT} + {1888466400 -18000 0 EST} + {1899356400 -14400 1 EDT} + {1919916000 -18000 0 EST} + {1930806000 -14400 1 EDT} + {1951365600 -18000 0 EST} + {1962860400 -14400 1 EDT} + {1983420000 -18000 0 EST} + {1994310000 -14400 1 EDT} + {2014869600 -18000 0 EST} + {2025759600 -14400 1 EDT} + {2046319200 -18000 0 EST} + {2057209200 -14400 1 EDT} + {2077768800 -18000 0 EST} + {2088658800 -14400 1 EDT} + {2109218400 -18000 0 EST} + {2120108400 -14400 1 EDT} + {2140668000 -18000 0 EST} + {2152162800 -14400 1 EDT} + {2172722400 -18000 0 EST} + {2183612400 -14400 1 EDT} + {2204172000 -18000 0 EST} + {2215062000 -14400 1 EDT} + {2235621600 -18000 0 EST} + {2246511600 -14400 1 EDT} + {2267071200 -18000 0 EST} + {2277961200 -14400 1 EDT} + {2298520800 -18000 0 EST} + {2309410800 -14400 1 EDT} + {2329970400 -18000 0 EST} + {2341465200 -14400 1 EDT} + {2362024800 -18000 0 EST} + {2372914800 -14400 1 EDT} + {2393474400 -18000 0 EST} + {2404364400 -14400 1 EDT} + {2424924000 -18000 0 EST} + {2435814000 -14400 1 EDT} + {2456373600 -18000 0 EST} + {2467263600 -14400 1 EDT} + {2487823200 -18000 0 EST} + {2499318000 -14400 1 EDT} + {2519877600 -18000 0 EST} + {2530767600 -14400 1 EDT} + {2551327200 -18000 0 EST} + {2562217200 -14400 1 EDT} + {2582776800 -18000 0 EST} + {2593666800 -14400 1 EDT} + {2614226400 -18000 0 EST} + {2625116400 -14400 1 EDT} + {2645676000 -18000 0 EST} + {2656566000 -14400 1 EDT} + {2677125600 -18000 0 EST} + {2688620400 -14400 1 EDT} + {2709180000 -18000 0 EST} + {2720070000 -14400 1 EDT} + {2740629600 -18000 0 EST} + {2751519600 -14400 1 EDT} + {2772079200 -18000 0 EST} + {2782969200 -14400 1 EDT} + {2803528800 -18000 0 EST} + {2814418800 -14400 1 EDT} + {2834978400 -18000 0 EST} + {2846473200 -14400 1 EDT} + {2867032800 -18000 0 EST} + {2877922800 -14400 1 EDT} + {2898482400 -18000 0 EST} + {2909372400 -14400 1 EDT} + {2929932000 -18000 0 EST} + {2940822000 -14400 1 EDT} + {2961381600 -18000 0 EST} + {2972271600 -14400 1 EDT} + {2992831200 -18000 0 EST} + {3003721200 -14400 1 EDT} + {3024280800 -18000 0 EST} + {3035775600 -14400 1 EDT} + {3056335200 -18000 0 EST} + {3067225200 -14400 1 EDT} + {3087784800 -18000 0 EST} + {3098674800 -14400 1 EDT} + {3119234400 -18000 0 EST} + {3130124400 -14400 1 EDT} + {3150684000 -18000 0 EST} + {3161574000 -14400 1 EDT} + {3182133600 -18000 0 EST} + {3193023600 -14400 1 EDT} + {3213583200 -18000 0 EST} + {3225078000 -14400 1 EDT} + {3245637600 -18000 0 EST} + {3256527600 -14400 1 EDT} + {3277087200 -18000 0 EST} + {3287977200 -14400 1 EDT} + {3308536800 -18000 0 EST} + {3319426800 -14400 1 EDT} + {3339986400 -18000 0 EST} + {3350876400 -14400 1 EDT} + {3371436000 -18000 0 EST} + {3382930800 -14400 1 EDT} + {3403490400 -18000 0 EST} + {3414380400 -14400 1 EDT} + {3434940000 -18000 0 EST} + {3445830000 -14400 1 EDT} + {3466389600 -18000 0 EST} + {3477279600 -14400 1 EDT} + {3497839200 -18000 0 EST} + {3508729200 -14400 1 EDT} + {3529288800 -18000 0 EST} + {3540178800 -14400 1 EDT} + {3560738400 -18000 0 EST} + {3572233200 -14400 1 EDT} + {3592792800 -18000 0 EST} + {3603682800 -14400 1 EDT} + {3624242400 -18000 0 EST} + {3635132400 -14400 1 EDT} + {3655692000 -18000 0 EST} + {3666582000 -14400 1 EDT} + {3687141600 -18000 0 EST} + {3698031600 -14400 1 EDT} + {3718591200 -18000 0 EST} + {3730086000 -14400 1 EDT} + {3750645600 -18000 0 EST} + {3761535600 -14400 1 EDT} + {3782095200 -18000 0 EST} + {3792985200 -14400 1 EDT} + {3813544800 -18000 0 EST} + {3824434800 -14400 1 EDT} + {3844994400 -18000 0 EST} + {3855884400 -14400 1 EDT} + {3876444000 -18000 0 EST} + {3887334000 -14400 1 EDT} + {3907893600 -18000 0 EST} + {3919388400 -14400 1 EDT} + {3939948000 -18000 0 EST} + {3950838000 -14400 1 EDT} + {3971397600 -18000 0 EST} + {3982287600 -14400 1 EDT} + {4002847200 -18000 0 EST} + {4013737200 -14400 1 EDT} + {4034296800 -18000 0 EST} + {4045186800 -14400 1 EDT} + {4065746400 -18000 0 EST} + {4076636400 -14400 1 EDT} + {4097196000 -18000 0 EST} } diff --git a/library/tzdata/America/Indiana/Tell_City b/library/tzdata/America/Indiana/Tell_City new file mode 100755 index 0000000..9eebcf7 --- /dev/null +++ b/library/tzdata/America/Indiana/Tell_City @@ -0,0 +1,234 @@ +# created by tools/tclZIC.tcl - do not edit + +set TZData(:America/Indiana/Tell_City) { + {-9223372036854775808 -20823 0 LMT} + {-2717647200 -21600 0 CST} + {-1633276800 -18000 1 CDT} + {-1615136400 -21600 0 CST} + {-1601827200 -18000 1 CDT} + {-1583686800 -21600 0 CST} + {-880214400 -18000 1 CWT} + {-769395600 -18000 1 CPT} + {-765392400 -21600 0 CST} + {-757360800 -21600 0 CST} + {-747244800 -18000 1 CDT} + {-733942800 -21600 0 CST} + {-526492800 -18000 1 CDT} + {-513190800 -21600 0 CST} + {-495043200 -18000 1 CDT} + {-481741200 -21600 0 CST} + {-462996000 -18000 1 CDT} + {-450291600 -21600 0 CST} + {-431539200 -18000 1 CDT} + {-418237200 -21600 0 CST} + {-400089600 -18000 1 CDT} + {-386787600 -21600 0 CST} + {-368640000 -18000 1 CDT} + {-355338000 -21600 0 CST} + {-337190400 -18000 1 CDT} + {-323888400 -21600 0 CST} + {-305740800 -18000 1 CDT} + {-289414800 -21600 0 CST} + {-273686400 -18000 1 CDT} + {-260989200 -21600 0 CST} + {-242236800 -18000 1 CDT} + {-226515600 -21600 0 CST} + {-210787200 -18000 1 CDT} + {-195066000 -21600 0 CST} + {-179337600 -18000 0 EST} + {-31518000 -18000 0 EST} + {-21488400 -14400 1 EDT} + {-5767200 -18000 0 EST} + {9961200 -14400 1 EDT} + {25682400 -18000 0 EST} + {31554000 -18000 0 EST} + {1143961200 -21600 0 CST} + {1143964800 -18000 1 CDT} + {1162105200 -21600 0 CST} + {1173600000 -18000 1 CDT} + {1194159600 -21600 0 CST} + {1205049600 -18000 1 CDT} + {1225609200 -21600 0 CST} + {1236499200 -18000 1 CDT} + {1257058800 -21600 0 CST} + {1268553600 -18000 1 CDT} + {1289113200 -21600 0 CST} + {1300003200 -18000 1 CDT} + {1320562800 -21600 0 CST} + {1331452800 -18000 1 CDT} + {1352012400 -21600 0 CST} + {1362902400 -18000 1 CDT} + {1383462000 -21600 0 CST} + {1394352000 -18000 1 CDT} + {1414911600 -21600 0 CST} + {1425801600 -18000 1 CDT} + {1446361200 -21600 0 CST} + {1457856000 -18000 1 CDT} + {1478415600 -21600 0 CST} + {1489305600 -18000 1 CDT} + {1509865200 -21600 0 CST} + {1520755200 -18000 1 CDT} + {1541314800 -21600 0 CST} + {1552204800 -18000 1 CDT} + {1572764400 -21600 0 CST} + {1583654400 -18000 1 CDT} + {1604214000 -21600 0 CST} + {1615708800 -18000 1 CDT} + {1636268400 -21600 0 CST} + {1647158400 -18000 1 CDT} + {1667718000 -21600 0 CST} + {1678608000 -18000 1 CDT} + {1699167600 -21600 0 CST} + {1710057600 -18000 1 CDT} + {1730617200 -21600 0 CST} + {1741507200 -18000 1 CDT} + {1762066800 -21600 0 CST} + {1772956800 -18000 1 CDT} + {1793516400 -21600 0 CST} + {1805011200 -18000 1 CDT} + {1825570800 -21600 0 CST} + {1836460800 -18000 1 CDT} + {1857020400 -21600 0 CST} + {1867910400 -18000 1 CDT} + {1888470000 -21600 0 CST} + {1899360000 -18000 1 CDT} + {1919919600 -21600 0 CST} + {1930809600 -18000 1 CDT} + {1951369200 -21600 0 CST} + {1962864000 -18000 1 CDT} + {1983423600 -21600 0 CST} + {1994313600 -18000 1 CDT} + {2014873200 -21600 0 CST} + {2025763200 -18000 1 CDT} + {2046322800 -21600 0 CST} + {2057212800 -18000 1 CDT} + {2077772400 -21600 0 CST} + {2088662400 -18000 1 CDT} + {2109222000 -21600 0 CST} + {2120112000 -18000 1 CDT} + {2140671600 -21600 0 CST} + {2152166400 -18000 1 CDT} + {2172726000 -21600 0 CST} + {2183616000 -18000 1 CDT} + {2204175600 -21600 0 CST} + {2215065600 -18000 1 CDT} + {2235625200 -21600 0 CST} + {2246515200 -18000 1 CDT} + {2267074800 -21600 0 CST} + {2277964800 -18000 1 CDT} + {2298524400 -21600 0 CST} + {2309414400 -18000 1 CDT} + {2329974000 -21600 0 CST} + {2341468800 -18000 1 CDT} + {2362028400 -21600 0 CST} + {2372918400 -18000 1 CDT} + {2393478000 -21600 0 CST} + {2404368000 -18000 1 CDT} + {2424927600 -21600 0 CST} + {2435817600 -18000 1 CDT} + {2456377200 -21600 0 CST} + {2467267200 -18000 1 CDT} + {2487826800 -21600 0 CST} + {2499321600 -18000 1 CDT} + {2519881200 -21600 0 CST} + {2530771200 -18000 1 CDT} + {2551330800 -21600 0 CST} + {2562220800 -18000 1 CDT} + {2582780400 -21600 0 CST} + {2593670400 -18000 1 CDT} + {2614230000 -21600 0 CST} + {2625120000 -18000 1 CDT} + {2645679600 -21600 0 CST} + {2656569600 -18000 1 CDT} + {2677129200 -21600 0 CST} + {2688624000 -18000 1 CDT} + {2709183600 -21600 0 CST} + {2720073600 -18000 1 CDT} + {2740633200 -21600 0 CST} + {2751523200 -18000 1 CDT} + {2772082800 -21600 0 CST} + {2782972800 -18000 1 CDT} + {2803532400 -21600 0 CST} + {2814422400 -18000 1 CDT} + {2834982000 -21600 0 CST} + {2846476800 -18000 1 CDT} + {2867036400 -21600 0 CST} + {2877926400 -18000 1 CDT} + {2898486000 -21600 0 CST} + {2909376000 -18000 1 CDT} + {2929935600 -21600 0 CST} + {2940825600 -18000 1 CDT} + {2961385200 -21600 0 CST} + {2972275200 -18000 1 CDT} + {2992834800 -21600 0 CST} + {3003724800 -18000 1 CDT} + {3024284400 -21600 0 CST} + {3035779200 -18000 1 CDT} + {3056338800 -21600 0 CST} + {3067228800 -18000 1 CDT} + {3087788400 -21600 0 CST} + {3098678400 -18000 1 CDT} + {3119238000 -21600 0 CST} + {3130128000 -18000 1 CDT} + {3150687600 -21600 0 CST} + {3161577600 -18000 1 CDT} + {3182137200 -21600 0 CST} + {3193027200 -18000 1 CDT} + {3213586800 -21600 0 CST} + {3225081600 -18000 1 CDT} + {3245641200 -21600 0 CST} + {3256531200 -18000 1 CDT} + {3277090800 -21600 0 CST} + {3287980800 -18000 1 CDT} + {3308540400 -21600 0 CST} + {3319430400 -18000 1 CDT} + {3339990000 -21600 0 CST} + {3350880000 -18000 1 CDT} + {3371439600 -21600 0 CST} + {3382934400 -18000 1 CDT} + {3403494000 -21600 0 CST} + {3414384000 -18000 1 CDT} + {3434943600 -21600 0 CST} + {3445833600 -18000 1 CDT} + {3466393200 -21600 0 CST} + {3477283200 -18000 1 CDT} + {3497842800 -21600 0 CST} + {3508732800 -18000 1 CDT} + {3529292400 -21600 0 CST} + {3540182400 -18000 1 CDT} + {3560742000 -21600 0 CST} + {3572236800 -18000 1 CDT} + {3592796400 -21600 0 CST} + {3603686400 -18000 1 CDT} + {3624246000 -21600 0 CST} + {3635136000 -18000 1 CDT} + {3655695600 -21600 0 CST} + {3666585600 -18000 1 CDT} + {3687145200 -21600 0 CST} + {3698035200 -18000 1 CDT} + {3718594800 -21600 0 CST} + {3730089600 -18000 1 CDT} + {3750649200 -21600 0 CST} + {3761539200 -18000 1 CDT} + {3782098800 -21600 0 CST} + {3792988800 -18000 1 CDT} + {3813548400 -21600 0 CST} + {3824438400 -18000 1 CDT} + {3844998000 -21600 0 CST} + {3855888000 -18000 1 CDT} + {3876447600 -21600 0 CST} + {3887337600 -18000 1 CDT} + {3907897200 -21600 0 CST} + {3919392000 -18000 1 CDT} + {3939951600 -21600 0 CST} + {3950841600 -18000 1 CDT} + {3971401200 -21600 0 CST} + {3982291200 -18000 1 CDT} + {4002850800 -21600 0 CST} + {4013740800 -18000 1 CDT} + {4034300400 -21600 0 CST} + {4045190400 -18000 1 CDT} + {4065750000 -21600 0 CST} + {4076640000 -18000 1 CDT} + {4097199600 -21600 0 CST} +} diff --git a/library/tzdata/America/Indiana/Vincennes b/library/tzdata/America/Indiana/Vincennes index 3842b1c..1af7fc9 100755 --- a/library/tzdata/America/Indiana/Vincennes +++ b/library/tzdata/America/Indiana/Vincennes @@ -46,189 +46,189 @@ set TZData(:America/Indiana/Vincennes) { {1143964800 -18000 1 CDT} {1162105200 -21600 0 CST} {1173600000 -18000 1 CDT} - {1194159600 -21600 0 CST} - {1205049600 -18000 1 CDT} - {1225609200 -21600 0 CST} - {1236499200 -18000 1 CDT} - {1257058800 -21600 0 CST} - {1268553600 -18000 1 CDT} - {1289113200 -21600 0 CST} - {1300003200 -18000 1 CDT} - {1320562800 -21600 0 CST} - {1331452800 -18000 1 CDT} - {1352012400 -21600 0 CST} - {1362902400 -18000 1 CDT} - {1383462000 -21600 0 CST} - {1394352000 -18000 1 CDT} - {1414911600 -21600 0 CST} - {1425801600 -18000 1 CDT} - {1446361200 -21600 0 CST} - {1457856000 -18000 1 CDT} - {1478415600 -21600 0 CST} - {1489305600 -18000 1 CDT} - {1509865200 -21600 0 CST} - {1520755200 -18000 1 CDT} - {1541314800 -21600 0 CST} - {1552204800 -18000 1 CDT} - {1572764400 -21600 0 CST} - {1583654400 -18000 1 CDT} - {1604214000 -21600 0 CST} - {1615708800 -18000 1 CDT} - {1636268400 -21600 0 CST} - {1647158400 -18000 1 CDT} - {1667718000 -21600 0 CST} - {1678608000 -18000 1 CDT} - {1699167600 -21600 0 CST} - {1710057600 -18000 1 CDT} - {1730617200 -21600 0 CST} - {1741507200 -18000 1 CDT} - {1762066800 -21600 0 CST} - {1772956800 -18000 1 CDT} - {1793516400 -21600 0 CST} - {1805011200 -18000 1 CDT} - {1825570800 -21600 0 CST} - {1836460800 -18000 1 CDT} - {1857020400 -21600 0 CST} - {1867910400 -18000 1 CDT} - {1888470000 -21600 0 CST} - {1899360000 -18000 1 CDT} - {1919919600 -21600 0 CST} - {1930809600 -18000 1 CDT} - {1951369200 -21600 0 CST} - {1962864000 -18000 1 CDT} - {1983423600 -21600 0 CST} - {1994313600 -18000 1 CDT} - {2014873200 -21600 0 CST} - {2025763200 -18000 1 CDT} - {2046322800 -21600 0 CST} - {2057212800 -18000 1 CDT} - {2077772400 -21600 0 CST} - {2088662400 -18000 1 CDT} - {2109222000 -21600 0 CST} - {2120112000 -18000 1 CDT} - {2140671600 -21600 0 CST} - {2152166400 -18000 1 CDT} - {2172726000 -21600 0 CST} - {2183616000 -18000 1 CDT} - {2204175600 -21600 0 CST} - {2215065600 -18000 1 CDT} - {2235625200 -21600 0 CST} - {2246515200 -18000 1 CDT} - {2267074800 -21600 0 CST} - {2277964800 -18000 1 CDT} - {2298524400 -21600 0 CST} - {2309414400 -18000 1 CDT} - {2329974000 -21600 0 CST} - {2341468800 -18000 1 CDT} - {2362028400 -21600 0 CST} - {2372918400 -18000 1 CDT} - {2393478000 -21600 0 CST} - {2404368000 -18000 1 CDT} - {2424927600 -21600 0 CST} - {2435817600 -18000 1 CDT} - {2456377200 -21600 0 CST} - {2467267200 -18000 1 CDT} - {2487826800 -21600 0 CST} - {2499321600 -18000 1 CDT} - {2519881200 -21600 0 CST} - {2530771200 -18000 1 CDT} - {2551330800 -21600 0 CST} - {2562220800 -18000 1 CDT} - {2582780400 -21600 0 CST} - {2593670400 -18000 1 CDT} - {2614230000 -21600 0 CST} - {2625120000 -18000 1 CDT} - {2645679600 -21600 0 CST} - {2656569600 -18000 1 CDT} - {2677129200 -21600 0 CST} - {2688624000 -18000 1 CDT} - {2709183600 -21600 0 CST} - {2720073600 -18000 1 CDT} - {2740633200 -21600 0 CST} - {2751523200 -18000 1 CDT} - {2772082800 -21600 0 CST} - {2782972800 -18000 1 CDT} - {2803532400 -21600 0 CST} - {2814422400 -18000 1 CDT} - {2834982000 -21600 0 CST} - {2846476800 -18000 1 CDT} - {2867036400 -21600 0 CST} - {2877926400 -18000 1 CDT} - {2898486000 -21600 0 CST} - {2909376000 -18000 1 CDT} - {2929935600 -21600 0 CST} - {2940825600 -18000 1 CDT} - {2961385200 -21600 0 CST} - {2972275200 -18000 1 CDT} - {2992834800 -21600 0 CST} - {3003724800 -18000 1 CDT} - {3024284400 -21600 0 CST} - {3035779200 -18000 1 CDT} - {3056338800 -21600 0 CST} - {3067228800 -18000 1 CDT} - {3087788400 -21600 0 CST} - {3098678400 -18000 1 CDT} - {3119238000 -21600 0 CST} - {3130128000 -18000 1 CDT} - {3150687600 -21600 0 CST} - {3161577600 -18000 1 CDT} - {3182137200 -21600 0 CST} - {3193027200 -18000 1 CDT} - {3213586800 -21600 0 CST} - {3225081600 -18000 1 CDT} - {3245641200 -21600 0 CST} - {3256531200 -18000 1 CDT} - {3277090800 -21600 0 CST} - {3287980800 -18000 1 CDT} - {3308540400 -21600 0 CST} - {3319430400 -18000 1 CDT} - {3339990000 -21600 0 CST} - {3350880000 -18000 1 CDT} - {3371439600 -21600 0 CST} - {3382934400 -18000 1 CDT} - {3403494000 -21600 0 CST} - {3414384000 -18000 1 CDT} - {3434943600 -21600 0 CST} - {3445833600 -18000 1 CDT} - {3466393200 -21600 0 CST} - {3477283200 -18000 1 CDT} - {3497842800 -21600 0 CST} - {3508732800 -18000 1 CDT} - {3529292400 -21600 0 CST} - {3540182400 -18000 1 CDT} - {3560742000 -21600 0 CST} - {3572236800 -18000 1 CDT} - {3592796400 -21600 0 CST} - {3603686400 -18000 1 CDT} - {3624246000 -21600 0 CST} - {3635136000 -18000 1 CDT} - {3655695600 -21600 0 CST} - {3666585600 -18000 1 CDT} - {3687145200 -21600 0 CST} - {3698035200 -18000 1 CDT} - {3718594800 -21600 0 CST} - {3730089600 -18000 1 CDT} - {3750649200 -21600 0 CST} - {3761539200 -18000 1 CDT} - {3782098800 -21600 0 CST} - {3792988800 -18000 1 CDT} - {3813548400 -21600 0 CST} - {3824438400 -18000 1 CDT} - {3844998000 -21600 0 CST} - {3855888000 -18000 1 CDT} - {3876447600 -21600 0 CST} - {3887337600 -18000 1 CDT} - {3907897200 -21600 0 CST} - {3919392000 -18000 1 CDT} - {3939951600 -21600 0 CST} - {3950841600 -18000 1 CDT} - {3971401200 -21600 0 CST} - {3982291200 -18000 1 CDT} - {4002850800 -21600 0 CST} - {4013740800 -18000 1 CDT} - {4034300400 -21600 0 CST} - {4045190400 -18000 1 CDT} - {4065750000 -21600 0 CST} - {4076640000 -18000 1 CDT} - {4097199600 -21600 0 CST} + {1194163200 -18000 0 EST} + {1205046000 -14400 1 EDT} + {1225605600 -18000 0 EST} + {1236495600 -14400 1 EDT} + {1257055200 -18000 0 EST} + {1268550000 -14400 1 EDT} + {1289109600 -18000 0 EST} + {1299999600 -14400 1 EDT} + {1320559200 -18000 0 EST} + {1331449200 -14400 1 EDT} + {1352008800 -18000 0 EST} + {1362898800 -14400 1 EDT} + {1383458400 -18000 0 EST} + {1394348400 -14400 1 EDT} + {1414908000 -18000 0 EST} + {1425798000 -14400 1 EDT} + {1446357600 -18000 0 EST} + {1457852400 -14400 1 EDT} + {1478412000 -18000 0 EST} + {1489302000 -14400 1 EDT} + {1509861600 -18000 0 EST} + {1520751600 -14400 1 EDT} + {1541311200 -18000 0 EST} + {1552201200 -14400 1 EDT} + {1572760800 -18000 0 EST} + {1583650800 -14400 1 EDT} + {1604210400 -18000 0 EST} + {1615705200 -14400 1 EDT} + {1636264800 -18000 0 EST} + {1647154800 -14400 1 EDT} + {1667714400 -18000 0 EST} + {1678604400 -14400 1 EDT} + {1699164000 -18000 0 EST} + {1710054000 -14400 1 EDT} + {1730613600 -18000 0 EST} + {1741503600 -14400 1 EDT} + {1762063200 -18000 0 EST} + {1772953200 -14400 1 EDT} + {1793512800 -18000 0 EST} + {1805007600 -14400 1 EDT} + {1825567200 -18000 0 EST} + {1836457200 -14400 1 EDT} + {1857016800 -18000 0 EST} + {1867906800 -14400 1 EDT} + {1888466400 -18000 0 EST} + {1899356400 -14400 1 EDT} + {1919916000 -18000 0 EST} + {1930806000 -14400 1 EDT} + {1951365600 -18000 0 EST} + {1962860400 -14400 1 EDT} + {1983420000 -18000 0 EST} + {1994310000 -14400 1 EDT} + {2014869600 -18000 0 EST} + {2025759600 -14400 1 EDT} + {2046319200 -18000 0 EST} + {2057209200 -14400 1 EDT} + {2077768800 -18000 0 EST} + {2088658800 -14400 1 EDT} + {2109218400 -18000 0 EST} + {2120108400 -14400 1 EDT} + {2140668000 -18000 0 EST} + {2152162800 -14400 1 EDT} + {2172722400 -18000 0 EST} + {2183612400 -14400 1 EDT} + {2204172000 -18000 0 EST} + {2215062000 -14400 1 EDT} + {2235621600 -18000 0 EST} + {2246511600 -14400 1 EDT} + {2267071200 -18000 0 EST} + {2277961200 -14400 1 EDT} + {2298520800 -18000 0 EST} + {2309410800 -14400 1 EDT} + {2329970400 -18000 0 EST} + {2341465200 -14400 1 EDT} + {2362024800 -18000 0 EST} + {2372914800 -14400 1 EDT} + {2393474400 -18000 0 EST} + {2404364400 -14400 1 EDT} + {2424924000 -18000 0 EST} + {2435814000 -14400 1 EDT} + {2456373600 -18000 0 EST} + {2467263600 -14400 1 EDT} + {2487823200 -18000 0 EST} + {2499318000 -14400 1 EDT} + {2519877600 -18000 0 EST} + {2530767600 -14400 1 EDT} + {2551327200 -18000 0 EST} + {2562217200 -14400 1 EDT} + {2582776800 -18000 0 EST} + {2593666800 -14400 1 EDT} + {2614226400 -18000 0 EST} + {2625116400 -14400 1 EDT} + {2645676000 -18000 0 EST} + {2656566000 -14400 1 EDT} + {2677125600 -18000 0 EST} + {2688620400 -14400 1 EDT} + {2709180000 -18000 0 EST} + {2720070000 -14400 1 EDT} + {2740629600 -18000 0 EST} + {2751519600 -14400 1 EDT} + {2772079200 -18000 0 EST} + {2782969200 -14400 1 EDT} + {2803528800 -18000 0 EST} + {2814418800 -14400 1 EDT} + {2834978400 -18000 0 EST} + {2846473200 -14400 1 EDT} + {2867032800 -18000 0 EST} + {2877922800 -14400 1 EDT} + {2898482400 -18000 0 EST} + {2909372400 -14400 1 EDT} + {2929932000 -18000 0 EST} + {2940822000 -14400 1 EDT} + {2961381600 -18000 0 EST} + {2972271600 -14400 1 EDT} + {2992831200 -18000 0 EST} + {3003721200 -14400 1 EDT} + {3024280800 -18000 0 EST} + {3035775600 -14400 1 EDT} + {3056335200 -18000 0 EST} + {3067225200 -14400 1 EDT} + {3087784800 -18000 0 EST} + {3098674800 -14400 1 EDT} + {3119234400 -18000 0 EST} + {3130124400 -14400 1 EDT} + {3150684000 -18000 0 EST} + {3161574000 -14400 1 EDT} + {3182133600 -18000 0 EST} + {3193023600 -14400 1 EDT} + {3213583200 -18000 0 EST} + {3225078000 -14400 1 EDT} + {3245637600 -18000 0 EST} + {3256527600 -14400 1 EDT} + {3277087200 -18000 0 EST} + {3287977200 -14400 1 EDT} + {3308536800 -18000 0 EST} + {3319426800 -14400 1 EDT} + {3339986400 -18000 0 EST} + {3350876400 -14400 1 EDT} + {3371436000 -18000 0 EST} + {3382930800 -14400 1 EDT} + {3403490400 -18000 0 EST} + {3414380400 -14400 1 EDT} + {3434940000 -18000 0 EST} + {3445830000 -14400 1 EDT} + {3466389600 -18000 0 EST} + {3477279600 -14400 1 EDT} + {3497839200 -18000 0 EST} + {3508729200 -14400 1 EDT} + {3529288800 -18000 0 EST} + {3540178800 -14400 1 EDT} + {3560738400 -18000 0 EST} + {3572233200 -14400 1 EDT} + {3592792800 -18000 0 EST} + {3603682800 -14400 1 EDT} + {3624242400 -18000 0 EST} + {3635132400 -14400 1 EDT} + {3655692000 -18000 0 EST} + {3666582000 -14400 1 EDT} + {3687141600 -18000 0 EST} + {3698031600 -14400 1 EDT} + {3718591200 -18000 0 EST} + {3730086000 -14400 1 EDT} + {3750645600 -18000 0 EST} + {3761535600 -14400 1 EDT} + {3782095200 -18000 0 EST} + {3792985200 -14400 1 EDT} + {3813544800 -18000 0 EST} + {3824434800 -14400 1 EDT} + {3844994400 -18000 0 EST} + {3855884400 -14400 1 EDT} + {3876444000 -18000 0 EST} + {3887334000 -14400 1 EDT} + {3907893600 -18000 0 EST} + {3919388400 -14400 1 EDT} + {3939948000 -18000 0 EST} + {3950838000 -14400 1 EDT} + {3971397600 -18000 0 EST} + {3982287600 -14400 1 EDT} + {4002847200 -18000 0 EST} + {4013737200 -14400 1 EDT} + {4034296800 -18000 0 EST} + {4045186800 -14400 1 EDT} + {4065746400 -18000 0 EST} + {4076636400 -14400 1 EDT} + {4097196000 -18000 0 EST} } diff --git a/library/tzdata/America/Port-au-Prince b/library/tzdata/America/Port-au-Prince index aaba8c9..04ee62c 100644 --- a/library/tzdata/America/Port-au-Prince +++ b/library/tzdata/America/Port-au-Prince @@ -38,190 +38,4 @@ set TZData(:America/Port-au-Prince) { {1130644800 -18000 0 EST} {1143954000 -14400 1 EDT} {1162094400 -18000 0 EST} - {1175403600 -14400 1 EDT} - {1193544000 -18000 0 EST} - {1207458000 -14400 1 EDT} - {1224993600 -18000 0 EST} - {1238907600 -14400 1 EDT} - {1256443200 -18000 0 EST} - {1270357200 -14400 1 EDT} - {1288497600 -18000 0 EST} - {1301806800 -14400 1 EDT} - {1319947200 -18000 0 EST} - {1333256400 -14400 1 EDT} - {1351396800 -18000 0 EST} - {1365310800 -14400 1 EDT} - {1382846400 -18000 0 EST} - {1396760400 -14400 1 EDT} - {1414296000 -18000 0 EST} - {1428210000 -14400 1 EDT} - {1445745600 -18000 0 EST} - {1459659600 -14400 1 EDT} - {1477800000 -18000 0 EST} - {1491109200 -14400 1 EDT} - {1509249600 -18000 0 EST} - {1522558800 -14400 1 EDT} - {1540699200 -18000 0 EST} - {1554613200 -14400 1 EDT} - {1572148800 -18000 0 EST} - {1586062800 -14400 1 EDT} - {1603598400 -18000 0 EST} - {1617512400 -14400 1 EDT} - {1635652800 -18000 0 EST} - {1648962000 -14400 1 EDT} - {1667102400 -18000 0 EST} - {1680411600 -14400 1 EDT} - {1698552000 -18000 0 EST} - {1712466000 -14400 1 EDT} - {1730001600 -18000 0 EST} - {1743915600 -14400 1 EDT} - {1761451200 -18000 0 EST} - {1775365200 -14400 1 EDT} - {1792900800 -18000 0 EST} - {1806814800 -14400 1 EDT} - {1824955200 -18000 0 EST} - {1838264400 -14400 1 EDT} - {1856404800 -18000 0 EST} - {1869714000 -14400 1 EDT} - {1887854400 -18000 0 EST} - {1901768400 -14400 1 EDT} - {1919304000 -18000 0 EST} - {1933218000 -14400 1 EDT} - {1950753600 -18000 0 EST} - {1964667600 -14400 1 EDT} - {1982808000 -18000 0 EST} - {1996117200 -14400 1 EDT} - {2014257600 -18000 0 EST} - {2027566800 -14400 1 EDT} - {2045707200 -18000 0 EST} - {2059016400 -14400 1 EDT} - {2077156800 -18000 0 EST} - {2091070800 -14400 1 EDT} - {2108606400 -18000 0 EST} - {2122520400 -14400 1 EDT} - {2140056000 -18000 0 EST} - {2153970000 -14400 1 EDT} - {2172110400 -18000 0 EST} - {2185419600 -14400 1 EDT} - {2203560000 -18000 0 EST} - {2216869200 -14400 1 EDT} - {2235009600 -18000 0 EST} - {2248923600 -14400 1 EDT} - {2266459200 -18000 0 EST} - {2280373200 -14400 1 EDT} - {2297908800 -18000 0 EST} - {2311822800 -14400 1 EDT} - {2329358400 -18000 0 EST} - {2343272400 -14400 1 EDT} - {2361412800 -18000 0 EST} - {2374722000 -14400 1 EDT} - {2392862400 -18000 0 EST} - {2406171600 -14400 1 EDT} - {2424312000 -18000 0 EST} - {2438226000 -14400 1 EDT} - {2455761600 -18000 0 EST} - {2469675600 -14400 1 EDT} - {2487211200 -18000 0 EST} - {2501125200 -14400 1 EDT} - {2519265600 -18000 0 EST} - {2532574800 -14400 1 EDT} - {2550715200 -18000 0 EST} - {2564024400 -14400 1 EDT} - {2582164800 -18000 0 EST} - {2596078800 -14400 1 EDT} - {2613614400 -18000 0 EST} - {2627528400 -14400 1 EDT} - {2645064000 -18000 0 EST} - {2658978000 -14400 1 EDT} - {2676513600 -18000 0 EST} - {2690427600 -14400 1 EDT} - {2708568000 -18000 0 EST} - {2721877200 -14400 1 EDT} - {2740017600 -18000 0 EST} - {2753326800 -14400 1 EDT} - {2771467200 -18000 0 EST} - {2785381200 -14400 1 EDT} - {2802916800 -18000 0 EST} - {2816830800 -14400 1 EDT} - {2834366400 -18000 0 EST} - {2848280400 -14400 1 EDT} - {2866420800 -18000 0 EST} - {2879730000 -14400 1 EDT} - {2897870400 -18000 0 EST} - {2911179600 -14400 1 EDT} - {2929320000 -18000 0 EST} - {2942629200 -14400 1 EDT} - {2960769600 -18000 0 EST} - {2974683600 -14400 1 EDT} - {2992219200 -18000 0 EST} - {3006133200 -14400 1 EDT} - {3023668800 -18000 0 EST} - {3037582800 -14400 1 EDT} - {3055723200 -18000 0 EST} - {3069032400 -14400 1 EDT} - {3087172800 -18000 0 EST} - {3100482000 -14400 1 EDT} - {3118622400 -18000 0 EST} - {3132536400 -14400 1 EDT} - {3150072000 -18000 0 EST} - {3163986000 -14400 1 EDT} - {3181521600 -18000 0 EST} - {3195435600 -14400 1 EDT} - {3212971200 -18000 0 EST} - {3226885200 -14400 1 EDT} - {3245025600 -18000 0 EST} - {3258334800 -14400 1 EDT} - {3276475200 -18000 0 EST} - {3289784400 -14400 1 EDT} - {3307924800 -18000 0 EST} - {3321838800 -14400 1 EDT} - {3339374400 -18000 0 EST} - {3353288400 -14400 1 EDT} - {3370824000 -18000 0 EST} - {3384738000 -14400 1 EDT} - {3402878400 -18000 0 EST} - {3416187600 -14400 1 EDT} - {3434328000 -18000 0 EST} - {3447637200 -14400 1 EDT} - {3465777600 -18000 0 EST} - {3479691600 -14400 1 EDT} - {3497227200 -18000 0 EST} - {3511141200 -14400 1 EDT} - {3528676800 -18000 0 EST} - {3542590800 -14400 1 EDT} - {3560126400 -18000 0 EST} - {3574040400 -14400 1 EDT} - {3592180800 -18000 0 EST} - {3605490000 -14400 1 EDT} - {3623630400 -18000 0 EST} - {3636939600 -14400 1 EDT} - {3655080000 -18000 0 EST} - {3668994000 -14400 1 EDT} - {3686529600 -18000 0 EST} - {3700443600 -14400 1 EDT} - {3717979200 -18000 0 EST} - {3731893200 -14400 1 EDT} - {3750033600 -18000 0 EST} - {3763342800 -14400 1 EDT} - {3781483200 -18000 0 EST} - {3794792400 -14400 1 EDT} - {3812932800 -18000 0 EST} - {3826242000 -14400 1 EDT} - {3844382400 -18000 0 EST} - {3858296400 -14400 1 EDT} - {3875832000 -18000 0 EST} - {3889746000 -14400 1 EDT} - {3907281600 -18000 0 EST} - {3921195600 -14400 1 EDT} - {3939336000 -18000 0 EST} - {3952645200 -14400 1 EDT} - {3970785600 -18000 0 EST} - {3984094800 -14400 1 EDT} - {4002235200 -18000 0 EST} - {4016149200 -14400 1 EDT} - {4033684800 -18000 0 EST} - {4047598800 -14400 1 EDT} - {4065134400 -18000 0 EST} - {4079048400 -14400 1 EDT} - {4096584000 -18000 0 EST} } diff --git a/library/tzdata/Antarctica/McMurdo b/library/tzdata/Antarctica/McMurdo index e9a3bf9..670f7eb 100644 --- a/library/tzdata/Antarctica/McMurdo +++ b/library/tzdata/Antarctica/McMurdo @@ -69,189 +69,189 @@ set TZData(:Antarctica/McMurdo) { {1142690400 43200 0 NZST} {1159624800 46800 1 NZDT} {1174140000 43200 0 NZST} - {1191679200 46800 1 NZDT} - {1205589600 43200 0 NZST} - {1223128800 46800 1 NZDT} - {1237039200 43200 0 NZST} - {1254578400 46800 1 NZDT} - {1269093600 43200 0 NZST} - {1286028000 46800 1 NZDT} - {1300543200 43200 0 NZST} - {1317477600 46800 1 NZDT} - {1331992800 43200 0 NZST} - {1349532000 46800 1 NZDT} - {1363442400 43200 0 NZST} - {1380981600 46800 1 NZDT} - {1394892000 43200 0 NZST} - {1412431200 46800 1 NZDT} - {1426341600 43200 0 NZST} - {1443880800 46800 1 NZDT} - {1458396000 43200 0 NZST} - {1475330400 46800 1 NZDT} - {1489845600 43200 0 NZST} - {1506780000 46800 1 NZDT} - {1521295200 43200 0 NZST} - {1538834400 46800 1 NZDT} - {1552744800 43200 0 NZST} - {1570284000 46800 1 NZDT} - {1584194400 43200 0 NZST} - {1601733600 46800 1 NZDT} - {1616248800 43200 0 NZST} - {1633183200 46800 1 NZDT} - {1647698400 43200 0 NZST} - {1664632800 46800 1 NZDT} - {1679148000 43200 0 NZST} - {1696082400 46800 1 NZDT} - {1710597600 43200 0 NZST} - {1728136800 46800 1 NZDT} - {1742047200 43200 0 NZST} - {1759586400 46800 1 NZDT} - {1773496800 43200 0 NZST} - {1791036000 46800 1 NZDT} - {1805551200 43200 0 NZST} - {1822485600 46800 1 NZDT} - {1837000800 43200 0 NZST} - {1853935200 46800 1 NZDT} - {1868450400 43200 0 NZST} - {1885989600 46800 1 NZDT} - {1899900000 43200 0 NZST} - {1917439200 46800 1 NZDT} - {1931349600 43200 0 NZST} - {1948888800 46800 1 NZDT} - {1963404000 43200 0 NZST} - {1980338400 46800 1 NZDT} - {1994853600 43200 0 NZST} - {2011788000 46800 1 NZDT} - {2026303200 43200 0 NZST} - {2043237600 46800 1 NZDT} - {2057752800 43200 0 NZST} - {2075292000 46800 1 NZDT} - {2089202400 43200 0 NZST} - {2106741600 46800 1 NZDT} - {2120652000 43200 0 NZST} - {2138191200 46800 1 NZDT} - {2152706400 43200 0 NZST} - {2169640800 46800 1 NZDT} - {2184156000 43200 0 NZST} - {2201090400 46800 1 NZDT} - {2215605600 43200 0 NZST} - {2233144800 46800 1 NZDT} - {2247055200 43200 0 NZST} - {2264594400 46800 1 NZDT} - {2278504800 43200 0 NZST} - {2296044000 46800 1 NZDT} - {2309954400 43200 0 NZST} - {2327493600 46800 1 NZDT} - {2342008800 43200 0 NZST} - {2358943200 46800 1 NZDT} - {2373458400 43200 0 NZST} - {2390392800 46800 1 NZDT} - {2404908000 43200 0 NZST} - {2422447200 46800 1 NZDT} - {2436357600 43200 0 NZST} - {2453896800 46800 1 NZDT} - {2467807200 43200 0 NZST} - {2485346400 46800 1 NZDT} - {2499861600 43200 0 NZST} - {2516796000 46800 1 NZDT} - {2531311200 43200 0 NZST} - {2548245600 46800 1 NZDT} - {2562760800 43200 0 NZST} - {2579695200 46800 1 NZDT} - {2594210400 43200 0 NZST} - {2611749600 46800 1 NZDT} - {2625660000 43200 0 NZST} - {2643199200 46800 1 NZDT} - {2657109600 43200 0 NZST} - {2674648800 46800 1 NZDT} - {2689164000 43200 0 NZST} - {2706098400 46800 1 NZDT} - {2720613600 43200 0 NZST} - {2737548000 46800 1 NZDT} - {2752063200 43200 0 NZST} - {2769602400 46800 1 NZDT} - {2783512800 43200 0 NZST} - {2801052000 46800 1 NZDT} - {2814962400 43200 0 NZST} - {2832501600 46800 1 NZDT} - {2847016800 43200 0 NZST} - {2863951200 46800 1 NZDT} - {2878466400 43200 0 NZST} - {2895400800 46800 1 NZDT} - {2909916000 43200 0 NZST} - {2926850400 46800 1 NZDT} - {2941365600 43200 0 NZST} - {2958904800 46800 1 NZDT} - {2972815200 43200 0 NZST} - {2990354400 46800 1 NZDT} - {3004264800 43200 0 NZST} - {3021804000 46800 1 NZDT} - {3036319200 43200 0 NZST} - {3053253600 46800 1 NZDT} - {3067768800 43200 0 NZST} - {3084703200 46800 1 NZDT} - {3099218400 43200 0 NZST} - {3116757600 46800 1 NZDT} - {3130668000 43200 0 NZST} - {3148207200 46800 1 NZDT} - {3162117600 43200 0 NZST} - {3179656800 46800 1 NZDT} - {3193567200 43200 0 NZST} - {3211106400 46800 1 NZDT} - {3225621600 43200 0 NZST} - {3242556000 46800 1 NZDT} - {3257071200 43200 0 NZST} - {3274005600 46800 1 NZDT} - {3288520800 43200 0 NZST} - {3306060000 46800 1 NZDT} - {3319970400 43200 0 NZST} - {3337509600 46800 1 NZDT} - {3351420000 43200 0 NZST} - {3368959200 46800 1 NZDT} - {3383474400 43200 0 NZST} - {3400408800 46800 1 NZDT} - {3414924000 43200 0 NZST} - {3431858400 46800 1 NZDT} - {3446373600 43200 0 NZST} - {3463308000 46800 1 NZDT} - {3477823200 43200 0 NZST} - {3495362400 46800 1 NZDT} - {3509272800 43200 0 NZST} - {3526812000 46800 1 NZDT} - {3540722400 43200 0 NZST} - {3558261600 46800 1 NZDT} - {3572776800 43200 0 NZST} - {3589711200 46800 1 NZDT} - {3604226400 43200 0 NZST} - {3621160800 46800 1 NZDT} - {3635676000 43200 0 NZST} - {3653215200 46800 1 NZDT} - {3667125600 43200 0 NZST} - {3684664800 46800 1 NZDT} - {3698575200 43200 0 NZST} - {3716114400 46800 1 NZDT} - {3730629600 43200 0 NZST} - {3747564000 46800 1 NZDT} - {3762079200 43200 0 NZST} - {3779013600 46800 1 NZDT} - {3793528800 43200 0 NZST} - {3810463200 46800 1 NZDT} - {3824978400 43200 0 NZST} - {3842517600 46800 1 NZDT} - {3856428000 43200 0 NZST} - {3873967200 46800 1 NZDT} - {3887877600 43200 0 NZST} - {3905416800 46800 1 NZDT} - {3919932000 43200 0 NZST} - {3936866400 46800 1 NZDT} - {3951381600 43200 0 NZST} - {3968316000 46800 1 NZDT} - {3982831200 43200 0 NZST} - {4000370400 46800 1 NZDT} - {4014280800 43200 0 NZST} - {4031820000 46800 1 NZDT} - {4045730400 43200 0 NZST} - {4063269600 46800 1 NZDT} - {4077180000 43200 0 NZST} - {4094719200 46800 1 NZDT} + {1191074400 46800 1 NZDT} + {1207404000 43200 0 NZST} + {1222524000 46800 1 NZDT} + {1238853600 43200 0 NZST} + {1253973600 46800 1 NZDT} + {1270303200 43200 0 NZST} + {1285423200 46800 1 NZDT} + {1301752800 43200 0 NZST} + {1316872800 46800 1 NZDT} + {1333202400 43200 0 NZST} + {1348927200 46800 1 NZDT} + {1365256800 43200 0 NZST} + {1380376800 46800 1 NZDT} + {1396706400 43200 0 NZST} + {1411826400 46800 1 NZDT} + {1428156000 43200 0 NZST} + {1443276000 46800 1 NZDT} + {1459605600 43200 0 NZST} + {1474725600 46800 1 NZDT} + {1491055200 43200 0 NZST} + {1506175200 46800 1 NZDT} + {1522504800 43200 0 NZST} + {1538229600 46800 1 NZDT} + {1554559200 43200 0 NZST} + {1569679200 46800 1 NZDT} + {1586008800 43200 0 NZST} + {1601128800 46800 1 NZDT} + {1617458400 43200 0 NZST} + {1632578400 46800 1 NZDT} + {1648908000 43200 0 NZST} + {1664028000 46800 1 NZDT} + {1680357600 43200 0 NZST} + {1695477600 46800 1 NZDT} + {1712412000 43200 0 NZST} + {1727532000 46800 1 NZDT} + {1743861600 43200 0 NZST} + {1758981600 46800 1 NZDT} + {1775311200 43200 0 NZST} + {1790431200 46800 1 NZDT} + {1806760800 43200 0 NZST} + {1821880800 46800 1 NZDT} + {1838210400 43200 0 NZST} + {1853330400 46800 1 NZDT} + {1869660000 43200 0 NZST} + {1885384800 46800 1 NZDT} + {1901714400 43200 0 NZST} + {1916834400 46800 1 NZDT} + {1933164000 43200 0 NZST} + {1948284000 46800 1 NZDT} + {1964613600 43200 0 NZST} + {1979733600 46800 1 NZDT} + {1996063200 43200 0 NZST} + {2011183200 46800 1 NZDT} + {2027512800 43200 0 NZST} + {2042632800 46800 1 NZDT} + {2058962400 43200 0 NZST} + {2074687200 46800 1 NZDT} + {2091016800 43200 0 NZST} + {2106136800 46800 1 NZDT} + {2122466400 43200 0 NZST} + {2137586400 46800 1 NZDT} + {2153916000 43200 0 NZST} + {2169036000 46800 1 NZDT} + {2185365600 43200 0 NZST} + {2200485600 46800 1 NZDT} + {2216815200 43200 0 NZST} + {2232540000 46800 1 NZDT} + {2248869600 43200 0 NZST} + {2263989600 46800 1 NZDT} + {2280319200 43200 0 NZST} + {2295439200 46800 1 NZDT} + {2311768800 43200 0 NZST} + {2326888800 46800 1 NZDT} + {2343218400 43200 0 NZST} + {2358338400 46800 1 NZDT} + {2374668000 43200 0 NZST} + {2389788000 46800 1 NZDT} + {2406117600 43200 0 NZST} + {2421842400 46800 1 NZDT} + {2438172000 43200 0 NZST} + {2453292000 46800 1 NZDT} + {2469621600 43200 0 NZST} + {2484741600 46800 1 NZDT} + {2501071200 43200 0 NZST} + {2516191200 46800 1 NZDT} + {2532520800 43200 0 NZST} + {2547640800 46800 1 NZDT} + {2563970400 43200 0 NZST} + {2579090400 46800 1 NZDT} + {2596024800 43200 0 NZST} + {2611144800 46800 1 NZDT} + {2627474400 43200 0 NZST} + {2642594400 46800 1 NZDT} + {2658924000 43200 0 NZST} + {2674044000 46800 1 NZDT} + {2690373600 43200 0 NZST} + {2705493600 46800 1 NZDT} + {2721823200 43200 0 NZST} + {2736943200 46800 1 NZDT} + {2753272800 43200 0 NZST} + {2768997600 46800 1 NZDT} + {2785327200 43200 0 NZST} + {2800447200 46800 1 NZDT} + {2816776800 43200 0 NZST} + {2831896800 46800 1 NZDT} + {2848226400 43200 0 NZST} + {2863346400 46800 1 NZDT} + {2879676000 43200 0 NZST} + {2894796000 46800 1 NZDT} + {2911125600 43200 0 NZST} + {2926245600 46800 1 NZDT} + {2942575200 43200 0 NZST} + {2958300000 46800 1 NZDT} + {2974629600 43200 0 NZST} + {2989749600 46800 1 NZDT} + {3006079200 43200 0 NZST} + {3021199200 46800 1 NZDT} + {3037528800 43200 0 NZST} + {3052648800 46800 1 NZDT} + {3068978400 43200 0 NZST} + {3084098400 46800 1 NZDT} + {3100428000 43200 0 NZST} + {3116152800 46800 1 NZDT} + {3132482400 43200 0 NZST} + {3147602400 46800 1 NZDT} + {3163932000 43200 0 NZST} + {3179052000 46800 1 NZDT} + {3195381600 43200 0 NZST} + {3210501600 46800 1 NZDT} + {3226831200 43200 0 NZST} + {3241951200 46800 1 NZDT} + {3258280800 43200 0 NZST} + {3273400800 46800 1 NZDT} + {3289730400 43200 0 NZST} + {3305455200 46800 1 NZDT} + {3321784800 43200 0 NZST} + {3336904800 46800 1 NZDT} + {3353234400 43200 0 NZST} + {3368354400 46800 1 NZDT} + {3384684000 43200 0 NZST} + {3399804000 46800 1 NZDT} + {3416133600 43200 0 NZST} + {3431253600 46800 1 NZDT} + {3447583200 43200 0 NZST} + {3462703200 46800 1 NZDT} + {3479637600 43200 0 NZST} + {3494757600 46800 1 NZDT} + {3511087200 43200 0 NZST} + {3526207200 46800 1 NZDT} + {3542536800 43200 0 NZST} + {3557656800 46800 1 NZDT} + {3573986400 43200 0 NZST} + {3589106400 46800 1 NZDT} + {3605436000 43200 0 NZST} + {3620556000 46800 1 NZDT} + {3636885600 43200 0 NZST} + {3652610400 46800 1 NZDT} + {3668940000 43200 0 NZST} + {3684060000 46800 1 NZDT} + {3700389600 43200 0 NZST} + {3715509600 46800 1 NZDT} + {3731839200 43200 0 NZST} + {3746959200 46800 1 NZDT} + {3763288800 43200 0 NZST} + {3778408800 46800 1 NZDT} + {3794738400 43200 0 NZST} + {3809858400 46800 1 NZDT} + {3826188000 43200 0 NZST} + {3841912800 46800 1 NZDT} + {3858242400 43200 0 NZST} + {3873362400 46800 1 NZDT} + {3889692000 43200 0 NZST} + {3904812000 46800 1 NZDT} + {3921141600 43200 0 NZST} + {3936261600 46800 1 NZDT} + {3952591200 43200 0 NZST} + {3967711200 46800 1 NZDT} + {3984040800 43200 0 NZST} + {3999765600 46800 1 NZDT} + {4016095200 43200 0 NZST} + {4031215200 46800 1 NZDT} + {4047544800 43200 0 NZST} + {4062664800 46800 1 NZDT} + {4078994400 43200 0 NZST} + {4094114400 46800 1 NZDT} } diff --git a/library/tzdata/Australia/Adelaide b/library/tzdata/Australia/Adelaide index 02511e6..9abe192 100644 --- a/library/tzdata/Australia/Adelaide +++ b/library/tzdata/Australia/Adelaide @@ -86,188 +86,188 @@ set TZData(:Australia/Adelaide) { {1162053000 37800 1 CST} {1174753800 34200 0 CST} {1193502600 37800 1 CST} - {1206808200 34200 0 CST} - {1224952200 37800 1 CST} - {1238257800 34200 0 CST} - {1256401800 37800 1 CST} - {1269707400 34200 0 CST} - {1288456200 37800 1 CST} - {1301157000 34200 0 CST} - {1319905800 37800 1 CST} - {1332606600 34200 0 CST} - {1351355400 37800 1 CST} - {1364661000 34200 0 CST} - {1382805000 37800 1 CST} - {1396110600 34200 0 CST} - {1414254600 37800 1 CST} - {1427560200 34200 0 CST} - {1445704200 37800 1 CST} - {1459009800 34200 0 CST} - {1477758600 37800 1 CST} - {1490459400 34200 0 CST} - {1509208200 37800 1 CST} - {1521909000 34200 0 CST} - {1540657800 37800 1 CST} - {1553963400 34200 0 CST} - {1572107400 37800 1 CST} - {1585413000 34200 0 CST} - {1603557000 37800 1 CST} - {1616862600 34200 0 CST} - {1635611400 37800 1 CST} - {1648312200 34200 0 CST} - {1667061000 37800 1 CST} - {1679761800 34200 0 CST} - {1698510600 37800 1 CST} - {1711816200 34200 0 CST} - {1729960200 37800 1 CST} - {1743265800 34200 0 CST} - {1761409800 37800 1 CST} - {1774715400 34200 0 CST} - {1792859400 37800 1 CST} - {1806165000 34200 0 CST} - {1824913800 37800 1 CST} - {1837614600 34200 0 CST} - {1856363400 37800 1 CST} - {1869064200 34200 0 CST} - {1887813000 37800 1 CST} - {1901118600 34200 0 CST} - {1919262600 37800 1 CST} - {1932568200 34200 0 CST} - {1950712200 37800 1 CST} - {1964017800 34200 0 CST} - {1982766600 37800 1 CST} - {1995467400 34200 0 CST} - {2014216200 37800 1 CST} - {2026917000 34200 0 CST} - {2045665800 37800 1 CST} - {2058366600 34200 0 CST} - {2077115400 37800 1 CST} - {2090421000 34200 0 CST} - {2108565000 37800 1 CST} - {2121870600 34200 0 CST} - {2140014600 37800 1 CST} - {2153320200 34200 0 CST} - {2172069000 37800 1 CST} - {2184769800 34200 0 CST} - {2203518600 37800 1 CST} - {2216219400 34200 0 CST} - {2234968200 37800 1 CST} - {2248273800 34200 0 CST} - {2266417800 37800 1 CST} - {2279723400 34200 0 CST} - {2297867400 37800 1 CST} - {2311173000 34200 0 CST} - {2329317000 37800 1 CST} - {2342622600 34200 0 CST} - {2361371400 37800 1 CST} - {2374072200 34200 0 CST} - {2392821000 37800 1 CST} - {2405521800 34200 0 CST} - {2424270600 37800 1 CST} - {2437576200 34200 0 CST} - {2455720200 37800 1 CST} - {2469025800 34200 0 CST} - {2487169800 37800 1 CST} - {2500475400 34200 0 CST} - {2519224200 37800 1 CST} - {2531925000 34200 0 CST} - {2550673800 37800 1 CST} - {2563374600 34200 0 CST} - {2582123400 37800 1 CST} - {2595429000 34200 0 CST} - {2613573000 37800 1 CST} - {2626878600 34200 0 CST} - {2645022600 37800 1 CST} - {2658328200 34200 0 CST} - {2676472200 37800 1 CST} - {2689777800 34200 0 CST} - {2708526600 37800 1 CST} - {2721227400 34200 0 CST} - {2739976200 37800 1 CST} - {2752677000 34200 0 CST} - {2771425800 37800 1 CST} - {2784731400 34200 0 CST} - {2802875400 37800 1 CST} - {2816181000 34200 0 CST} - {2834325000 37800 1 CST} - {2847630600 34200 0 CST} - {2866379400 37800 1 CST} - {2879080200 34200 0 CST} - {2897829000 37800 1 CST} - {2910529800 34200 0 CST} - {2929278600 37800 1 CST} - {2941979400 34200 0 CST} - {2960728200 37800 1 CST} - {2974033800 34200 0 CST} - {2992177800 37800 1 CST} - {3005483400 34200 0 CST} - {3023627400 37800 1 CST} - {3036933000 34200 0 CST} - {3055681800 37800 1 CST} - {3068382600 34200 0 CST} - {3087131400 37800 1 CST} - {3099832200 34200 0 CST} - {3118581000 37800 1 CST} - {3131886600 34200 0 CST} - {3150030600 37800 1 CST} - {3163336200 34200 0 CST} - {3181480200 37800 1 CST} - {3194785800 34200 0 CST} - {3212929800 37800 1 CST} - {3226235400 34200 0 CST} - {3244984200 37800 1 CST} - {3257685000 34200 0 CST} - {3276433800 37800 1 CST} - {3289134600 34200 0 CST} - {3307883400 37800 1 CST} - {3321189000 34200 0 CST} - {3339333000 37800 1 CST} - {3352638600 34200 0 CST} - {3370782600 37800 1 CST} - {3384088200 34200 0 CST} - {3402837000 37800 1 CST} - {3415537800 34200 0 CST} - {3434286600 37800 1 CST} - {3446987400 34200 0 CST} - {3465736200 37800 1 CST} - {3479041800 34200 0 CST} - {3497185800 37800 1 CST} - {3510491400 34200 0 CST} - {3528635400 37800 1 CST} - {3541941000 34200 0 CST} - {3560085000 37800 1 CST} - {3573390600 34200 0 CST} - {3592139400 37800 1 CST} - {3604840200 34200 0 CST} - {3623589000 37800 1 CST} - {3636289800 34200 0 CST} - {3655038600 37800 1 CST} - {3668344200 34200 0 CST} - {3686488200 37800 1 CST} - {3699793800 34200 0 CST} - {3717937800 37800 1 CST} - {3731243400 34200 0 CST} - {3749992200 37800 1 CST} - {3762693000 34200 0 CST} - {3781441800 37800 1 CST} - {3794142600 34200 0 CST} - {3812891400 37800 1 CST} - {3825592200 34200 0 CST} - {3844341000 37800 1 CST} - {3857646600 34200 0 CST} - {3875790600 37800 1 CST} - {3889096200 34200 0 CST} - {3907240200 37800 1 CST} - {3920545800 34200 0 CST} - {3939294600 37800 1 CST} - {3951995400 34200 0 CST} - {3970744200 37800 1 CST} - {3983445000 34200 0 CST} - {4002193800 37800 1 CST} - {4015499400 34200 0 CST} - {4033643400 37800 1 CST} - {4046949000 34200 0 CST} - {4065093000 37800 1 CST} - {4078398600 34200 0 CST} - {4096542600 37800 1 CST} + {1207413000 34200 0 CST} + {1223137800 37800 1 CST} + {1238862600 34200 0 CST} + {1254587400 37800 1 CST} + {1270312200 34200 0 CST} + {1286037000 37800 1 CST} + {1301761800 34200 0 CST} + {1317486600 37800 1 CST} + {1333211400 34200 0 CST} + {1349541000 37800 1 CST} + {1365265800 34200 0 CST} + {1380990600 37800 1 CST} + {1396715400 34200 0 CST} + {1412440200 37800 1 CST} + {1428165000 34200 0 CST} + {1443889800 37800 1 CST} + {1459614600 34200 0 CST} + {1475339400 37800 1 CST} + {1491064200 34200 0 CST} + {1506789000 37800 1 CST} + {1522513800 34200 0 CST} + {1538843400 37800 1 CST} + {1554568200 34200 0 CST} + {1570293000 37800 1 CST} + {1586017800 34200 0 CST} + {1601742600 37800 1 CST} + {1617467400 34200 0 CST} + {1633192200 37800 1 CST} + {1648917000 34200 0 CST} + {1664641800 37800 1 CST} + {1680366600 34200 0 CST} + {1696091400 37800 1 CST} + {1712421000 34200 0 CST} + {1728145800 37800 1 CST} + {1743870600 34200 0 CST} + {1759595400 37800 1 CST} + {1775320200 34200 0 CST} + {1791045000 37800 1 CST} + {1806769800 34200 0 CST} + {1822494600 37800 1 CST} + {1838219400 34200 0 CST} + {1853944200 37800 1 CST} + {1869669000 34200 0 CST} + {1885998600 37800 1 CST} + {1901723400 34200 0 CST} + {1917448200 37800 1 CST} + {1933173000 34200 0 CST} + {1948897800 37800 1 CST} + {1964622600 34200 0 CST} + {1980347400 37800 1 CST} + {1996072200 34200 0 CST} + {2011797000 37800 1 CST} + {2027521800 34200 0 CST} + {2043246600 37800 1 CST} + {2058971400 34200 0 CST} + {2075301000 37800 1 CST} + {2091025800 34200 0 CST} + {2106750600 37800 1 CST} + {2122475400 34200 0 CST} + {2138200200 37800 1 CST} + {2153925000 34200 0 CST} + {2169649800 37800 1 CST} + {2185374600 34200 0 CST} + {2201099400 37800 1 CST} + {2216824200 34200 0 CST} + {2233153800 37800 1 CST} + {2248878600 34200 0 CST} + {2264603400 37800 1 CST} + {2280328200 34200 0 CST} + {2296053000 37800 1 CST} + {2311777800 34200 0 CST} + {2327502600 37800 1 CST} + {2343227400 34200 0 CST} + {2358952200 37800 1 CST} + {2374677000 34200 0 CST} + {2390401800 37800 1 CST} + {2406126600 34200 0 CST} + {2422456200 37800 1 CST} + {2438181000 34200 0 CST} + {2453905800 37800 1 CST} + {2469630600 34200 0 CST} + {2485355400 37800 1 CST} + {2501080200 34200 0 CST} + {2516805000 37800 1 CST} + {2532529800 34200 0 CST} + {2548254600 37800 1 CST} + {2563979400 34200 0 CST} + {2579704200 37800 1 CST} + {2596033800 34200 0 CST} + {2611758600 37800 1 CST} + {2627483400 34200 0 CST} + {2643208200 37800 1 CST} + {2658933000 34200 0 CST} + {2674657800 37800 1 CST} + {2690382600 34200 0 CST} + {2706107400 37800 1 CST} + {2721832200 34200 0 CST} + {2737557000 37800 1 CST} + {2753281800 34200 0 CST} + {2769611400 37800 1 CST} + {2785336200 34200 0 CST} + {2801061000 37800 1 CST} + {2816785800 34200 0 CST} + {2832510600 37800 1 CST} + {2848235400 34200 0 CST} + {2863960200 37800 1 CST} + {2879685000 34200 0 CST} + {2895409800 37800 1 CST} + {2911134600 34200 0 CST} + {2926859400 37800 1 CST} + {2942584200 34200 0 CST} + {2958913800 37800 1 CST} + {2974638600 34200 0 CST} + {2990363400 37800 1 CST} + {3006088200 34200 0 CST} + {3021813000 37800 1 CST} + {3037537800 34200 0 CST} + {3053262600 37800 1 CST} + {3068987400 34200 0 CST} + {3084712200 37800 1 CST} + {3100437000 34200 0 CST} + {3116766600 37800 1 CST} + {3132491400 34200 0 CST} + {3148216200 37800 1 CST} + {3163941000 34200 0 CST} + {3179665800 37800 1 CST} + {3195390600 34200 0 CST} + {3211115400 37800 1 CST} + {3226840200 34200 0 CST} + {3242565000 37800 1 CST} + {3258289800 34200 0 CST} + {3274014600 37800 1 CST} + {3289739400 34200 0 CST} + {3306069000 37800 1 CST} + {3321793800 34200 0 CST} + {3337518600 37800 1 CST} + {3353243400 34200 0 CST} + {3368968200 37800 1 CST} + {3384693000 34200 0 CST} + {3400417800 37800 1 CST} + {3416142600 34200 0 CST} + {3431867400 37800 1 CST} + {3447592200 34200 0 CST} + {3463317000 37800 1 CST} + {3479646600 34200 0 CST} + {3495371400 37800 1 CST} + {3511096200 34200 0 CST} + {3526821000 37800 1 CST} + {3542545800 34200 0 CST} + {3558270600 37800 1 CST} + {3573995400 34200 0 CST} + {3589720200 37800 1 CST} + {3605445000 34200 0 CST} + {3621169800 37800 1 CST} + {3636894600 34200 0 CST} + {3653224200 37800 1 CST} + {3668949000 34200 0 CST} + {3684673800 37800 1 CST} + {3700398600 34200 0 CST} + {3716123400 37800 1 CST} + {3731848200 34200 0 CST} + {3747573000 37800 1 CST} + {3763297800 34200 0 CST} + {3779022600 37800 1 CST} + {3794747400 34200 0 CST} + {3810472200 37800 1 CST} + {3826197000 34200 0 CST} + {3842526600 37800 1 CST} + {3858251400 34200 0 CST} + {3873976200 37800 1 CST} + {3889701000 34200 0 CST} + {3905425800 37800 1 CST} + {3921150600 34200 0 CST} + {3936875400 37800 1 CST} + {3952600200 34200 0 CST} + {3968325000 37800 1 CST} + {3984049800 34200 0 CST} + {4000379400 37800 1 CST} + {4016104200 34200 0 CST} + {4031829000 37800 1 CST} + {4047553800 34200 0 CST} + {4063278600 37800 1 CST} + {4079003400 34200 0 CST} + {4094728200 37800 1 CST} } diff --git a/library/tzdata/Australia/Broken_Hill b/library/tzdata/Australia/Broken_Hill index fa39b3f..35cbb7e 100644 --- a/library/tzdata/Australia/Broken_Hill +++ b/library/tzdata/Australia/Broken_Hill @@ -88,188 +88,188 @@ set TZData(:Australia/Broken_Hill) { {1162053000 37800 1 CST} {1174753800 34200 0 CST} {1193502600 37800 1 CST} - {1206808200 34200 0 CST} - {1224952200 37800 1 CST} - {1238257800 34200 0 CST} - {1256401800 37800 1 CST} - {1269707400 34200 0 CST} - {1288456200 37800 1 CST} - {1301157000 34200 0 CST} - {1319905800 37800 1 CST} - {1332606600 34200 0 CST} - {1351355400 37800 1 CST} - {1364661000 34200 0 CST} - {1382805000 37800 1 CST} - {1396110600 34200 0 CST} - {1414254600 37800 1 CST} - {1427560200 34200 0 CST} - {1445704200 37800 1 CST} - {1459009800 34200 0 CST} - {1477758600 37800 1 CST} - {1490459400 34200 0 CST} - {1509208200 37800 1 CST} - {1521909000 34200 0 CST} - {1540657800 37800 1 CST} - {1553963400 34200 0 CST} - {1572107400 37800 1 CST} - {1585413000 34200 0 CST} - {1603557000 37800 1 CST} - {1616862600 34200 0 CST} - {1635611400 37800 1 CST} - {1648312200 34200 0 CST} - {1667061000 37800 1 CST} - {1679761800 34200 0 CST} - {1698510600 37800 1 CST} - {1711816200 34200 0 CST} - {1729960200 37800 1 CST} - {1743265800 34200 0 CST} - {1761409800 37800 1 CST} - {1774715400 34200 0 CST} - {1792859400 37800 1 CST} - {1806165000 34200 0 CST} - {1824913800 37800 1 CST} - {1837614600 34200 0 CST} - {1856363400 37800 1 CST} - {1869064200 34200 0 CST} - {1887813000 37800 1 CST} - {1901118600 34200 0 CST} - {1919262600 37800 1 CST} - {1932568200 34200 0 CST} - {1950712200 37800 1 CST} - {1964017800 34200 0 CST} - {1982766600 37800 1 CST} - {1995467400 34200 0 CST} - {2014216200 37800 1 CST} - {2026917000 34200 0 CST} - {2045665800 37800 1 CST} - {2058366600 34200 0 CST} - {2077115400 37800 1 CST} - {2090421000 34200 0 CST} - {2108565000 37800 1 CST} - {2121870600 34200 0 CST} - {2140014600 37800 1 CST} - {2153320200 34200 0 CST} - {2172069000 37800 1 CST} - {2184769800 34200 0 CST} - {2203518600 37800 1 CST} - {2216219400 34200 0 CST} - {2234968200 37800 1 CST} - {2248273800 34200 0 CST} - {2266417800 37800 1 CST} - {2279723400 34200 0 CST} - {2297867400 37800 1 CST} - {2311173000 34200 0 CST} - {2329317000 37800 1 CST} - {2342622600 34200 0 CST} - {2361371400 37800 1 CST} - {2374072200 34200 0 CST} - {2392821000 37800 1 CST} - {2405521800 34200 0 CST} - {2424270600 37800 1 CST} - {2437576200 34200 0 CST} - {2455720200 37800 1 CST} - {2469025800 34200 0 CST} - {2487169800 37800 1 CST} - {2500475400 34200 0 CST} - {2519224200 37800 1 CST} - {2531925000 34200 0 CST} - {2550673800 37800 1 CST} - {2563374600 34200 0 CST} - {2582123400 37800 1 CST} - {2595429000 34200 0 CST} - {2613573000 37800 1 CST} - {2626878600 34200 0 CST} - {2645022600 37800 1 CST} - {2658328200 34200 0 CST} - {2676472200 37800 1 CST} - {2689777800 34200 0 CST} - {2708526600 37800 1 CST} - {2721227400 34200 0 CST} - {2739976200 37800 1 CST} - {2752677000 34200 0 CST} - {2771425800 37800 1 CST} - {2784731400 34200 0 CST} - {2802875400 37800 1 CST} - {2816181000 34200 0 CST} - {2834325000 37800 1 CST} - {2847630600 34200 0 CST} - {2866379400 37800 1 CST} - {2879080200 34200 0 CST} - {2897829000 37800 1 CST} - {2910529800 34200 0 CST} - {2929278600 37800 1 CST} - {2941979400 34200 0 CST} - {2960728200 37800 1 CST} - {2974033800 34200 0 CST} - {2992177800 37800 1 CST} - {3005483400 34200 0 CST} - {3023627400 37800 1 CST} - {3036933000 34200 0 CST} - {3055681800 37800 1 CST} - {3068382600 34200 0 CST} - {3087131400 37800 1 CST} - {3099832200 34200 0 CST} - {3118581000 37800 1 CST} - {3131886600 34200 0 CST} - {3150030600 37800 1 CST} - {3163336200 34200 0 CST} - {3181480200 37800 1 CST} - {3194785800 34200 0 CST} - {3212929800 37800 1 CST} - {3226235400 34200 0 CST} - {3244984200 37800 1 CST} - {3257685000 34200 0 CST} - {3276433800 37800 1 CST} - {3289134600 34200 0 CST} - {3307883400 37800 1 CST} - {3321189000 34200 0 CST} - {3339333000 37800 1 CST} - {3352638600 34200 0 CST} - {3370782600 37800 1 CST} - {3384088200 34200 0 CST} - {3402837000 37800 1 CST} - {3415537800 34200 0 CST} - {3434286600 37800 1 CST} - {3446987400 34200 0 CST} - {3465736200 37800 1 CST} - {3479041800 34200 0 CST} - {3497185800 37800 1 CST} - {3510491400 34200 0 CST} - {3528635400 37800 1 CST} - {3541941000 34200 0 CST} - {3560085000 37800 1 CST} - {3573390600 34200 0 CST} - {3592139400 37800 1 CST} - {3604840200 34200 0 CST} - {3623589000 37800 1 CST} - {3636289800 34200 0 CST} - {3655038600 37800 1 CST} - {3668344200 34200 0 CST} - {3686488200 37800 1 CST} - {3699793800 34200 0 CST} - {3717937800 37800 1 CST} - {3731243400 34200 0 CST} - {3749992200 37800 1 CST} - {3762693000 34200 0 CST} - {3781441800 37800 1 CST} - {3794142600 34200 0 CST} - {3812891400 37800 1 CST} - {3825592200 34200 0 CST} - {3844341000 37800 1 CST} - {3857646600 34200 0 CST} - {3875790600 37800 1 CST} - {3889096200 34200 0 CST} - {3907240200 37800 1 CST} - {3920545800 34200 0 CST} - {3939294600 37800 1 CST} - {3951995400 34200 0 CST} - {3970744200 37800 1 CST} - {3983445000 34200 0 CST} - {4002193800 37800 1 CST} - {4015499400 34200 0 CST} - {4033643400 37800 1 CST} - {4046949000 34200 0 CST} - {4065093000 37800 1 CST} - {4078398600 34200 0 CST} - {4096542600 37800 1 CST} + {1207413000 34200 0 CST} + {1223137800 37800 1 CST} + {1238862600 34200 0 CST} + {1254587400 37800 1 CST} + {1270312200 34200 0 CST} + {1286037000 37800 1 CST} + {1301761800 34200 0 CST} + {1317486600 37800 1 CST} + {1333211400 34200 0 CST} + {1349541000 37800 1 CST} + {1365265800 34200 0 CST} + {1380990600 37800 1 CST} + {1396715400 34200 0 CST} + {1412440200 37800 1 CST} + {1428165000 34200 0 CST} + {1443889800 37800 1 CST} + {1459614600 34200 0 CST} + {1475339400 37800 1 CST} + {1491064200 34200 0 CST} + {1506789000 37800 1 CST} + {1522513800 34200 0 CST} + {1538843400 37800 1 CST} + {1554568200 34200 0 CST} + {1570293000 37800 1 CST} + {1586017800 34200 0 CST} + {1601742600 37800 1 CST} + {1617467400 34200 0 CST} + {1633192200 37800 1 CST} + {1648917000 34200 0 CST} + {1664641800 37800 1 CST} + {1680366600 34200 0 CST} + {1696091400 37800 1 CST} + {1712421000 34200 0 CST} + {1728145800 37800 1 CST} + {1743870600 34200 0 CST} + {1759595400 37800 1 CST} + {1775320200 34200 0 CST} + {1791045000 37800 1 CST} + {1806769800 34200 0 CST} + {1822494600 37800 1 CST} + {1838219400 34200 0 CST} + {1853944200 37800 1 CST} + {1869669000 34200 0 CST} + {1885998600 37800 1 CST} + {1901723400 34200 0 CST} + {1917448200 37800 1 CST} + {1933173000 34200 0 CST} + {1948897800 37800 1 CST} + {1964622600 34200 0 CST} + {1980347400 37800 1 CST} + {1996072200 34200 0 CST} + {2011797000 37800 1 CST} + {2027521800 34200 0 CST} + {2043246600 37800 1 CST} + {2058971400 34200 0 CST} + {2075301000 37800 1 CST} + {2091025800 34200 0 CST} + {2106750600 37800 1 CST} + {2122475400 34200 0 CST} + {2138200200 37800 1 CST} + {2153925000 34200 0 CST} + {2169649800 37800 1 CST} + {2185374600 34200 0 CST} + {2201099400 37800 1 CST} + {2216824200 34200 0 CST} + {2233153800 37800 1 CST} + {2248878600 34200 0 CST} + {2264603400 37800 1 CST} + {2280328200 34200 0 CST} + {2296053000 37800 1 CST} + {2311777800 34200 0 CST} + {2327502600 37800 1 CST} + {2343227400 34200 0 CST} + {2358952200 37800 1 CST} + {2374677000 34200 0 CST} + {2390401800 37800 1 CST} + {2406126600 34200 0 CST} + {2422456200 37800 1 CST} + {2438181000 34200 0 CST} + {2453905800 37800 1 CST} + {2469630600 34200 0 CST} + {2485355400 37800 1 CST} + {2501080200 34200 0 CST} + {2516805000 37800 1 CST} + {2532529800 34200 0 CST} + {2548254600 37800 1 CST} + {2563979400 34200 0 CST} + {2579704200 37800 1 CST} + {2596033800 34200 0 CST} + {2611758600 37800 1 CST} + {2627483400 34200 0 CST} + {2643208200 37800 1 CST} + {2658933000 34200 0 CST} + {2674657800 37800 1 CST} + {2690382600 34200 0 CST} + {2706107400 37800 1 CST} + {2721832200 34200 0 CST} + {2737557000 37800 1 CST} + {2753281800 34200 0 CST} + {2769611400 37800 1 CST} + {2785336200 34200 0 CST} + {2801061000 37800 1 CST} + {2816785800 34200 0 CST} + {2832510600 37800 1 CST} + {2848235400 34200 0 CST} + {2863960200 37800 1 CST} + {2879685000 34200 0 CST} + {2895409800 37800 1 CST} + {2911134600 34200 0 CST} + {2926859400 37800 1 CST} + {2942584200 34200 0 CST} + {2958913800 37800 1 CST} + {2974638600 34200 0 CST} + {2990363400 37800 1 CST} + {3006088200 34200 0 CST} + {3021813000 37800 1 CST} + {3037537800 34200 0 CST} + {3053262600 37800 1 CST} + {3068987400 34200 0 CST} + {3084712200 37800 1 CST} + {3100437000 34200 0 CST} + {3116766600 37800 1 CST} + {3132491400 34200 0 CST} + {3148216200 37800 1 CST} + {3163941000 34200 0 CST} + {3179665800 37800 1 CST} + {3195390600 34200 0 CST} + {3211115400 37800 1 CST} + {3226840200 34200 0 CST} + {3242565000 37800 1 CST} + {3258289800 34200 0 CST} + {3274014600 37800 1 CST} + {3289739400 34200 0 CST} + {3306069000 37800 1 CST} + {3321793800 34200 0 CST} + {3337518600 37800 1 CST} + {3353243400 34200 0 CST} + {3368968200 37800 1 CST} + {3384693000 34200 0 CST} + {3400417800 37800 1 CST} + {3416142600 34200 0 CST} + {3431867400 37800 1 CST} + {3447592200 34200 0 CST} + {3463317000 37800 1 CST} + {3479646600 34200 0 CST} + {3495371400 37800 1 CST} + {3511096200 34200 0 CST} + {3526821000 37800 1 CST} + {3542545800 34200 0 CST} + {3558270600 37800 1 CST} + {3573995400 34200 0 CST} + {3589720200 37800 1 CST} + {3605445000 34200 0 CST} + {3621169800 37800 1 CST} + {3636894600 34200 0 CST} + {3653224200 37800 1 CST} + {3668949000 34200 0 CST} + {3684673800 37800 1 CST} + {3700398600 34200 0 CST} + {3716123400 37800 1 CST} + {3731848200 34200 0 CST} + {3747573000 37800 1 CST} + {3763297800 34200 0 CST} + {3779022600 37800 1 CST} + {3794747400 34200 0 CST} + {3810472200 37800 1 CST} + {3826197000 34200 0 CST} + {3842526600 37800 1 CST} + {3858251400 34200 0 CST} + {3873976200 37800 1 CST} + {3889701000 34200 0 CST} + {3905425800 37800 1 CST} + {3921150600 34200 0 CST} + {3936875400 37800 1 CST} + {3952600200 34200 0 CST} + {3968325000 37800 1 CST} + {3984049800 34200 0 CST} + {4000379400 37800 1 CST} + {4016104200 34200 0 CST} + {4031829000 37800 1 CST} + {4047553800 34200 0 CST} + {4063278600 37800 1 CST} + {4079003400 34200 0 CST} + {4094728200 37800 1 CST} } diff --git a/library/tzdata/Australia/Currie b/library/tzdata/Australia/Currie index 1751589..ae6d1f0 100644 --- a/library/tzdata/Australia/Currie +++ b/library/tzdata/Australia/Currie @@ -86,188 +86,188 @@ set TZData(:Australia/Currie) { {1159632000 39600 1 EST} {1174752000 36000 0 EST} {1191686400 39600 1 EST} - {1206806400 36000 0 EST} + {1207411200 36000 0 EST} {1223136000 39600 1 EST} - {1238256000 36000 0 EST} + {1238860800 36000 0 EST} {1254585600 39600 1 EST} - {1269705600 36000 0 EST} + {1270310400 36000 0 EST} {1286035200 39600 1 EST} - {1301155200 36000 0 EST} + {1301760000 36000 0 EST} {1317484800 39600 1 EST} - {1332604800 36000 0 EST} + {1333209600 36000 0 EST} {1349539200 39600 1 EST} - {1364659200 36000 0 EST} + {1365264000 36000 0 EST} {1380988800 39600 1 EST} - {1396108800 36000 0 EST} + {1396713600 36000 0 EST} {1412438400 39600 1 EST} - {1427558400 36000 0 EST} + {1428163200 36000 0 EST} {1443888000 39600 1 EST} - {1459008000 36000 0 EST} + {1459612800 36000 0 EST} {1475337600 39600 1 EST} - {1490457600 36000 0 EST} + {1491062400 36000 0 EST} {1506787200 39600 1 EST} - {1521907200 36000 0 EST} + {1522512000 36000 0 EST} {1538841600 39600 1 EST} - {1553961600 36000 0 EST} + {1554566400 36000 0 EST} {1570291200 39600 1 EST} - {1585411200 36000 0 EST} + {1586016000 36000 0 EST} {1601740800 39600 1 EST} - {1616860800 36000 0 EST} + {1617465600 36000 0 EST} {1633190400 39600 1 EST} - {1648310400 36000 0 EST} + {1648915200 36000 0 EST} {1664640000 39600 1 EST} - {1679760000 36000 0 EST} + {1680364800 36000 0 EST} {1696089600 39600 1 EST} - {1711814400 36000 0 EST} + {1712419200 36000 0 EST} {1728144000 39600 1 EST} - {1743264000 36000 0 EST} + {1743868800 36000 0 EST} {1759593600 39600 1 EST} - {1774713600 36000 0 EST} + {1775318400 36000 0 EST} {1791043200 39600 1 EST} - {1806163200 36000 0 EST} + {1806768000 36000 0 EST} {1822492800 39600 1 EST} - {1837612800 36000 0 EST} + {1838217600 36000 0 EST} {1853942400 39600 1 EST} - {1869062400 36000 0 EST} + {1869667200 36000 0 EST} {1885996800 39600 1 EST} - {1901116800 36000 0 EST} + {1901721600 36000 0 EST} {1917446400 39600 1 EST} - {1932566400 36000 0 EST} + {1933171200 36000 0 EST} {1948896000 39600 1 EST} - {1964016000 36000 0 EST} + {1964620800 36000 0 EST} {1980345600 39600 1 EST} - {1995465600 36000 0 EST} + {1996070400 36000 0 EST} {2011795200 39600 1 EST} - {2026915200 36000 0 EST} + {2027520000 36000 0 EST} {2043244800 39600 1 EST} - {2058364800 36000 0 EST} + {2058969600 36000 0 EST} {2075299200 39600 1 EST} - {2090419200 36000 0 EST} + {2091024000 36000 0 EST} {2106748800 39600 1 EST} - {2121868800 36000 0 EST} + {2122473600 36000 0 EST} {2138198400 39600 1 EST} - {2153318400 36000 0 EST} + {2153923200 36000 0 EST} {2169648000 39600 1 EST} - {2184768000 36000 0 EST} + {2185372800 36000 0 EST} {2201097600 39600 1 EST} - {2216217600 36000 0 EST} + {2216822400 36000 0 EST} {2233152000 39600 1 EST} - {2248272000 36000 0 EST} + {2248876800 36000 0 EST} {2264601600 39600 1 EST} - {2279721600 36000 0 EST} + {2280326400 36000 0 EST} {2296051200 39600 1 EST} - {2311171200 36000 0 EST} + {2311776000 36000 0 EST} {2327500800 39600 1 EST} - {2342620800 36000 0 EST} + {2343225600 36000 0 EST} {2358950400 39600 1 EST} - {2374070400 36000 0 EST} + {2374675200 36000 0 EST} {2390400000 39600 1 EST} - {2405520000 36000 0 EST} + {2406124800 36000 0 EST} {2422454400 39600 1 EST} - {2437574400 36000 0 EST} + {2438179200 36000 0 EST} {2453904000 39600 1 EST} - {2469024000 36000 0 EST} + {2469628800 36000 0 EST} {2485353600 39600 1 EST} - {2500473600 36000 0 EST} + {2501078400 36000 0 EST} {2516803200 39600 1 EST} - {2531923200 36000 0 EST} + {2532528000 36000 0 EST} {2548252800 39600 1 EST} - {2563372800 36000 0 EST} + {2563977600 36000 0 EST} {2579702400 39600 1 EST} - {2595427200 36000 0 EST} + {2596032000 36000 0 EST} {2611756800 39600 1 EST} - {2626876800 36000 0 EST} + {2627481600 36000 0 EST} {2643206400 39600 1 EST} - {2658326400 36000 0 EST} + {2658931200 36000 0 EST} {2674656000 39600 1 EST} - {2689776000 36000 0 EST} + {2690380800 36000 0 EST} {2706105600 39600 1 EST} - {2721225600 36000 0 EST} + {2721830400 36000 0 EST} {2737555200 39600 1 EST} - {2752675200 36000 0 EST} + {2753280000 36000 0 EST} {2769609600 39600 1 EST} - {2784729600 36000 0 EST} + {2785334400 36000 0 EST} {2801059200 39600 1 EST} - {2816179200 36000 0 EST} + {2816784000 36000 0 EST} {2832508800 39600 1 EST} - {2847628800 36000 0 EST} + {2848233600 36000 0 EST} {2863958400 39600 1 EST} - {2879078400 36000 0 EST} + {2879683200 36000 0 EST} {2895408000 39600 1 EST} - {2910528000 36000 0 EST} + {2911132800 36000 0 EST} {2926857600 39600 1 EST} - {2941977600 36000 0 EST} + {2942582400 36000 0 EST} {2958912000 39600 1 EST} - {2974032000 36000 0 EST} + {2974636800 36000 0 EST} {2990361600 39600 1 EST} - {3005481600 36000 0 EST} + {3006086400 36000 0 EST} {3021811200 39600 1 EST} - {3036931200 36000 0 EST} + {3037536000 36000 0 EST} {3053260800 39600 1 EST} - {3068380800 36000 0 EST} + {3068985600 36000 0 EST} {3084710400 39600 1 EST} - {3099830400 36000 0 EST} + {3100435200 36000 0 EST} {3116764800 39600 1 EST} - {3131884800 36000 0 EST} + {3132489600 36000 0 EST} {3148214400 39600 1 EST} - {3163334400 36000 0 EST} + {3163939200 36000 0 EST} {3179664000 39600 1 EST} - {3194784000 36000 0 EST} + {3195388800 36000 0 EST} {3211113600 39600 1 EST} - {3226233600 36000 0 EST} + {3226838400 36000 0 EST} {3242563200 39600 1 EST} - {3257683200 36000 0 EST} + {3258288000 36000 0 EST} {3274012800 39600 1 EST} - {3289132800 36000 0 EST} + {3289737600 36000 0 EST} {3306067200 39600 1 EST} - {3321187200 36000 0 EST} + {3321792000 36000 0 EST} {3337516800 39600 1 EST} - {3352636800 36000 0 EST} + {3353241600 36000 0 EST} {3368966400 39600 1 EST} - {3384086400 36000 0 EST} + {3384691200 36000 0 EST} {3400416000 39600 1 EST} - {3415536000 36000 0 EST} + {3416140800 36000 0 EST} {3431865600 39600 1 EST} - {3446985600 36000 0 EST} + {3447590400 36000 0 EST} {3463315200 39600 1 EST} - {3479040000 36000 0 EST} + {3479644800 36000 0 EST} {3495369600 39600 1 EST} - {3510489600 36000 0 EST} + {3511094400 36000 0 EST} {3526819200 39600 1 EST} - {3541939200 36000 0 EST} + {3542544000 36000 0 EST} {3558268800 39600 1 EST} - {3573388800 36000 0 EST} + {3573993600 36000 0 EST} {3589718400 39600 1 EST} - {3604838400 36000 0 EST} + {3605443200 36000 0 EST} {3621168000 39600 1 EST} - {3636288000 36000 0 EST} + {3636892800 36000 0 EST} {3653222400 39600 1 EST} - {3668342400 36000 0 EST} + {3668947200 36000 0 EST} {3684672000 39600 1 EST} - {3699792000 36000 0 EST} + {3700396800 36000 0 EST} {3716121600 39600 1 EST} - {3731241600 36000 0 EST} + {3731846400 36000 0 EST} {3747571200 39600 1 EST} - {3762691200 36000 0 EST} + {3763296000 36000 0 EST} {3779020800 39600 1 EST} - {3794140800 36000 0 EST} + {3794745600 36000 0 EST} {3810470400 39600 1 EST} - {3825590400 36000 0 EST} + {3826195200 36000 0 EST} {3842524800 39600 1 EST} - {3857644800 36000 0 EST} + {3858249600 36000 0 EST} {3873974400 39600 1 EST} - {3889094400 36000 0 EST} + {3889699200 36000 0 EST} {3905424000 39600 1 EST} - {3920544000 36000 0 EST} + {3921148800 36000 0 EST} {3936873600 39600 1 EST} - {3951993600 36000 0 EST} + {3952598400 36000 0 EST} {3968323200 39600 1 EST} - {3983443200 36000 0 EST} + {3984048000 36000 0 EST} {4000377600 39600 1 EST} - {4015497600 36000 0 EST} + {4016102400 36000 0 EST} {4031827200 39600 1 EST} - {4046947200 36000 0 EST} + {4047552000 36000 0 EST} {4063276800 39600 1 EST} - {4078396800 36000 0 EST} + {4079001600 36000 0 EST} {4094726400 39600 1 EST} } diff --git a/library/tzdata/Australia/Hobart b/library/tzdata/Australia/Hobart index 8fce5a4..8f27110 100644 --- a/library/tzdata/Australia/Hobart +++ b/library/tzdata/Australia/Hobart @@ -94,188 +94,188 @@ set TZData(:Australia/Hobart) { {1159632000 39600 1 EST} {1174752000 36000 0 EST} {1191686400 39600 1 EST} - {1206806400 36000 0 EST} + {1207411200 36000 0 EST} {1223136000 39600 1 EST} - {1238256000 36000 0 EST} + {1238860800 36000 0 EST} {1254585600 39600 1 EST} - {1269705600 36000 0 EST} + {1270310400 36000 0 EST} {1286035200 39600 1 EST} - {1301155200 36000 0 EST} + {1301760000 36000 0 EST} {1317484800 39600 1 EST} - {1332604800 36000 0 EST} + {1333209600 36000 0 EST} {1349539200 39600 1 EST} - {1364659200 36000 0 EST} + {1365264000 36000 0 EST} {1380988800 39600 1 EST} - {1396108800 36000 0 EST} + {1396713600 36000 0 EST} {1412438400 39600 1 EST} - {1427558400 36000 0 EST} + {1428163200 36000 0 EST} {1443888000 39600 1 EST} - {1459008000 36000 0 EST} + {1459612800 36000 0 EST} {1475337600 39600 1 EST} - {1490457600 36000 0 EST} + {1491062400 36000 0 EST} {1506787200 39600 1 EST} - {1521907200 36000 0 EST} + {1522512000 36000 0 EST} {1538841600 39600 1 EST} - {1553961600 36000 0 EST} + {1554566400 36000 0 EST} {1570291200 39600 1 EST} - {1585411200 36000 0 EST} + {1586016000 36000 0 EST} {1601740800 39600 1 EST} - {1616860800 36000 0 EST} + {1617465600 36000 0 EST} {1633190400 39600 1 EST} - {1648310400 36000 0 EST} + {1648915200 36000 0 EST} {1664640000 39600 1 EST} - {1679760000 36000 0 EST} + {1680364800 36000 0 EST} {1696089600 39600 1 EST} - {1711814400 36000 0 EST} + {1712419200 36000 0 EST} {1728144000 39600 1 EST} - {1743264000 36000 0 EST} + {1743868800 36000 0 EST} {1759593600 39600 1 EST} - {1774713600 36000 0 EST} + {1775318400 36000 0 EST} {1791043200 39600 1 EST} - {1806163200 36000 0 EST} + {1806768000 36000 0 EST} {1822492800 39600 1 EST} - {1837612800 36000 0 EST} + {1838217600 36000 0 EST} {1853942400 39600 1 EST} - {1869062400 36000 0 EST} + {1869667200 36000 0 EST} {1885996800 39600 1 EST} - {1901116800 36000 0 EST} + {1901721600 36000 0 EST} {1917446400 39600 1 EST} - {1932566400 36000 0 EST} + {1933171200 36000 0 EST} {1948896000 39600 1 EST} - {1964016000 36000 0 EST} + {1964620800 36000 0 EST} {1980345600 39600 1 EST} - {1995465600 36000 0 EST} + {1996070400 36000 0 EST} {2011795200 39600 1 EST} - {2026915200 36000 0 EST} + {2027520000 36000 0 EST} {2043244800 39600 1 EST} - {2058364800 36000 0 EST} + {2058969600 36000 0 EST} {2075299200 39600 1 EST} - {2090419200 36000 0 EST} + {2091024000 36000 0 EST} {2106748800 39600 1 EST} - {2121868800 36000 0 EST} + {2122473600 36000 0 EST} {2138198400 39600 1 EST} - {2153318400 36000 0 EST} + {2153923200 36000 0 EST} {2169648000 39600 1 EST} - {2184768000 36000 0 EST} + {2185372800 36000 0 EST} {2201097600 39600 1 EST} - {2216217600 36000 0 EST} + {2216822400 36000 0 EST} {2233152000 39600 1 EST} - {2248272000 36000 0 EST} + {2248876800 36000 0 EST} {2264601600 39600 1 EST} - {2279721600 36000 0 EST} + {2280326400 36000 0 EST} {2296051200 39600 1 EST} - {2311171200 36000 0 EST} + {2311776000 36000 0 EST} {2327500800 39600 1 EST} - {2342620800 36000 0 EST} + {2343225600 36000 0 EST} {2358950400 39600 1 EST} - {2374070400 36000 0 EST} + {2374675200 36000 0 EST} {2390400000 39600 1 EST} - {2405520000 36000 0 EST} + {2406124800 36000 0 EST} {2422454400 39600 1 EST} - {2437574400 36000 0 EST} + {2438179200 36000 0 EST} {2453904000 39600 1 EST} - {2469024000 36000 0 EST} + {2469628800 36000 0 EST} {2485353600 39600 1 EST} - {2500473600 36000 0 EST} + {2501078400 36000 0 EST} {2516803200 39600 1 EST} - {2531923200 36000 0 EST} + {2532528000 36000 0 EST} {2548252800 39600 1 EST} - {2563372800 36000 0 EST} + {2563977600 36000 0 EST} {2579702400 39600 1 EST} - {2595427200 36000 0 EST} + {2596032000 36000 0 EST} {2611756800 39600 1 EST} - {2626876800 36000 0 EST} + {2627481600 36000 0 EST} {2643206400 39600 1 EST} - {2658326400 36000 0 EST} + {2658931200 36000 0 EST} {2674656000 39600 1 EST} - {2689776000 36000 0 EST} + {2690380800 36000 0 EST} {2706105600 39600 1 EST} - {2721225600 36000 0 EST} + {2721830400 36000 0 EST} {2737555200 39600 1 EST} - {2752675200 36000 0 EST} + {2753280000 36000 0 EST} {2769609600 39600 1 EST} - {2784729600 36000 0 EST} + {2785334400 36000 0 EST} {2801059200 39600 1 EST} - {2816179200 36000 0 EST} + {2816784000 36000 0 EST} {2832508800 39600 1 EST} - {2847628800 36000 0 EST} + {2848233600 36000 0 EST} {2863958400 39600 1 EST} - {2879078400 36000 0 EST} + {2879683200 36000 0 EST} {2895408000 39600 1 EST} - {2910528000 36000 0 EST} + {2911132800 36000 0 EST} {2926857600 39600 1 EST} - {2941977600 36000 0 EST} + {2942582400 36000 0 EST} {2958912000 39600 1 EST} - {2974032000 36000 0 EST} + {2974636800 36000 0 EST} {2990361600 39600 1 EST} - {3005481600 36000 0 EST} + {3006086400 36000 0 EST} {3021811200 39600 1 EST} - {3036931200 36000 0 EST} + {3037536000 36000 0 EST} {3053260800 39600 1 EST} - {3068380800 36000 0 EST} + {3068985600 36000 0 EST} {3084710400 39600 1 EST} - {3099830400 36000 0 EST} + {3100435200 36000 0 EST} {3116764800 39600 1 EST} - {3131884800 36000 0 EST} + {3132489600 36000 0 EST} {3148214400 39600 1 EST} - {3163334400 36000 0 EST} + {3163939200 36000 0 EST} {3179664000 39600 1 EST} - {3194784000 36000 0 EST} + {3195388800 36000 0 EST} {3211113600 39600 1 EST} - {3226233600 36000 0 EST} + {3226838400 36000 0 EST} {3242563200 39600 1 EST} - {3257683200 36000 0 EST} + {3258288000 36000 0 EST} {3274012800 39600 1 EST} - {3289132800 36000 0 EST} + {3289737600 36000 0 EST} {3306067200 39600 1 EST} - {3321187200 36000 0 EST} + {3321792000 36000 0 EST} {3337516800 39600 1 EST} - {3352636800 36000 0 EST} + {3353241600 36000 0 EST} {3368966400 39600 1 EST} - {3384086400 36000 0 EST} + {3384691200 36000 0 EST} {3400416000 39600 1 EST} - {3415536000 36000 0 EST} + {3416140800 36000 0 EST} {3431865600 39600 1 EST} - {3446985600 36000 0 EST} + {3447590400 36000 0 EST} {3463315200 39600 1 EST} - {3479040000 36000 0 EST} + {3479644800 36000 0 EST} {3495369600 39600 1 EST} - {3510489600 36000 0 EST} + {3511094400 36000 0 EST} {3526819200 39600 1 EST} - {3541939200 36000 0 EST} + {3542544000 36000 0 EST} {3558268800 39600 1 EST} - {3573388800 36000 0 EST} + {3573993600 36000 0 EST} {3589718400 39600 1 EST} - {3604838400 36000 0 EST} + {3605443200 36000 0 EST} {3621168000 39600 1 EST} - {3636288000 36000 0 EST} + {3636892800 36000 0 EST} {3653222400 39600 1 EST} - {3668342400 36000 0 EST} + {3668947200 36000 0 EST} {3684672000 39600 1 EST} - {3699792000 36000 0 EST} + {3700396800 36000 0 EST} {3716121600 39600 1 EST} - {3731241600 36000 0 EST} + {3731846400 36000 0 EST} {3747571200 39600 1 EST} - {3762691200 36000 0 EST} + {3763296000 36000 0 EST} {3779020800 39600 1 EST} - {3794140800 36000 0 EST} + {3794745600 36000 0 EST} {3810470400 39600 1 EST} - {3825590400 36000 0 EST} + {3826195200 36000 0 EST} {3842524800 39600 1 EST} - {3857644800 36000 0 EST} + {3858249600 36000 0 EST} {3873974400 39600 1 EST} - {3889094400 36000 0 EST} + {3889699200 36000 0 EST} {3905424000 39600 1 EST} - {3920544000 36000 0 EST} + {3921148800 36000 0 EST} {3936873600 39600 1 EST} - {3951993600 36000 0 EST} + {3952598400 36000 0 EST} {3968323200 39600 1 EST} - {3983443200 36000 0 EST} + {3984048000 36000 0 EST} {4000377600 39600 1 EST} - {4015497600 36000 0 EST} + {4016102400 36000 0 EST} {4031827200 39600 1 EST} - {4046947200 36000 0 EST} + {4047552000 36000 0 EST} {4063276800 39600 1 EST} - {4078396800 36000 0 EST} + {4079001600 36000 0 EST} {4094726400 39600 1 EST} } diff --git a/library/tzdata/Australia/Lord_Howe b/library/tzdata/Australia/Lord_Howe index a24dd90..da094e5 100644 --- a/library/tzdata/Australia/Lord_Howe +++ b/library/tzdata/Australia/Lord_Howe @@ -57,188 +57,188 @@ set TZData(:Australia/Lord_Howe) { {1162049400 39600 1 LHST} {1174748400 37800 0 LHST} {1193499000 39600 1 LHST} - {1206802800 37800 0 LHST} - {1224948600 39600 1 LHST} - {1238252400 37800 0 LHST} - {1256398200 39600 1 LHST} - {1269702000 37800 0 LHST} - {1288452600 39600 1 LHST} - {1301151600 37800 0 LHST} - {1319902200 39600 1 LHST} - {1332601200 37800 0 LHST} - {1351351800 39600 1 LHST} - {1364655600 37800 0 LHST} - {1382801400 39600 1 LHST} - {1396105200 37800 0 LHST} - {1414251000 39600 1 LHST} - {1427554800 37800 0 LHST} - {1445700600 39600 1 LHST} - {1459004400 37800 0 LHST} - {1477755000 39600 1 LHST} - {1490454000 37800 0 LHST} - {1509204600 39600 1 LHST} - {1521903600 37800 0 LHST} - {1540654200 39600 1 LHST} - {1553958000 37800 0 LHST} - {1572103800 39600 1 LHST} - {1585407600 37800 0 LHST} - {1603553400 39600 1 LHST} - {1616857200 37800 0 LHST} - {1635607800 39600 1 LHST} - {1648306800 37800 0 LHST} - {1667057400 39600 1 LHST} - {1679756400 37800 0 LHST} - {1698507000 39600 1 LHST} - {1711810800 37800 0 LHST} - {1729956600 39600 1 LHST} - {1743260400 37800 0 LHST} - {1761406200 39600 1 LHST} - {1774710000 37800 0 LHST} - {1792855800 39600 1 LHST} - {1806159600 37800 0 LHST} - {1824910200 39600 1 LHST} - {1837609200 37800 0 LHST} - {1856359800 39600 1 LHST} - {1869058800 37800 0 LHST} - {1887809400 39600 1 LHST} - {1901113200 37800 0 LHST} - {1919259000 39600 1 LHST} - {1932562800 37800 0 LHST} - {1950708600 39600 1 LHST} - {1964012400 37800 0 LHST} - {1982763000 39600 1 LHST} - {1995462000 37800 0 LHST} - {2014212600 39600 1 LHST} - {2026911600 37800 0 LHST} - {2045662200 39600 1 LHST} - {2058361200 37800 0 LHST} - {2077111800 39600 1 LHST} - {2090415600 37800 0 LHST} - {2108561400 39600 1 LHST} - {2121865200 37800 0 LHST} - {2140011000 39600 1 LHST} - {2153314800 37800 0 LHST} - {2172065400 39600 1 LHST} - {2184764400 37800 0 LHST} - {2203515000 39600 1 LHST} - {2216214000 37800 0 LHST} - {2234964600 39600 1 LHST} - {2248268400 37800 0 LHST} - {2266414200 39600 1 LHST} - {2279718000 37800 0 LHST} - {2297863800 39600 1 LHST} - {2311167600 37800 0 LHST} - {2329313400 39600 1 LHST} - {2342617200 37800 0 LHST} - {2361367800 39600 1 LHST} - {2374066800 37800 0 LHST} - {2392817400 39600 1 LHST} - {2405516400 37800 0 LHST} - {2424267000 39600 1 LHST} - {2437570800 37800 0 LHST} - {2455716600 39600 1 LHST} - {2469020400 37800 0 LHST} - {2487166200 39600 1 LHST} - {2500470000 37800 0 LHST} - {2519220600 39600 1 LHST} - {2531919600 37800 0 LHST} - {2550670200 39600 1 LHST} - {2563369200 37800 0 LHST} - {2582119800 39600 1 LHST} - {2595423600 37800 0 LHST} - {2613569400 39600 1 LHST} - {2626873200 37800 0 LHST} - {2645019000 39600 1 LHST} - {2658322800 37800 0 LHST} - {2676468600 39600 1 LHST} - {2689772400 37800 0 LHST} - {2708523000 39600 1 LHST} - {2721222000 37800 0 LHST} - {2739972600 39600 1 LHST} - {2752671600 37800 0 LHST} - {2771422200 39600 1 LHST} - {2784726000 37800 0 LHST} - {2802871800 39600 1 LHST} - {2816175600 37800 0 LHST} - {2834321400 39600 1 LHST} - {2847625200 37800 0 LHST} - {2866375800 39600 1 LHST} - {2879074800 37800 0 LHST} - {2897825400 39600 1 LHST} - {2910524400 37800 0 LHST} - {2929275000 39600 1 LHST} - {2941974000 37800 0 LHST} - {2960724600 39600 1 LHST} - {2974028400 37800 0 LHST} - {2992174200 39600 1 LHST} - {3005478000 37800 0 LHST} - {3023623800 39600 1 LHST} - {3036927600 37800 0 LHST} - {3055678200 39600 1 LHST} - {3068377200 37800 0 LHST} - {3087127800 39600 1 LHST} - {3099826800 37800 0 LHST} - {3118577400 39600 1 LHST} - {3131881200 37800 0 LHST} - {3150027000 39600 1 LHST} - {3163330800 37800 0 LHST} - {3181476600 39600 1 LHST} - {3194780400 37800 0 LHST} - {3212926200 39600 1 LHST} - {3226230000 37800 0 LHST} - {3244980600 39600 1 LHST} - {3257679600 37800 0 LHST} - {3276430200 39600 1 LHST} - {3289129200 37800 0 LHST} - {3307879800 39600 1 LHST} - {3321183600 37800 0 LHST} - {3339329400 39600 1 LHST} - {3352633200 37800 0 LHST} - {3370779000 39600 1 LHST} - {3384082800 37800 0 LHST} - {3402833400 39600 1 LHST} - {3415532400 37800 0 LHST} - {3434283000 39600 1 LHST} - {3446982000 37800 0 LHST} - {3465732600 39600 1 LHST} - {3479036400 37800 0 LHST} - {3497182200 39600 1 LHST} - {3510486000 37800 0 LHST} - {3528631800 39600 1 LHST} - {3541935600 37800 0 LHST} - {3560081400 39600 1 LHST} - {3573385200 37800 0 LHST} - {3592135800 39600 1 LHST} - {3604834800 37800 0 LHST} - {3623585400 39600 1 LHST} - {3636284400 37800 0 LHST} - {3655035000 39600 1 LHST} - {3668338800 37800 0 LHST} - {3686484600 39600 1 LHST} - {3699788400 37800 0 LHST} - {3717934200 39600 1 LHST} - {3731238000 37800 0 LHST} - {3749988600 39600 1 LHST} - {3762687600 37800 0 LHST} - {3781438200 39600 1 LHST} - {3794137200 37800 0 LHST} - {3812887800 39600 1 LHST} - {3825586800 37800 0 LHST} - {3844337400 39600 1 LHST} - {3857641200 37800 0 LHST} - {3875787000 39600 1 LHST} - {3889090800 37800 0 LHST} - {3907236600 39600 1 LHST} - {3920540400 37800 0 LHST} - {3939291000 39600 1 LHST} - {3951990000 37800 0 LHST} - {3970740600 39600 1 LHST} - {3983439600 37800 0 LHST} - {4002190200 39600 1 LHST} - {4015494000 37800 0 LHST} - {4033639800 39600 1 LHST} - {4046943600 37800 0 LHST} - {4065089400 39600 1 LHST} - {4078393200 37800 0 LHST} - {4096539000 39600 1 LHST} + {1207407600 37800 0 LHST} + {1223134200 39600 1 LHST} + {1238857200 37800 0 LHST} + {1254583800 39600 1 LHST} + {1270306800 37800 0 LHST} + {1286033400 39600 1 LHST} + {1301756400 37800 0 LHST} + {1317483000 39600 1 LHST} + {1333206000 37800 0 LHST} + {1349537400 39600 1 LHST} + {1365260400 37800 0 LHST} + {1380987000 39600 1 LHST} + {1396710000 37800 0 LHST} + {1412436600 39600 1 LHST} + {1428159600 37800 0 LHST} + {1443886200 39600 1 LHST} + {1459609200 37800 0 LHST} + {1475335800 39600 1 LHST} + {1491058800 37800 0 LHST} + {1506785400 39600 1 LHST} + {1522508400 37800 0 LHST} + {1538839800 39600 1 LHST} + {1554562800 37800 0 LHST} + {1570289400 39600 1 LHST} + {1586012400 37800 0 LHST} + {1601739000 39600 1 LHST} + {1617462000 37800 0 LHST} + {1633188600 39600 1 LHST} + {1648911600 37800 0 LHST} + {1664638200 39600 1 LHST} + {1680361200 37800 0 LHST} + {1696087800 39600 1 LHST} + {1712415600 37800 0 LHST} + {1728142200 39600 1 LHST} + {1743865200 37800 0 LHST} + {1759591800 39600 1 LHST} + {1775314800 37800 0 LHST} + {1791041400 39600 1 LHST} + {1806764400 37800 0 LHST} + {1822491000 39600 1 LHST} + {1838214000 37800 0 LHST} + {1853940600 39600 1 LHST} + {1869663600 37800 0 LHST} + {1885995000 39600 1 LHST} + {1901718000 37800 0 LHST} + {1917444600 39600 1 LHST} + {1933167600 37800 0 LHST} + {1948894200 39600 1 LHST} + {1964617200 37800 0 LHST} + {1980343800 39600 1 LHST} + {1996066800 37800 0 LHST} + {2011793400 39600 1 LHST} + {2027516400 37800 0 LHST} + {2043243000 39600 1 LHST} + {2058966000 37800 0 LHST} + {2075297400 39600 1 LHST} + {2091020400 37800 0 LHST} + {2106747000 39600 1 LHST} + {2122470000 37800 0 LHST} + {2138196600 39600 1 LHST} + {2153919600 37800 0 LHST} + {2169646200 39600 1 LHST} + {2185369200 37800 0 LHST} + {2201095800 39600 1 LHST} + {2216818800 37800 0 LHST} + {2233150200 39600 1 LHST} + {2248873200 37800 0 LHST} + {2264599800 39600 1 LHST} + {2280322800 37800 0 LHST} + {2296049400 39600 1 LHST} + {2311772400 37800 0 LHST} + {2327499000 39600 1 LHST} + {2343222000 37800 0 LHST} + {2358948600 39600 1 LHST} + {2374671600 37800 0 LHST} + {2390398200 39600 1 LHST} + {2406121200 37800 0 LHST} + {2422452600 39600 1 LHST} + {2438175600 37800 0 LHST} + {2453902200 39600 1 LHST} + {2469625200 37800 0 LHST} + {2485351800 39600 1 LHST} + {2501074800 37800 0 LHST} + {2516801400 39600 1 LHST} + {2532524400 37800 0 LHST} + {2548251000 39600 1 LHST} + {2563974000 37800 0 LHST} + {2579700600 39600 1 LHST} + {2596028400 37800 0 LHST} + {2611755000 39600 1 LHST} + {2627478000 37800 0 LHST} + {2643204600 39600 1 LHST} + {2658927600 37800 0 LHST} + {2674654200 39600 1 LHST} + {2690377200 37800 0 LHST} + {2706103800 39600 1 LHST} + {2721826800 37800 0 LHST} + {2737553400 39600 1 LHST} + {2753276400 37800 0 LHST} + {2769607800 39600 1 LHST} + {2785330800 37800 0 LHST} + {2801057400 39600 1 LHST} + {2816780400 37800 0 LHST} + {2832507000 39600 1 LHST} + {2848230000 37800 0 LHST} + {2863956600 39600 1 LHST} + {2879679600 37800 0 LHST} + {2895406200 39600 1 LHST} + {2911129200 37800 0 LHST} + {2926855800 39600 1 LHST} + {2942578800 37800 0 LHST} + {2958910200 39600 1 LHST} + {2974633200 37800 0 LHST} + {2990359800 39600 1 LHST} + {3006082800 37800 0 LHST} + {3021809400 39600 1 LHST} + {3037532400 37800 0 LHST} + {3053259000 39600 1 LHST} + {3068982000 37800 0 LHST} + {3084708600 39600 1 LHST} + {3100431600 37800 0 LHST} + {3116763000 39600 1 LHST} + {3132486000 37800 0 LHST} + {3148212600 39600 1 LHST} + {3163935600 37800 0 LHST} + {3179662200 39600 1 LHST} + {3195385200 37800 0 LHST} + {3211111800 39600 1 LHST} + {3226834800 37800 0 LHST} + {3242561400 39600 1 LHST} + {3258284400 37800 0 LHST} + {3274011000 39600 1 LHST} + {3289734000 37800 0 LHST} + {3306065400 39600 1 LHST} + {3321788400 37800 0 LHST} + {3337515000 39600 1 LHST} + {3353238000 37800 0 LHST} + {3368964600 39600 1 LHST} + {3384687600 37800 0 LHST} + {3400414200 39600 1 LHST} + {3416137200 37800 0 LHST} + {3431863800 39600 1 LHST} + {3447586800 37800 0 LHST} + {3463313400 39600 1 LHST} + {3479641200 37800 0 LHST} + {3495367800 39600 1 LHST} + {3511090800 37800 0 LHST} + {3526817400 39600 1 LHST} + {3542540400 37800 0 LHST} + {3558267000 39600 1 LHST} + {3573990000 37800 0 LHST} + {3589716600 39600 1 LHST} + {3605439600 37800 0 LHST} + {3621166200 39600 1 LHST} + {3636889200 37800 0 LHST} + {3653220600 39600 1 LHST} + {3668943600 37800 0 LHST} + {3684670200 39600 1 LHST} + {3700393200 37800 0 LHST} + {3716119800 39600 1 LHST} + {3731842800 37800 0 LHST} + {3747569400 39600 1 LHST} + {3763292400 37800 0 LHST} + {3779019000 39600 1 LHST} + {3794742000 37800 0 LHST} + {3810468600 39600 1 LHST} + {3826191600 37800 0 LHST} + {3842523000 39600 1 LHST} + {3858246000 37800 0 LHST} + {3873972600 39600 1 LHST} + {3889695600 37800 0 LHST} + {3905422200 39600 1 LHST} + {3921145200 37800 0 LHST} + {3936871800 39600 1 LHST} + {3952594800 37800 0 LHST} + {3968321400 39600 1 LHST} + {3984044400 37800 0 LHST} + {4000375800 39600 1 LHST} + {4016098800 37800 0 LHST} + {4031825400 39600 1 LHST} + {4047548400 37800 0 LHST} + {4063275000 39600 1 LHST} + {4078998000 37800 0 LHST} + {4094724600 39600 1 LHST} } diff --git a/library/tzdata/Australia/Melbourne b/library/tzdata/Australia/Melbourne index fc5314d..907b8b9 100644 --- a/library/tzdata/Australia/Melbourne +++ b/library/tzdata/Australia/Melbourne @@ -85,188 +85,188 @@ set TZData(:Australia/Melbourne) { {1162051200 39600 1 EST} {1174752000 36000 0 EST} {1193500800 39600 1 EST} - {1206806400 36000 0 EST} - {1224950400 39600 1 EST} - {1238256000 36000 0 EST} - {1256400000 39600 1 EST} - {1269705600 36000 0 EST} - {1288454400 39600 1 EST} - {1301155200 36000 0 EST} - {1319904000 39600 1 EST} - {1332604800 36000 0 EST} - {1351353600 39600 1 EST} - {1364659200 36000 0 EST} - {1382803200 39600 1 EST} - {1396108800 36000 0 EST} - {1414252800 39600 1 EST} - {1427558400 36000 0 EST} - {1445702400 39600 1 EST} - {1459008000 36000 0 EST} - {1477756800 39600 1 EST} - {1490457600 36000 0 EST} - {1509206400 39600 1 EST} - {1521907200 36000 0 EST} - {1540656000 39600 1 EST} - {1553961600 36000 0 EST} - {1572105600 39600 1 EST} - {1585411200 36000 0 EST} - {1603555200 39600 1 EST} - {1616860800 36000 0 EST} - {1635609600 39600 1 EST} - {1648310400 36000 0 EST} - {1667059200 39600 1 EST} - {1679760000 36000 0 EST} - {1698508800 39600 1 EST} - {1711814400 36000 0 EST} - {1729958400 39600 1 EST} - {1743264000 36000 0 EST} - {1761408000 39600 1 EST} - {1774713600 36000 0 EST} - {1792857600 39600 1 EST} - {1806163200 36000 0 EST} - {1824912000 39600 1 EST} - {1837612800 36000 0 EST} - {1856361600 39600 1 EST} - {1869062400 36000 0 EST} - {1887811200 39600 1 EST} - {1901116800 36000 0 EST} - {1919260800 39600 1 EST} - {1932566400 36000 0 EST} - {1950710400 39600 1 EST} - {1964016000 36000 0 EST} - {1982764800 39600 1 EST} - {1995465600 36000 0 EST} - {2014214400 39600 1 EST} - {2026915200 36000 0 EST} - {2045664000 39600 1 EST} - {2058364800 36000 0 EST} - {2077113600 39600 1 EST} - {2090419200 36000 0 EST} - {2108563200 39600 1 EST} - {2121868800 36000 0 EST} - {2140012800 39600 1 EST} - {2153318400 36000 0 EST} - {2172067200 39600 1 EST} - {2184768000 36000 0 EST} - {2203516800 39600 1 EST} - {2216217600 36000 0 EST} - {2234966400 39600 1 EST} - {2248272000 36000 0 EST} - {2266416000 39600 1 EST} - {2279721600 36000 0 EST} - {2297865600 39600 1 EST} - {2311171200 36000 0 EST} - {2329315200 39600 1 EST} - {2342620800 36000 0 EST} - {2361369600 39600 1 EST} - {2374070400 36000 0 EST} - {2392819200 39600 1 EST} - {2405520000 36000 0 EST} - {2424268800 39600 1 EST} - {2437574400 36000 0 EST} - {2455718400 39600 1 EST} - {2469024000 36000 0 EST} - {2487168000 39600 1 EST} - {2500473600 36000 0 EST} - {2519222400 39600 1 EST} - {2531923200 36000 0 EST} - {2550672000 39600 1 EST} - {2563372800 36000 0 EST} - {2582121600 39600 1 EST} - {2595427200 36000 0 EST} - {2613571200 39600 1 EST} - {2626876800 36000 0 EST} - {2645020800 39600 1 EST} - {2658326400 36000 0 EST} - {2676470400 39600 1 EST} - {2689776000 36000 0 EST} - {2708524800 39600 1 EST} - {2721225600 36000 0 EST} - {2739974400 39600 1 EST} - {2752675200 36000 0 EST} - {2771424000 39600 1 EST} - {2784729600 36000 0 EST} - {2802873600 39600 1 EST} - {2816179200 36000 0 EST} - {2834323200 39600 1 EST} - {2847628800 36000 0 EST} - {2866377600 39600 1 EST} - {2879078400 36000 0 EST} - {2897827200 39600 1 EST} - {2910528000 36000 0 EST} - {2929276800 39600 1 EST} - {2941977600 36000 0 EST} - {2960726400 39600 1 EST} - {2974032000 36000 0 EST} - {2992176000 39600 1 EST} - {3005481600 36000 0 EST} - {3023625600 39600 1 EST} - {3036931200 36000 0 EST} - {3055680000 39600 1 EST} - {3068380800 36000 0 EST} - {3087129600 39600 1 EST} - {3099830400 36000 0 EST} - {3118579200 39600 1 EST} - {3131884800 36000 0 EST} - {3150028800 39600 1 EST} - {3163334400 36000 0 EST} - {3181478400 39600 1 EST} - {3194784000 36000 0 EST} - {3212928000 39600 1 EST} - {3226233600 36000 0 EST} - {3244982400 39600 1 EST} - {3257683200 36000 0 EST} - {3276432000 39600 1 EST} - {3289132800 36000 0 EST} - {3307881600 39600 1 EST} - {3321187200 36000 0 EST} - {3339331200 39600 1 EST} - {3352636800 36000 0 EST} - {3370780800 39600 1 EST} - {3384086400 36000 0 EST} - {3402835200 39600 1 EST} - {3415536000 36000 0 EST} - {3434284800 39600 1 EST} - {3446985600 36000 0 EST} - {3465734400 39600 1 EST} - {3479040000 36000 0 EST} - {3497184000 39600 1 EST} - {3510489600 36000 0 EST} - {3528633600 39600 1 EST} - {3541939200 36000 0 EST} - {3560083200 39600 1 EST} - {3573388800 36000 0 EST} - {3592137600 39600 1 EST} - {3604838400 36000 0 EST} - {3623587200 39600 1 EST} - {3636288000 36000 0 EST} - {3655036800 39600 1 EST} - {3668342400 36000 0 EST} - {3686486400 39600 1 EST} - {3699792000 36000 0 EST} - {3717936000 39600 1 EST} - {3731241600 36000 0 EST} - {3749990400 39600 1 EST} - {3762691200 36000 0 EST} - {3781440000 39600 1 EST} - {3794140800 36000 0 EST} - {3812889600 39600 1 EST} - {3825590400 36000 0 EST} - {3844339200 39600 1 EST} - {3857644800 36000 0 EST} - {3875788800 39600 1 EST} - {3889094400 36000 0 EST} - {3907238400 39600 1 EST} - {3920544000 36000 0 EST} - {3939292800 39600 1 EST} - {3951993600 36000 0 EST} - {3970742400 39600 1 EST} - {3983443200 36000 0 EST} - {4002192000 39600 1 EST} - {4015497600 36000 0 EST} - {4033641600 39600 1 EST} - {4046947200 36000 0 EST} - {4065091200 39600 1 EST} - {4078396800 36000 0 EST} - {4096540800 39600 1 EST} + {1207411200 36000 0 EST} + {1223136000 39600 1 EST} + {1238860800 36000 0 EST} + {1254585600 39600 1 EST} + {1270310400 36000 0 EST} + {1286035200 39600 1 EST} + {1301760000 36000 0 EST} + {1317484800 39600 1 EST} + {1333209600 36000 0 EST} + {1349539200 39600 1 EST} + {1365264000 36000 0 EST} + {1380988800 39600 1 EST} + {1396713600 36000 0 EST} + {1412438400 39600 1 EST} + {1428163200 36000 0 EST} + {1443888000 39600 1 EST} + {1459612800 36000 0 EST} + {1475337600 39600 1 EST} + {1491062400 36000 0 EST} + {1506787200 39600 1 EST} + {1522512000 36000 0 EST} + {1538841600 39600 1 EST} + {1554566400 36000 0 EST} + {1570291200 39600 1 EST} + {1586016000 36000 0 EST} + {1601740800 39600 1 EST} + {1617465600 36000 0 EST} + {1633190400 39600 1 EST} + {1648915200 36000 0 EST} + {1664640000 39600 1 EST} + {1680364800 36000 0 EST} + {1696089600 39600 1 EST} + {1712419200 36000 0 EST} + {1728144000 39600 1 EST} + {1743868800 36000 0 EST} + {1759593600 39600 1 EST} + {1775318400 36000 0 EST} + {1791043200 39600 1 EST} + {1806768000 36000 0 EST} + {1822492800 39600 1 EST} + {1838217600 36000 0 EST} + {1853942400 39600 1 EST} + {1869667200 36000 0 EST} + {1885996800 39600 1 EST} + {1901721600 36000 0 EST} + {1917446400 39600 1 EST} + {1933171200 36000 0 EST} + {1948896000 39600 1 EST} + {1964620800 36000 0 EST} + {1980345600 39600 1 EST} + {1996070400 36000 0 EST} + {2011795200 39600 1 EST} + {2027520000 36000 0 EST} + {2043244800 39600 1 EST} + {2058969600 36000 0 EST} + {2075299200 39600 1 EST} + {2091024000 36000 0 EST} + {2106748800 39600 1 EST} + {2122473600 36000 0 EST} + {2138198400 39600 1 EST} + {2153923200 36000 0 EST} + {2169648000 39600 1 EST} + {2185372800 36000 0 EST} + {2201097600 39600 1 EST} + {2216822400 36000 0 EST} + {2233152000 39600 1 EST} + {2248876800 36000 0 EST} + {2264601600 39600 1 EST} + {2280326400 36000 0 EST} + {2296051200 39600 1 EST} + {2311776000 36000 0 EST} + {2327500800 39600 1 EST} + {2343225600 36000 0 EST} + {2358950400 39600 1 EST} + {2374675200 36000 0 EST} + {2390400000 39600 1 EST} + {2406124800 36000 0 EST} + {2422454400 39600 1 EST} + {2438179200 36000 0 EST} + {2453904000 39600 1 EST} + {2469628800 36000 0 EST} + {2485353600 39600 1 EST} + {2501078400 36000 0 EST} + {2516803200 39600 1 EST} + {2532528000 36000 0 EST} + {2548252800 39600 1 EST} + {2563977600 36000 0 EST} + {2579702400 39600 1 EST} + {2596032000 36000 0 EST} + {2611756800 39600 1 EST} + {2627481600 36000 0 EST} + {2643206400 39600 1 EST} + {2658931200 36000 0 EST} + {2674656000 39600 1 EST} + {2690380800 36000 0 EST} + {2706105600 39600 1 EST} + {2721830400 36000 0 EST} + {2737555200 39600 1 EST} + {2753280000 36000 0 EST} + {2769609600 39600 1 EST} + {2785334400 36000 0 EST} + {2801059200 39600 1 EST} + {2816784000 36000 0 EST} + {2832508800 39600 1 EST} + {2848233600 36000 0 EST} + {2863958400 39600 1 EST} + {2879683200 36000 0 EST} + {2895408000 39600 1 EST} + {2911132800 36000 0 EST} + {2926857600 39600 1 EST} + {2942582400 36000 0 EST} + {2958912000 39600 1 EST} + {2974636800 36000 0 EST} + {2990361600 39600 1 EST} + {3006086400 36000 0 EST} + {3021811200 39600 1 EST} + {3037536000 36000 0 EST} + {3053260800 39600 1 EST} + {3068985600 36000 0 EST} + {3084710400 39600 1 EST} + {3100435200 36000 0 EST} + {3116764800 39600 1 EST} + {3132489600 36000 0 EST} + {3148214400 39600 1 EST} + {3163939200 36000 0 EST} + {3179664000 39600 1 EST} + {3195388800 36000 0 EST} + {3211113600 39600 1 EST} + {3226838400 36000 0 EST} + {3242563200 39600 1 EST} + {3258288000 36000 0 EST} + {3274012800 39600 1 EST} + {3289737600 36000 0 EST} + {3306067200 39600 1 EST} + {3321792000 36000 0 EST} + {3337516800 39600 1 EST} + {3353241600 36000 0 EST} + {3368966400 39600 1 EST} + {3384691200 36000 0 EST} + {3400416000 39600 1 EST} + {3416140800 36000 0 EST} + {3431865600 39600 1 EST} + {3447590400 36000 0 EST} + {3463315200 39600 1 EST} + {3479644800 36000 0 EST} + {3495369600 39600 1 EST} + {3511094400 36000 0 EST} + {3526819200 39600 1 EST} + {3542544000 36000 0 EST} + {3558268800 39600 1 EST} + {3573993600 36000 0 EST} + {3589718400 39600 1 EST} + {3605443200 36000 0 EST} + {3621168000 39600 1 EST} + {3636892800 36000 0 EST} + {3653222400 39600 1 EST} + {3668947200 36000 0 EST} + {3684672000 39600 1 EST} + {3700396800 36000 0 EST} + {3716121600 39600 1 EST} + {3731846400 36000 0 EST} + {3747571200 39600 1 EST} + {3763296000 36000 0 EST} + {3779020800 39600 1 EST} + {3794745600 36000 0 EST} + {3810470400 39600 1 EST} + {3826195200 36000 0 EST} + {3842524800 39600 1 EST} + {3858249600 36000 0 EST} + {3873974400 39600 1 EST} + {3889699200 36000 0 EST} + {3905424000 39600 1 EST} + {3921148800 36000 0 EST} + {3936873600 39600 1 EST} + {3952598400 36000 0 EST} + {3968323200 39600 1 EST} + {3984048000 36000 0 EST} + {4000377600 39600 1 EST} + {4016102400 36000 0 EST} + {4031827200 39600 1 EST} + {4047552000 36000 0 EST} + {4063276800 39600 1 EST} + {4079001600 36000 0 EST} + {4094726400 39600 1 EST} } diff --git a/library/tzdata/Australia/Sydney b/library/tzdata/Australia/Sydney index fa0edcc..84b1d14 100644 --- a/library/tzdata/Australia/Sydney +++ b/library/tzdata/Australia/Sydney @@ -85,188 +85,188 @@ set TZData(:Australia/Sydney) { {1162051200 39600 1 EST} {1174752000 36000 0 EST} {1193500800 39600 1 EST} - {1206806400 36000 0 EST} - {1224950400 39600 1 EST} - {1238256000 36000 0 EST} - {1256400000 39600 1 EST} - {1269705600 36000 0 EST} - {1288454400 39600 1 EST} - {1301155200 36000 0 EST} - {1319904000 39600 1 EST} - {1332604800 36000 0 EST} - {1351353600 39600 1 EST} - {1364659200 36000 0 EST} - {1382803200 39600 1 EST} - {1396108800 36000 0 EST} - {1414252800 39600 1 EST} - {1427558400 36000 0 EST} - {1445702400 39600 1 EST} - {1459008000 36000 0 EST} - {1477756800 39600 1 EST} - {1490457600 36000 0 EST} - {1509206400 39600 1 EST} - {1521907200 36000 0 EST} - {1540656000 39600 1 EST} - {1553961600 36000 0 EST} - {1572105600 39600 1 EST} - {1585411200 36000 0 EST} - {1603555200 39600 1 EST} - {1616860800 36000 0 EST} - {1635609600 39600 1 EST} - {1648310400 36000 0 EST} - {1667059200 39600 1 EST} - {1679760000 36000 0 EST} - {1698508800 39600 1 EST} - {1711814400 36000 0 EST} - {1729958400 39600 1 EST} - {1743264000 36000 0 EST} - {1761408000 39600 1 EST} - {1774713600 36000 0 EST} - {1792857600 39600 1 EST} - {1806163200 36000 0 EST} - {1824912000 39600 1 EST} - {1837612800 36000 0 EST} - {1856361600 39600 1 EST} - {1869062400 36000 0 EST} - {1887811200 39600 1 EST} - {1901116800 36000 0 EST} - {1919260800 39600 1 EST} - {1932566400 36000 0 EST} - {1950710400 39600 1 EST} - {1964016000 36000 0 EST} - {1982764800 39600 1 EST} - {1995465600 36000 0 EST} - {2014214400 39600 1 EST} - {2026915200 36000 0 EST} - {2045664000 39600 1 EST} - {2058364800 36000 0 EST} - {2077113600 39600 1 EST} - {2090419200 36000 0 EST} - {2108563200 39600 1 EST} - {2121868800 36000 0 EST} - {2140012800 39600 1 EST} - {2153318400 36000 0 EST} - {2172067200 39600 1 EST} - {2184768000 36000 0 EST} - {2203516800 39600 1 EST} - {2216217600 36000 0 EST} - {2234966400 39600 1 EST} - {2248272000 36000 0 EST} - {2266416000 39600 1 EST} - {2279721600 36000 0 EST} - {2297865600 39600 1 EST} - {2311171200 36000 0 EST} - {2329315200 39600 1 EST} - {2342620800 36000 0 EST} - {2361369600 39600 1 EST} - {2374070400 36000 0 EST} - {2392819200 39600 1 EST} - {2405520000 36000 0 EST} - {2424268800 39600 1 EST} - {2437574400 36000 0 EST} - {2455718400 39600 1 EST} - {2469024000 36000 0 EST} - {2487168000 39600 1 EST} - {2500473600 36000 0 EST} - {2519222400 39600 1 EST} - {2531923200 36000 0 EST} - {2550672000 39600 1 EST} - {2563372800 36000 0 EST} - {2582121600 39600 1 EST} - {2595427200 36000 0 EST} - {2613571200 39600 1 EST} - {2626876800 36000 0 EST} - {2645020800 39600 1 EST} - {2658326400 36000 0 EST} - {2676470400 39600 1 EST} - {2689776000 36000 0 EST} - {2708524800 39600 1 EST} - {2721225600 36000 0 EST} - {2739974400 39600 1 EST} - {2752675200 36000 0 EST} - {2771424000 39600 1 EST} - {2784729600 36000 0 EST} - {2802873600 39600 1 EST} - {2816179200 36000 0 EST} - {2834323200 39600 1 EST} - {2847628800 36000 0 EST} - {2866377600 39600 1 EST} - {2879078400 36000 0 EST} - {2897827200 39600 1 EST} - {2910528000 36000 0 EST} - {2929276800 39600 1 EST} - {2941977600 36000 0 EST} - {2960726400 39600 1 EST} - {2974032000 36000 0 EST} - {2992176000 39600 1 EST} - {3005481600 36000 0 EST} - {3023625600 39600 1 EST} - {3036931200 36000 0 EST} - {3055680000 39600 1 EST} - {3068380800 36000 0 EST} - {3087129600 39600 1 EST} - {3099830400 36000 0 EST} - {3118579200 39600 1 EST} - {3131884800 36000 0 EST} - {3150028800 39600 1 EST} - {3163334400 36000 0 EST} - {3181478400 39600 1 EST} - {3194784000 36000 0 EST} - {3212928000 39600 1 EST} - {3226233600 36000 0 EST} - {3244982400 39600 1 EST} - {3257683200 36000 0 EST} - {3276432000 39600 1 EST} - {3289132800 36000 0 EST} - {3307881600 39600 1 EST} - {3321187200 36000 0 EST} - {3339331200 39600 1 EST} - {3352636800 36000 0 EST} - {3370780800 39600 1 EST} - {3384086400 36000 0 EST} - {3402835200 39600 1 EST} - {3415536000 36000 0 EST} - {3434284800 39600 1 EST} - {3446985600 36000 0 EST} - {3465734400 39600 1 EST} - {3479040000 36000 0 EST} - {3497184000 39600 1 EST} - {3510489600 36000 0 EST} - {3528633600 39600 1 EST} - {3541939200 36000 0 EST} - {3560083200 39600 1 EST} - {3573388800 36000 0 EST} - {3592137600 39600 1 EST} - {3604838400 36000 0 EST} - {3623587200 39600 1 EST} - {3636288000 36000 0 EST} - {3655036800 39600 1 EST} - {3668342400 36000 0 EST} - {3686486400 39600 1 EST} - {3699792000 36000 0 EST} - {3717936000 39600 1 EST} - {3731241600 36000 0 EST} - {3749990400 39600 1 EST} - {3762691200 36000 0 EST} - {3781440000 39600 1 EST} - {3794140800 36000 0 EST} - {3812889600 39600 1 EST} - {3825590400 36000 0 EST} - {3844339200 39600 1 EST} - {3857644800 36000 0 EST} - {3875788800 39600 1 EST} - {3889094400 36000 0 EST} - {3907238400 39600 1 EST} - {3920544000 36000 0 EST} - {3939292800 39600 1 EST} - {3951993600 36000 0 EST} - {3970742400 39600 1 EST} - {3983443200 36000 0 EST} - {4002192000 39600 1 EST} - {4015497600 36000 0 EST} - {4033641600 39600 1 EST} - {4046947200 36000 0 EST} - {4065091200 39600 1 EST} - {4078396800 36000 0 EST} - {4096540800 39600 1 EST} + {1207411200 36000 0 EST} + {1223136000 39600 1 EST} + {1238860800 36000 0 EST} + {1254585600 39600 1 EST} + {1270310400 36000 0 EST} + {1286035200 39600 1 EST} + {1301760000 36000 0 EST} + {1317484800 39600 1 EST} + {1333209600 36000 0 EST} + {1349539200 39600 1 EST} + {1365264000 36000 0 EST} + {1380988800 39600 1 EST} + {1396713600 36000 0 EST} + {1412438400 39600 1 EST} + {1428163200 36000 0 EST} + {1443888000 39600 1 EST} + {1459612800 36000 0 EST} + {1475337600 39600 1 EST} + {1491062400 36000 0 EST} + {1506787200 39600 1 EST} + {1522512000 36000 0 EST} + {1538841600 39600 1 EST} + {1554566400 36000 0 EST} + {1570291200 39600 1 EST} + {1586016000 36000 0 EST} + {1601740800 39600 1 EST} + {1617465600 36000 0 EST} + {1633190400 39600 1 EST} + {1648915200 36000 0 EST} + {1664640000 39600 1 EST} + {1680364800 36000 0 EST} + {1696089600 39600 1 EST} + {1712419200 36000 0 EST} + {1728144000 39600 1 EST} + {1743868800 36000 0 EST} + {1759593600 39600 1 EST} + {1775318400 36000 0 EST} + {1791043200 39600 1 EST} + {1806768000 36000 0 EST} + {1822492800 39600 1 EST} + {1838217600 36000 0 EST} + {1853942400 39600 1 EST} + {1869667200 36000 0 EST} + {1885996800 39600 1 EST} + {1901721600 36000 0 EST} + {1917446400 39600 1 EST} + {1933171200 36000 0 EST} + {1948896000 39600 1 EST} + {1964620800 36000 0 EST} + {1980345600 39600 1 EST} + {1996070400 36000 0 EST} + {2011795200 39600 1 EST} + {2027520000 36000 0 EST} + {2043244800 39600 1 EST} + {2058969600 36000 0 EST} + {2075299200 39600 1 EST} + {2091024000 36000 0 EST} + {2106748800 39600 1 EST} + {2122473600 36000 0 EST} + {2138198400 39600 1 EST} + {2153923200 36000 0 EST} + {2169648000 39600 1 EST} + {2185372800 36000 0 EST} + {2201097600 39600 1 EST} + {2216822400 36000 0 EST} + {2233152000 39600 1 EST} + {2248876800 36000 0 EST} + {2264601600 39600 1 EST} + {2280326400 36000 0 EST} + {2296051200 39600 1 EST} + {2311776000 36000 0 EST} + {2327500800 39600 1 EST} + {2343225600 36000 0 EST} + {2358950400 39600 1 EST} + {2374675200 36000 0 EST} + {2390400000 39600 1 EST} + {2406124800 36000 0 EST} + {2422454400 39600 1 EST} + {2438179200 36000 0 EST} + {2453904000 39600 1 EST} + {2469628800 36000 0 EST} + {2485353600 39600 1 EST} + {2501078400 36000 0 EST} + {2516803200 39600 1 EST} + {2532528000 36000 0 EST} + {2548252800 39600 1 EST} + {2563977600 36000 0 EST} + {2579702400 39600 1 EST} + {2596032000 36000 0 EST} + {2611756800 39600 1 EST} + {2627481600 36000 0 EST} + {2643206400 39600 1 EST} + {2658931200 36000 0 EST} + {2674656000 39600 1 EST} + {2690380800 36000 0 EST} + {2706105600 39600 1 EST} + {2721830400 36000 0 EST} + {2737555200 39600 1 EST} + {2753280000 36000 0 EST} + {2769609600 39600 1 EST} + {2785334400 36000 0 EST} + {2801059200 39600 1 EST} + {2816784000 36000 0 EST} + {2832508800 39600 1 EST} + {2848233600 36000 0 EST} + {2863958400 39600 1 EST} + {2879683200 36000 0 EST} + {2895408000 39600 1 EST} + {2911132800 36000 0 EST} + {2926857600 39600 1 EST} + {2942582400 36000 0 EST} + {2958912000 39600 1 EST} + {2974636800 36000 0 EST} + {2990361600 39600 1 EST} + {3006086400 36000 0 EST} + {3021811200 39600 1 EST} + {3037536000 36000 0 EST} + {3053260800 39600 1 EST} + {3068985600 36000 0 EST} + {3084710400 39600 1 EST} + {3100435200 36000 0 EST} + {3116764800 39600 1 EST} + {3132489600 36000 0 EST} + {3148214400 39600 1 EST} + {3163939200 36000 0 EST} + {3179664000 39600 1 EST} + {3195388800 36000 0 EST} + {3211113600 39600 1 EST} + {3226838400 36000 0 EST} + {3242563200 39600 1 EST} + {3258288000 36000 0 EST} + {3274012800 39600 1 EST} + {3289737600 36000 0 EST} + {3306067200 39600 1 EST} + {3321792000 36000 0 EST} + {3337516800 39600 1 EST} + {3353241600 36000 0 EST} + {3368966400 39600 1 EST} + {3384691200 36000 0 EST} + {3400416000 39600 1 EST} + {3416140800 36000 0 EST} + {3431865600 39600 1 EST} + {3447590400 36000 0 EST} + {3463315200 39600 1 EST} + {3479644800 36000 0 EST} + {3495369600 39600 1 EST} + {3511094400 36000 0 EST} + {3526819200 39600 1 EST} + {3542544000 36000 0 EST} + {3558268800 39600 1 EST} + {3573993600 36000 0 EST} + {3589718400 39600 1 EST} + {3605443200 36000 0 EST} + {3621168000 39600 1 EST} + {3636892800 36000 0 EST} + {3653222400 39600 1 EST} + {3668947200 36000 0 EST} + {3684672000 39600 1 EST} + {3700396800 36000 0 EST} + {3716121600 39600 1 EST} + {3731846400 36000 0 EST} + {3747571200 39600 1 EST} + {3763296000 36000 0 EST} + {3779020800 39600 1 EST} + {3794745600 36000 0 EST} + {3810470400 39600 1 EST} + {3826195200 36000 0 EST} + {3842524800 39600 1 EST} + {3858249600 36000 0 EST} + {3873974400 39600 1 EST} + {3889699200 36000 0 EST} + {3905424000 39600 1 EST} + {3921148800 36000 0 EST} + {3936873600 39600 1 EST} + {3952598400 36000 0 EST} + {3968323200 39600 1 EST} + {3984048000 36000 0 EST} + {4000377600 39600 1 EST} + {4016102400 36000 0 EST} + {4031827200 39600 1 EST} + {4047552000 36000 0 EST} + {4063276800 39600 1 EST} + {4079001600 36000 0 EST} + {4094726400 39600 1 EST} } diff --git a/library/tzdata/Pacific/Auckland b/library/tzdata/Pacific/Auckland index 4e85a92..5f7e238 100644 --- a/library/tzdata/Pacific/Auckland +++ b/library/tzdata/Pacific/Auckland @@ -97,189 +97,189 @@ set TZData(:Pacific/Auckland) { {1142690400 43200 0 NZST} {1159624800 46800 1 NZDT} {1174140000 43200 0 NZST} - {1191679200 46800 1 NZDT} - {1205589600 43200 0 NZST} - {1223128800 46800 1 NZDT} - {1237039200 43200 0 NZST} - {1254578400 46800 1 NZDT} - {1269093600 43200 0 NZST} - {1286028000 46800 1 NZDT} - {1300543200 43200 0 NZST} - {1317477600 46800 1 NZDT} - {1331992800 43200 0 NZST} - {1349532000 46800 1 NZDT} - {1363442400 43200 0 NZST} - {1380981600 46800 1 NZDT} - {1394892000 43200 0 NZST} - {1412431200 46800 1 NZDT} - {1426341600 43200 0 NZST} - {1443880800 46800 1 NZDT} - {1458396000 43200 0 NZST} - {1475330400 46800 1 NZDT} - {1489845600 43200 0 NZST} - {1506780000 46800 1 NZDT} - {1521295200 43200 0 NZST} - {1538834400 46800 1 NZDT} - {1552744800 43200 0 NZST} - {1570284000 46800 1 NZDT} - {1584194400 43200 0 NZST} - {1601733600 46800 1 NZDT} - {1616248800 43200 0 NZST} - {1633183200 46800 1 NZDT} - {1647698400 43200 0 NZST} - {1664632800 46800 1 NZDT} - {1679148000 43200 0 NZST} - {1696082400 46800 1 NZDT} - {1710597600 43200 0 NZST} - {1728136800 46800 1 NZDT} - {1742047200 43200 0 NZST} - {1759586400 46800 1 NZDT} - {1773496800 43200 0 NZST} - {1791036000 46800 1 NZDT} - {1805551200 43200 0 NZST} - {1822485600 46800 1 NZDT} - {1837000800 43200 0 NZST} - {1853935200 46800 1 NZDT} - {1868450400 43200 0 NZST} - {1885989600 46800 1 NZDT} - {1899900000 43200 0 NZST} - {1917439200 46800 1 NZDT} - {1931349600 43200 0 NZST} - {1948888800 46800 1 NZDT} - {1963404000 43200 0 NZST} - {1980338400 46800 1 NZDT} - {1994853600 43200 0 NZST} - {2011788000 46800 1 NZDT} - {2026303200 43200 0 NZST} - {2043237600 46800 1 NZDT} - {2057752800 43200 0 NZST} - {2075292000 46800 1 NZDT} - {2089202400 43200 0 NZST} - {2106741600 46800 1 NZDT} - {2120652000 43200 0 NZST} - {2138191200 46800 1 NZDT} - {2152706400 43200 0 NZST} - {2169640800 46800 1 NZDT} - {2184156000 43200 0 NZST} - {2201090400 46800 1 NZDT} - {2215605600 43200 0 NZST} - {2233144800 46800 1 NZDT} - {2247055200 43200 0 NZST} - {2264594400 46800 1 NZDT} - {2278504800 43200 0 NZST} - {2296044000 46800 1 NZDT} - {2309954400 43200 0 NZST} - {2327493600 46800 1 NZDT} - {2342008800 43200 0 NZST} - {2358943200 46800 1 NZDT} - {2373458400 43200 0 NZST} - {2390392800 46800 1 NZDT} - {2404908000 43200 0 NZST} - {2422447200 46800 1 NZDT} - {2436357600 43200 0 NZST} - {2453896800 46800 1 NZDT} - {2467807200 43200 0 NZST} - {2485346400 46800 1 NZDT} - {2499861600 43200 0 NZST} - {2516796000 46800 1 NZDT} - {2531311200 43200 0 NZST} - {2548245600 46800 1 NZDT} - {2562760800 43200 0 NZST} - {2579695200 46800 1 NZDT} - {2594210400 43200 0 NZST} - {2611749600 46800 1 NZDT} - {2625660000 43200 0 NZST} - {2643199200 46800 1 NZDT} - {2657109600 43200 0 NZST} - {2674648800 46800 1 NZDT} - {2689164000 43200 0 NZST} - {2706098400 46800 1 NZDT} - {2720613600 43200 0 NZST} - {2737548000 46800 1 NZDT} - {2752063200 43200 0 NZST} - {2769602400 46800 1 NZDT} - {2783512800 43200 0 NZST} - {2801052000 46800 1 NZDT} - {2814962400 43200 0 NZST} - {2832501600 46800 1 NZDT} - {2847016800 43200 0 NZST} - {2863951200 46800 1 NZDT} - {2878466400 43200 0 NZST} - {2895400800 46800 1 NZDT} - {2909916000 43200 0 NZST} - {2926850400 46800 1 NZDT} - {2941365600 43200 0 NZST} - {2958904800 46800 1 NZDT} - {2972815200 43200 0 NZST} - {2990354400 46800 1 NZDT} - {3004264800 43200 0 NZST} - {3021804000 46800 1 NZDT} - {3036319200 43200 0 NZST} - {3053253600 46800 1 NZDT} - {3067768800 43200 0 NZST} - {3084703200 46800 1 NZDT} - {3099218400 43200 0 NZST} - {3116757600 46800 1 NZDT} - {3130668000 43200 0 NZST} - {3148207200 46800 1 NZDT} - {3162117600 43200 0 NZST} - {3179656800 46800 1 NZDT} - {3193567200 43200 0 NZST} - {3211106400 46800 1 NZDT} - {3225621600 43200 0 NZST} - {3242556000 46800 1 NZDT} - {3257071200 43200 0 NZST} - {3274005600 46800 1 NZDT} - {3288520800 43200 0 NZST} - {3306060000 46800 1 NZDT} - {3319970400 43200 0 NZST} - {3337509600 46800 1 NZDT} - {3351420000 43200 0 NZST} - {3368959200 46800 1 NZDT} - {3383474400 43200 0 NZST} - {3400408800 46800 1 NZDT} - {3414924000 43200 0 NZST} - {3431858400 46800 1 NZDT} - {3446373600 43200 0 NZST} - {3463308000 46800 1 NZDT} - {3477823200 43200 0 NZST} - {3495362400 46800 1 NZDT} - {3509272800 43200 0 NZST} - {3526812000 46800 1 NZDT} - {3540722400 43200 0 NZST} - {3558261600 46800 1 NZDT} - {3572776800 43200 0 NZST} - {3589711200 46800 1 NZDT} - {3604226400 43200 0 NZST} - {3621160800 46800 1 NZDT} - {3635676000 43200 0 NZST} - {3653215200 46800 1 NZDT} - {3667125600 43200 0 NZST} - {3684664800 46800 1 NZDT} - {3698575200 43200 0 NZST} - {3716114400 46800 1 NZDT} - {3730629600 43200 0 NZST} - {3747564000 46800 1 NZDT} - {3762079200 43200 0 NZST} - {3779013600 46800 1 NZDT} - {3793528800 43200 0 NZST} - {3810463200 46800 1 NZDT} - {3824978400 43200 0 NZST} - {3842517600 46800 1 NZDT} - {3856428000 43200 0 NZST} - {3873967200 46800 1 NZDT} - {3887877600 43200 0 NZST} - {3905416800 46800 1 NZDT} - {3919932000 43200 0 NZST} - {3936866400 46800 1 NZDT} - {3951381600 43200 0 NZST} - {3968316000 46800 1 NZDT} - {3982831200 43200 0 NZST} - {4000370400 46800 1 NZDT} - {4014280800 43200 0 NZST} - {4031820000 46800 1 NZDT} - {4045730400 43200 0 NZST} - {4063269600 46800 1 NZDT} - {4077180000 43200 0 NZST} - {4094719200 46800 1 NZDT} + {1191074400 46800 1 NZDT} + {1207404000 43200 0 NZST} + {1222524000 46800 1 NZDT} + {1238853600 43200 0 NZST} + {1253973600 46800 1 NZDT} + {1270303200 43200 0 NZST} + {1285423200 46800 1 NZDT} + {1301752800 43200 0 NZST} + {1316872800 46800 1 NZDT} + {1333202400 43200 0 NZST} + {1348927200 46800 1 NZDT} + {1365256800 43200 0 NZST} + {1380376800 46800 1 NZDT} + {1396706400 43200 0 NZST} + {1411826400 46800 1 NZDT} + {1428156000 43200 0 NZST} + {1443276000 46800 1 NZDT} + {1459605600 43200 0 NZST} + {1474725600 46800 1 NZDT} + {1491055200 43200 0 NZST} + {1506175200 46800 1 NZDT} + {1522504800 43200 0 NZST} + {1538229600 46800 1 NZDT} + {1554559200 43200 0 NZST} + {1569679200 46800 1 NZDT} + {1586008800 43200 0 NZST} + {1601128800 46800 1 NZDT} + {1617458400 43200 0 NZST} + {1632578400 46800 1 NZDT} + {1648908000 43200 0 NZST} + {1664028000 46800 1 NZDT} + {1680357600 43200 0 NZST} + {1695477600 46800 1 NZDT} + {1712412000 43200 0 NZST} + {1727532000 46800 1 NZDT} + {1743861600 43200 0 NZST} + {1758981600 46800 1 NZDT} + {1775311200 43200 0 NZST} + {1790431200 46800 1 NZDT} + {1806760800 43200 0 NZST} + {1821880800 46800 1 NZDT} + {1838210400 43200 0 NZST} + {1853330400 46800 1 NZDT} + {1869660000 43200 0 NZST} + {1885384800 46800 1 NZDT} + {1901714400 43200 0 NZST} + {1916834400 46800 1 NZDT} + {1933164000 43200 0 NZST} + {1948284000 46800 1 NZDT} + {1964613600 43200 0 NZST} + {1979733600 46800 1 NZDT} + {1996063200 43200 0 NZST} + {2011183200 46800 1 NZDT} + {2027512800 43200 0 NZST} + {2042632800 46800 1 NZDT} + {2058962400 43200 0 NZST} + {2074687200 46800 1 NZDT} + {2091016800 43200 0 NZST} + {2106136800 46800 1 NZDT} + {2122466400 43200 0 NZST} + {2137586400 46800 1 NZDT} + {2153916000 43200 0 NZST} + {2169036000 46800 1 NZDT} + {2185365600 43200 0 NZST} + {2200485600 46800 1 NZDT} + {2216815200 43200 0 NZST} + {2232540000 46800 1 NZDT} + {2248869600 43200 0 NZST} + {2263989600 46800 1 NZDT} + {2280319200 43200 0 NZST} + {2295439200 46800 1 NZDT} + {2311768800 43200 0 NZST} + {2326888800 46800 1 NZDT} + {2343218400 43200 0 NZST} + {2358338400 46800 1 NZDT} + {2374668000 43200 0 NZST} + {2389788000 46800 1 NZDT} + {2406117600 43200 0 NZST} + {2421842400 46800 1 NZDT} + {2438172000 43200 0 NZST} + {2453292000 46800 1 NZDT} + {2469621600 43200 0 NZST} + {2484741600 46800 1 NZDT} + {2501071200 43200 0 NZST} + {2516191200 46800 1 NZDT} + {2532520800 43200 0 NZST} + {2547640800 46800 1 NZDT} + {2563970400 43200 0 NZST} + {2579090400 46800 1 NZDT} + {2596024800 43200 0 NZST} + {2611144800 46800 1 NZDT} + {2627474400 43200 0 NZST} + {2642594400 46800 1 NZDT} + {2658924000 43200 0 NZST} + {2674044000 46800 1 NZDT} + {2690373600 43200 0 NZST} + {2705493600 46800 1 NZDT} + {2721823200 43200 0 NZST} + {2736943200 46800 1 NZDT} + {2753272800 43200 0 NZST} + {2768997600 46800 1 NZDT} + {2785327200 43200 0 NZST} + {2800447200 46800 1 NZDT} + {2816776800 43200 0 NZST} + {2831896800 46800 1 NZDT} + {2848226400 43200 0 NZST} + {2863346400 46800 1 NZDT} + {2879676000 43200 0 NZST} + {2894796000 46800 1 NZDT} + {2911125600 43200 0 NZST} + {2926245600 46800 1 NZDT} + {2942575200 43200 0 NZST} + {2958300000 46800 1 NZDT} + {2974629600 43200 0 NZST} + {2989749600 46800 1 NZDT} + {3006079200 43200 0 NZST} + {3021199200 46800 1 NZDT} + {3037528800 43200 0 NZST} + {3052648800 46800 1 NZDT} + {3068978400 43200 0 NZST} + {3084098400 46800 1 NZDT} + {3100428000 43200 0 NZST} + {3116152800 46800 1 NZDT} + {3132482400 43200 0 NZST} + {3147602400 46800 1 NZDT} + {3163932000 43200 0 NZST} + {3179052000 46800 1 NZDT} + {3195381600 43200 0 NZST} + {3210501600 46800 1 NZDT} + {3226831200 43200 0 NZST} + {3241951200 46800 1 NZDT} + {3258280800 43200 0 NZST} + {3273400800 46800 1 NZDT} + {3289730400 43200 0 NZST} + {3305455200 46800 1 NZDT} + {3321784800 43200 0 NZST} + {3336904800 46800 1 NZDT} + {3353234400 43200 0 NZST} + {3368354400 46800 1 NZDT} + {3384684000 43200 0 NZST} + {3399804000 46800 1 NZDT} + {3416133600 43200 0 NZST} + {3431253600 46800 1 NZDT} + {3447583200 43200 0 NZST} + {3462703200 46800 1 NZDT} + {3479637600 43200 0 NZST} + {3494757600 46800 1 NZDT} + {3511087200 43200 0 NZST} + {3526207200 46800 1 NZDT} + {3542536800 43200 0 NZST} + {3557656800 46800 1 NZDT} + {3573986400 43200 0 NZST} + {3589106400 46800 1 NZDT} + {3605436000 43200 0 NZST} + {3620556000 46800 1 NZDT} + {3636885600 43200 0 NZST} + {3652610400 46800 1 NZDT} + {3668940000 43200 0 NZST} + {3684060000 46800 1 NZDT} + {3700389600 43200 0 NZST} + {3715509600 46800 1 NZDT} + {3731839200 43200 0 NZST} + {3746959200 46800 1 NZDT} + {3763288800 43200 0 NZST} + {3778408800 46800 1 NZDT} + {3794738400 43200 0 NZST} + {3809858400 46800 1 NZDT} + {3826188000 43200 0 NZST} + {3841912800 46800 1 NZDT} + {3858242400 43200 0 NZST} + {3873362400 46800 1 NZDT} + {3889692000 43200 0 NZST} + {3904812000 46800 1 NZDT} + {3921141600 43200 0 NZST} + {3936261600 46800 1 NZDT} + {3952591200 43200 0 NZST} + {3967711200 46800 1 NZDT} + {3984040800 43200 0 NZST} + {3999765600 46800 1 NZDT} + {4016095200 43200 0 NZST} + {4031215200 46800 1 NZDT} + {4047544800 43200 0 NZST} + {4062664800 46800 1 NZDT} + {4078994400 43200 0 NZST} + {4094114400 46800 1 NZDT} } diff --git a/library/tzdata/Pacific/Chatham b/library/tzdata/Pacific/Chatham index 161dffb..0ed2260 100644 --- a/library/tzdata/Pacific/Chatham +++ b/library/tzdata/Pacific/Chatham @@ -69,189 +69,189 @@ set TZData(:Pacific/Chatham) { {1142690400 45900 0 CHAST} {1159624800 49500 1 CHADT} {1174140000 45900 0 CHAST} - {1191679200 49500 1 CHADT} - {1205589600 45900 0 CHAST} - {1223128800 49500 1 CHADT} - {1237039200 45900 0 CHAST} - {1254578400 49500 1 CHADT} - {1269093600 45900 0 CHAST} - {1286028000 49500 1 CHADT} - {1300543200 45900 0 CHAST} - {1317477600 49500 1 CHADT} - {1331992800 45900 0 CHAST} - {1349532000 49500 1 CHADT} - {1363442400 45900 0 CHAST} - {1380981600 49500 1 CHADT} - {1394892000 45900 0 CHAST} - {1412431200 49500 1 CHADT} - {1426341600 45900 0 CHAST} - {1443880800 49500 1 CHADT} - {1458396000 45900 0 CHAST} - {1475330400 49500 1 CHADT} - {1489845600 45900 0 CHAST} - {1506780000 49500 1 CHADT} - {1521295200 45900 0 CHAST} - {1538834400 49500 1 CHADT} - {1552744800 45900 0 CHAST} - {1570284000 49500 1 CHADT} - {1584194400 45900 0 CHAST} - {1601733600 49500 1 CHADT} - {1616248800 45900 0 CHAST} - {1633183200 49500 1 CHADT} - {1647698400 45900 0 CHAST} - {1664632800 49500 1 CHADT} - {1679148000 45900 0 CHAST} - {1696082400 49500 1 CHADT} - {1710597600 45900 0 CHAST} - {1728136800 49500 1 CHADT} - {1742047200 45900 0 CHAST} - {1759586400 49500 1 CHADT} - {1773496800 45900 0 CHAST} - {1791036000 49500 1 CHADT} - {1805551200 45900 0 CHAST} - {1822485600 49500 1 CHADT} - {1837000800 45900 0 CHAST} - {1853935200 49500 1 CHADT} - {1868450400 45900 0 CHAST} - {1885989600 49500 1 CHADT} - {1899900000 45900 0 CHAST} - {1917439200 49500 1 CHADT} - {1931349600 45900 0 CHAST} - {1948888800 49500 1 CHADT} - {1963404000 45900 0 CHAST} - {1980338400 49500 1 CHADT} - {1994853600 45900 0 CHAST} - {2011788000 49500 1 CHADT} - {2026303200 45900 0 CHAST} - {2043237600 49500 1 CHADT} - {2057752800 45900 0 CHAST} - {2075292000 49500 1 CHADT} - {2089202400 45900 0 CHAST} - {2106741600 49500 1 CHADT} - {2120652000 45900 0 CHAST} - {2138191200 49500 1 CHADT} - {2152706400 45900 0 CHAST} - {2169640800 49500 1 CHADT} - {2184156000 45900 0 CHAST} - {2201090400 49500 1 CHADT} - {2215605600 45900 0 CHAST} - {2233144800 49500 1 CHADT} - {2247055200 45900 0 CHAST} - {2264594400 49500 1 CHADT} - {2278504800 45900 0 CHAST} - {2296044000 49500 1 CHADT} - {2309954400 45900 0 CHAST} - {2327493600 49500 1 CHADT} - {2342008800 45900 0 CHAST} - {2358943200 49500 1 CHADT} - {2373458400 45900 0 CHAST} - {2390392800 49500 1 CHADT} - {2404908000 45900 0 CHAST} - {2422447200 49500 1 CHADT} - {2436357600 45900 0 CHAST} - {2453896800 49500 1 CHADT} - {2467807200 45900 0 CHAST} - {2485346400 49500 1 CHADT} - {2499861600 45900 0 CHAST} - {2516796000 49500 1 CHADT} - {2531311200 45900 0 CHAST} - {2548245600 49500 1 CHADT} - {2562760800 45900 0 CHAST} - {2579695200 49500 1 CHADT} - {2594210400 45900 0 CHAST} - {2611749600 49500 1 CHADT} - {2625660000 45900 0 CHAST} - {2643199200 49500 1 CHADT} - {2657109600 45900 0 CHAST} - {2674648800 49500 1 CHADT} - {2689164000 45900 0 CHAST} - {2706098400 49500 1 CHADT} - {2720613600 45900 0 CHAST} - {2737548000 49500 1 CHADT} - {2752063200 45900 0 CHAST} - {2769602400 49500 1 CHADT} - {2783512800 45900 0 CHAST} - {2801052000 49500 1 CHADT} - {2814962400 45900 0 CHAST} - {2832501600 49500 1 CHADT} - {2847016800 45900 0 CHAST} - {2863951200 49500 1 CHADT} - {2878466400 45900 0 CHAST} - {2895400800 49500 1 CHADT} - {2909916000 45900 0 CHAST} - {2926850400 49500 1 CHADT} - {2941365600 45900 0 CHAST} - {2958904800 49500 1 CHADT} - {2972815200 45900 0 CHAST} - {2990354400 49500 1 CHADT} - {3004264800 45900 0 CHAST} - {3021804000 49500 1 CHADT} - {3036319200 45900 0 CHAST} - {3053253600 49500 1 CHADT} - {3067768800 45900 0 CHAST} - {3084703200 49500 1 CHADT} - {3099218400 45900 0 CHAST} - {3116757600 49500 1 CHADT} - {3130668000 45900 0 CHAST} - {3148207200 49500 1 CHADT} - {3162117600 45900 0 CHAST} - {3179656800 49500 1 CHADT} - {3193567200 45900 0 CHAST} - {3211106400 49500 1 CHADT} - {3225621600 45900 0 CHAST} - {3242556000 49500 1 CHADT} - {3257071200 45900 0 CHAST} - {3274005600 49500 1 CHADT} - {3288520800 45900 0 CHAST} - {3306060000 49500 1 CHADT} - {3319970400 45900 0 CHAST} - {3337509600 49500 1 CHADT} - {3351420000 45900 0 CHAST} - {3368959200 49500 1 CHADT} - {3383474400 45900 0 CHAST} - {3400408800 49500 1 CHADT} - {3414924000 45900 0 CHAST} - {3431858400 49500 1 CHADT} - {3446373600 45900 0 CHAST} - {3463308000 49500 1 CHADT} - {3477823200 45900 0 CHAST} - {3495362400 49500 1 CHADT} - {3509272800 45900 0 CHAST} - {3526812000 49500 1 CHADT} - {3540722400 45900 0 CHAST} - {3558261600 49500 1 CHADT} - {3572776800 45900 0 CHAST} - {3589711200 49500 1 CHADT} - {3604226400 45900 0 CHAST} - {3621160800 49500 1 CHADT} - {3635676000 45900 0 CHAST} - {3653215200 49500 1 CHADT} - {3667125600 45900 0 CHAST} - {3684664800 49500 1 CHADT} - {3698575200 45900 0 CHAST} - {3716114400 49500 1 CHADT} - {3730629600 45900 0 CHAST} - {3747564000 49500 1 CHADT} - {3762079200 45900 0 CHAST} - {3779013600 49500 1 CHADT} - {3793528800 45900 0 CHAST} - {3810463200 49500 1 CHADT} - {3824978400 45900 0 CHAST} - {3842517600 49500 1 CHADT} - {3856428000 45900 0 CHAST} - {3873967200 49500 1 CHADT} - {3887877600 45900 0 CHAST} - {3905416800 49500 1 CHADT} - {3919932000 45900 0 CHAST} - {3936866400 49500 1 CHADT} - {3951381600 45900 0 CHAST} - {3968316000 49500 1 CHADT} - {3982831200 45900 0 CHAST} - {4000370400 49500 1 CHADT} - {4014280800 45900 0 CHAST} - {4031820000 49500 1 CHADT} - {4045730400 45900 0 CHAST} - {4063269600 49500 1 CHADT} - {4077180000 45900 0 CHAST} - {4094719200 49500 1 CHADT} + {1191074400 49500 1 CHADT} + {1207404000 45900 0 CHAST} + {1222524000 49500 1 CHADT} + {1238853600 45900 0 CHAST} + {1253973600 49500 1 CHADT} + {1270303200 45900 0 CHAST} + {1285423200 49500 1 CHADT} + {1301752800 45900 0 CHAST} + {1316872800 49500 1 CHADT} + {1333202400 45900 0 CHAST} + {1348927200 49500 1 CHADT} + {1365256800 45900 0 CHAST} + {1380376800 49500 1 CHADT} + {1396706400 45900 0 CHAST} + {1411826400 49500 1 CHADT} + {1428156000 45900 0 CHAST} + {1443276000 49500 1 CHADT} + {1459605600 45900 0 CHAST} + {1474725600 49500 1 CHADT} + {1491055200 45900 0 CHAST} + {1506175200 49500 1 CHADT} + {1522504800 45900 0 CHAST} + {1538229600 49500 1 CHADT} + {1554559200 45900 0 CHAST} + {1569679200 49500 1 CHADT} + {1586008800 45900 0 CHAST} + {1601128800 49500 1 CHADT} + {1617458400 45900 0 CHAST} + {1632578400 49500 1 CHADT} + {1648908000 45900 0 CHAST} + {1664028000 49500 1 CHADT} + {1680357600 45900 0 CHAST} + {1695477600 49500 1 CHADT} + {1712412000 45900 0 CHAST} + {1727532000 49500 1 CHADT} + {1743861600 45900 0 CHAST} + {1758981600 49500 1 CHADT} + {1775311200 45900 0 CHAST} + {1790431200 49500 1 CHADT} + {1806760800 45900 0 CHAST} + {1821880800 49500 1 CHADT} + {1838210400 45900 0 CHAST} + {1853330400 49500 1 CHADT} + {1869660000 45900 0 CHAST} + {1885384800 49500 1 CHADT} + {1901714400 45900 0 CHAST} + {1916834400 49500 1 CHADT} + {1933164000 45900 0 CHAST} + {1948284000 49500 1 CHADT} + {1964613600 45900 0 CHAST} + {1979733600 49500 1 CHADT} + {1996063200 45900 0 CHAST} + {2011183200 49500 1 CHADT} + {2027512800 45900 0 CHAST} + {2042632800 49500 1 CHADT} + {2058962400 45900 0 CHAST} + {2074687200 49500 1 CHADT} + {2091016800 45900 0 CHAST} + {2106136800 49500 1 CHADT} + {2122466400 45900 0 CHAST} + {2137586400 49500 1 CHADT} + {2153916000 45900 0 CHAST} + {2169036000 49500 1 CHADT} + {2185365600 45900 0 CHAST} + {2200485600 49500 1 CHADT} + {2216815200 45900 0 CHAST} + {2232540000 49500 1 CHADT} + {2248869600 45900 0 CHAST} + {2263989600 49500 1 CHADT} + {2280319200 45900 0 CHAST} + {2295439200 49500 1 CHADT} + {2311768800 45900 0 CHAST} + {2326888800 49500 1 CHADT} + {2343218400 45900 0 CHAST} + {2358338400 49500 1 CHADT} + {2374668000 45900 0 CHAST} + {2389788000 49500 1 CHADT} + {2406117600 45900 0 CHAST} + {2421842400 49500 1 CHADT} + {2438172000 45900 0 CHAST} + {2453292000 49500 1 CHADT} + {2469621600 45900 0 CHAST} + {2484741600 49500 1 CHADT} + {2501071200 45900 0 CHAST} + {2516191200 49500 1 CHADT} + {2532520800 45900 0 CHAST} + {2547640800 49500 1 CHADT} + {2563970400 45900 0 CHAST} + {2579090400 49500 1 CHADT} + {2596024800 45900 0 CHAST} + {2611144800 49500 1 CHADT} + {2627474400 45900 0 CHAST} + {2642594400 49500 1 CHADT} + {2658924000 45900 0 CHAST} + {2674044000 49500 1 CHADT} + {2690373600 45900 0 CHAST} + {2705493600 49500 1 CHADT} + {2721823200 45900 0 CHAST} + {2736943200 49500 1 CHADT} + {2753272800 45900 0 CHAST} + {2768997600 49500 1 CHADT} + {2785327200 45900 0 CHAST} + {2800447200 49500 1 CHADT} + {2816776800 45900 0 CHAST} + {2831896800 49500 1 CHADT} + {2848226400 45900 0 CHAST} + {2863346400 49500 1 CHADT} + {2879676000 45900 0 CHAST} + {2894796000 49500 1 CHADT} + {2911125600 45900 0 CHAST} + {2926245600 49500 1 CHADT} + {2942575200 45900 0 CHAST} + {2958300000 49500 1 CHADT} + {2974629600 45900 0 CHAST} + {2989749600 49500 1 CHADT} + {3006079200 45900 0 CHAST} + {3021199200 49500 1 CHADT} + {3037528800 45900 0 CHAST} + {3052648800 49500 1 CHADT} + {3068978400 45900 0 CHAST} + {3084098400 49500 1 CHADT} + {3100428000 45900 0 CHAST} + {3116152800 49500 1 CHADT} + {3132482400 45900 0 CHAST} + {3147602400 49500 1 CHADT} + {3163932000 45900 0 CHAST} + {3179052000 49500 1 CHADT} + {3195381600 45900 0 CHAST} + {3210501600 49500 1 CHADT} + {3226831200 45900 0 CHAST} + {3241951200 49500 1 CHADT} + {3258280800 45900 0 CHAST} + {3273400800 49500 1 CHADT} + {3289730400 45900 0 CHAST} + {3305455200 49500 1 CHADT} + {3321784800 45900 0 CHAST} + {3336904800 49500 1 CHADT} + {3353234400 45900 0 CHAST} + {3368354400 49500 1 CHADT} + {3384684000 45900 0 CHAST} + {3399804000 49500 1 CHADT} + {3416133600 45900 0 CHAST} + {3431253600 49500 1 CHADT} + {3447583200 45900 0 CHAST} + {3462703200 49500 1 CHADT} + {3479637600 45900 0 CHAST} + {3494757600 49500 1 CHADT} + {3511087200 45900 0 CHAST} + {3526207200 49500 1 CHADT} + {3542536800 45900 0 CHAST} + {3557656800 49500 1 CHADT} + {3573986400 45900 0 CHAST} + {3589106400 49500 1 CHADT} + {3605436000 45900 0 CHAST} + {3620556000 49500 1 CHADT} + {3636885600 45900 0 CHAST} + {3652610400 49500 1 CHADT} + {3668940000 45900 0 CHAST} + {3684060000 49500 1 CHADT} + {3700389600 45900 0 CHAST} + {3715509600 49500 1 CHADT} + {3731839200 45900 0 CHAST} + {3746959200 49500 1 CHADT} + {3763288800 45900 0 CHAST} + {3778408800 49500 1 CHADT} + {3794738400 45900 0 CHAST} + {3809858400 49500 1 CHADT} + {3826188000 45900 0 CHAST} + {3841912800 49500 1 CHADT} + {3858242400 45900 0 CHAST} + {3873362400 49500 1 CHADT} + {3889692000 45900 0 CHAST} + {3904812000 49500 1 CHADT} + {3921141600 45900 0 CHAST} + {3936261600 49500 1 CHADT} + {3952591200 45900 0 CHAST} + {3967711200 49500 1 CHADT} + {3984040800 45900 0 CHAST} + {3999765600 49500 1 CHADT} + {4016095200 45900 0 CHAST} + {4031215200 49500 1 CHADT} + {4047544800 45900 0 CHAST} + {4062664800 49500 1 CHADT} + {4078994400 45900 0 CHAST} + {4094114400 49500 1 CHADT} } diff --git a/library/word.tcl b/library/word.tcl index 05c3bab..a407e7d 100644 --- a/library/word.tcl +++ b/library/word.tcl @@ -1,132 +1,146 @@ # word.tcl -- # -# This file defines various procedures for computing word boundaries -# in strings. This file is primarily needed so Tk text and entry -# widgets behave properly for different platforms. +# This file defines various procedures for computing word boundaries in +# strings. This file is primarily needed so Tk text and entry widgets behave +# properly for different platforms. # # Copyright (c) 1996 by Sun Microsystems, Inc. # Copyright (c) 1998 by Scritpics Corporation. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: word.tcl,v 1.8 2005/07/23 04:12:49 dgp Exp $ +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: word.tcl,v 1.8.8.1 2007/09/04 17:43:59 dgp Exp $ # The following variables are used to determine which characters are -# interpreted as white space. +# interpreted as white space. if {$::tcl_platform(platform) eq "windows"} { # Windows style - any but a unicode space char - set tcl_wordchars "\\S" - set tcl_nonwordchars "\\s" + set ::tcl_wordchars {\S} + set ::tcl_nonwordchars {\s} } else { # Motif style - any unicode word char (number, letter, or underscore) - set tcl_wordchars "\\w" - set tcl_nonwordchars "\\W" + set ::tcl_wordchars {\w} + set ::tcl_nonwordchars {\W} +} + +# Arrange for caches of the real matcher REs to be kept, which enables the REs +# themselves to be cached for greater performance (and somewhat greater +# clarity too). + +namespace eval ::tcl { + variable WordBreakRE + array set WordBreakRE {} + + proc UpdateWordBreakREs args { + # Ignores the arguments + global tcl_wordchars tcl_nonwordchars + variable WordBreakRE + + # To keep the RE strings short... + set letter $tcl_wordchars + set space $tcl_nonwordchars + + set WordBreakRE(after) "$letter$space|$space$letter" + set WordBreakRE(before) "^.*($letter$space|$space$letter)" + set WordBreakRE(end) "$space*$letter+$space" + set WordBreakRE(next) "$letter*$space+$letter" + set WordBreakRE(previous) "$space*($letter+)$space*\$" + } + + # Initialize the cache + UpdateWordBreakREs + trace add variable ::tcl_wordchars write ::tcl::UpdateWordBreakREs + trace add variable ::tcl_nonwordchars write ::tcl::UpdateWordBreakREs } # tcl_wordBreakAfter -- # -# This procedure returns the index of the first word boundary -# after the starting point in the given string, or -1 if there -# are no more boundaries in the given string. The index returned refers -# to the first character of the pair that comprises a boundary. +# This procedure returns the index of the first word boundary after the +# starting point in the given string, or -1 if there are no more boundaries in +# the given string. The index returned refers to the first character of the +# pair that comprises a boundary. # # Arguments: # str - String to search. # start - Index into string specifying starting point. proc tcl_wordBreakAfter {str start} { - global tcl_nonwordchars tcl_wordchars - set str [string range $str $start end] - if {[regexp -indices "$tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars" $str result]} { - return [expr {[lindex $result 1] + $start}] - } - return -1 + variable ::tcl::WordBreakRE + set result {-1 -1} + regexp -indices -start $start $WordBreakRE(after) $str result + return [lindex $result 1] } # tcl_wordBreakBefore -- # -# This procedure returns the index of the first word boundary -# before the starting point in the given string, or -1 if there -# are no more boundaries in the given string. The index returned -# refers to the second character of the pair that comprises a boundary. +# This procedure returns the index of the first word boundary before the +# starting point in the given string, or -1 if there are no more boundaries in +# the given string. The index returned refers to the second character of the +# pair that comprises a boundary. # # Arguments: # str - String to search. # start - Index into string specifying starting point. proc tcl_wordBreakBefore {str start} { - global tcl_nonwordchars tcl_wordchars - if {$start eq "end"} { - set start [string length $str] - } - if {[regexp -indices "^.*($tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars)" [string range $str 0 $start] result]} { - return [lindex $result 1] - } - return -1 + variable ::tcl::WordBreakRE + set result {-1 -1} + regexp -indices $WordBreakRE(before) [string range $str 0 $start] result + return [lindex $result 1] } # tcl_endOfWord -- # -# This procedure returns the index of the first end-of-word location -# after a starting index in the given string. An end-of-word location -# is defined to be the first whitespace character following the first -# non-whitespace character after the starting point. Returns -1 if -# there are no more words after the starting point. +# This procedure returns the index of the first end-of-word location after a +# starting index in the given string. An end-of-word location is defined to be +# the first whitespace character following the first non-whitespace character +# after the starting point. Returns -1 if there are no more words after the +# starting point. # # Arguments: # str - String to search. # start - Index into string specifying starting point. proc tcl_endOfWord {str start} { - global tcl_nonwordchars tcl_wordchars - if {[regexp -indices "$tcl_nonwordchars*$tcl_wordchars+$tcl_nonwordchars" \ - [string range $str $start end] result]} { - return [expr {[lindex $result 1] + $start}] - } - return -1 + variable ::tcl::WordBreakRE + set result {-1 -1} + regexp -indices -start $start $WordBreakRE(end) $str result + return [lindex $result 1] } # tcl_startOfNextWord -- # -# This procedure returns the index of the first start-of-word location -# after a starting index in the given string. A start-of-word -# location is defined to be a non-whitespace character following a -# whitespace character. Returns -1 if there are no more start-of-word -# locations after the starting point. +# This procedure returns the index of the first start-of-word location after a +# starting index in the given string. A start-of-word location is defined to +# be a non-whitespace character following a whitespace character. Returns -1 +# if there are no more start-of-word locations after the starting point. # # Arguments: # str - String to search. # start - Index into string specifying starting point. proc tcl_startOfNextWord {str start} { - global tcl_nonwordchars tcl_wordchars - if {[regexp -indices "$tcl_wordchars*$tcl_nonwordchars+$tcl_wordchars" \ - [string range $str $start end] result]} { - return [expr {[lindex $result 1] + $start}] - } - return -1 + variable ::tcl::WordBreakRE + set result {-1 -1} + regexp -indices -start $start $WordBreakRE(next) $str result + return [lindex $result 1] } # tcl_startOfPreviousWord -- # -# This procedure returns the index of the first start-of-word location -# before a starting index in the given string. +# This procedure returns the index of the first start-of-word location before +# a starting index in the given string. # # Arguments: # str - String to search. # start - Index into string specifying starting point. proc tcl_startOfPreviousWord {str start} { - global tcl_nonwordchars tcl_wordchars - if {$start eq "end"} { - set start [string length $str] - } - if {[regexp -indices \ - "$tcl_nonwordchars*($tcl_wordchars+)$tcl_nonwordchars*\$" \ - [string range $str 0 [expr {$start - 1}]] result word]} { - return [lindex $word 0] - } - return -1 + variable ::tcl::WordBreakRE + set word {-1 -1} + regexp -indices $WordBreakRE(previous) [string range $str 0 $start-1] \ + result word + return [lindex $word 0] } diff --git a/macosx/Tcl.xcodeproj/project.pbxproj b/macosx/Tcl.xcodeproj/project.pbxproj index 3dc0fd4..592a884 100644 --- a/macosx/Tcl.xcodeproj/project.pbxproj +++ b/macosx/Tcl.xcodeproj/project.pbxproj @@ -820,7 +820,6 @@ F96D444708F272B9004A47F5 /* pkgc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgc.c; sourceTree = ""; }; F96D444808F272B9004A47F5 /* pkgd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgd.c; sourceTree = ""; }; F96D444908F272B9004A47F5 /* pkge.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkge.c; sourceTree = ""; }; - F96D444A08F272B9004A47F5 /* pkgf.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgf.c; sourceTree = ""; }; F96D444B08F272B9004A47F5 /* pkgua.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgua.c; sourceTree = ""; }; F96D444C08F272B9004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = ""; }; F96D444D08F272B9004A47F5 /* install-sh */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = "install-sh"; sourceTree = ""; }; @@ -931,7 +930,7 @@ F966C06F08F281DC005CB29B /* Frameworks */, 1AB674ADFE9D54B511CA2CBB /* Products */, ); - comments = "Copyright (c) 2004-2007 Daniel A. Steffen \n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n\nRCS: @(#) $Id: project.pbxproj,v 1.21.2.2 2007/07/01 17:31:25 dgp Exp $\n"; + comments = "Copyright (c) 2004-2007 Daniel A. Steffen \n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n\nRCS: @(#) $Id: project.pbxproj,v 1.21.2.3 2007/09/04 17:44:03 dgp Exp $\n"; name = Tcl; path = .; sourceTree = SOURCE_ROOT; @@ -1773,7 +1772,6 @@ F96D444708F272B9004A47F5 /* pkgc.c */, F96D444808F272B9004A47F5 /* pkgd.c */, F96D444908F272B9004A47F5 /* pkge.c */, - F96D444A08F272B9004A47F5 /* pkgf.c */, F96D444B08F272B9004A47F5 /* pkgua.c */, F96D444C08F272B9004A47F5 /* README */, ); diff --git a/macosx/tclMacOSXNotify.c b/macosx/tclMacOSXNotify.c index 100df93..d139921 100644 --- a/macosx/tclMacOSXNotify.c +++ b/macosx/tclMacOSXNotify.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: tclMacOSXNotify.c,v 1.14.2.1 2007/06/25 18:53:31 dgp Exp $ + * RCS: @(#) $Id: tclMacOSXNotify.c,v 1.14.2.2 2007/09/04 17:44:02 dgp Exp $ */ #include "tclInt.h" @@ -324,7 +324,7 @@ extern int pthread_atfork(void (*prepare)(void), void (*parent)(void), * On 64bit Darwin 9 and later, it is not possible to call CoreFoundation after * a fork. */ -#if !defined(MAC_OS_X_VERSION_MIN_REQUIRED) || +#if !defined(MAC_OS_X_VERSION_MIN_REQUIRED) || \ MAC_OS_X_VERSION_MIN_REQUIRED < 1050 MODULE_SCOPE long tclMacOSXDarwinRelease; #define noCFafterFork (tclMacOSXDarwinRelease >= 9) diff --git a/tests/clock.test b/tests/clock.test index 801cb48..3632db6 100644 --- a/tests/clock.test +++ b/tests/clock.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: clock.test,v 1.79 2007/04/20 05:51:11 kennykb Exp $ +# RCS: @(#) $Id: clock.test,v 1.79.2.1 2007/09/04 17:44:04 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -36549,6 +36549,45 @@ test clock-59.1 {military time zones} { join $trouble \n } {} +# case-insensitive matching of weekday and month names [Bug 1781282] + +test clock-60.1 {case insensitive weekday names} { + clock scan "2000-W01 monday" -gmt true -format "%G-W%V %a" +} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"] +test clock-60.2 {case insensitive weekday names} { + clock scan "2000-W01 Monday" -gmt true -format "%G-W%V %a" +} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"] +test clock-60.3 {case insensitive weekday names} { + clock scan "2000-W01 MONDAY" -gmt true -format "%G-W%V %a" +} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"] +test clock-60.4 {case insensitive weekday names} { + clock scan "2000-W01 friday" -gmt true -format "%G-W%V %a" +} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"] +test clock-60.5 {case insensitive weekday names} { + clock scan "2000-W01 Friday" -gmt true -format "%G-W%V %a" +} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"] +test clock-60.6 {case insensitive weekday names} { + clock scan "2000-W01 FRIDAY" -gmt true -format "%G-W%V %a" +} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"] +test clock-60.7 {case insensitive month names} { + clock scan "1 january 2000" -gmt true -format "%d %b %Y" +} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"] +test clock-60.8 {case insensitive month names} { + clock scan "1 January 2000" -gmt true -format "%d %b %Y" +} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"] +test clock-60.9 {case insensitive month names} { + clock scan "1 JANUARY 2000" -gmt true -format "%d %b %Y" +} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"] +test clock-60.10 {case insensitive month names} { + clock scan "1 december 2000" -gmt true -format "%d %b %Y" +} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] +test clock-60.11 {case insensitive month names} { + clock scan "1 December 2000" -gmt true -format "%d %b %Y" +} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] +test clock-60.12 {case insensitive month names} { + clock scan "1 DECEMBER 2000" -gmt true -format "%d %b %Y" +} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] + # cleanup namespace delete ::testClock diff --git a/tests/compExpr.test b/tests/compExpr.test index 991033f..e2972ec 100644 --- a/tests/compExpr.test +++ b/tests/compExpr.test @@ -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: compExpr.test,v 1.13 2006/08/22 04:03:23 dgp Exp $ +# RCS: @(#) $Id: compExpr.test,v 1.13.6.1 2007/09/04 17:44:06 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -21,6 +21,9 @@ if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1" testConstraint testmathfunctions 1 } +# Constrain memory leak tests +testConstraint memory [llength [info commands memory]] + catch {unset a} test compExpr-1.1 {TclCompileExpr procedure, successful expr parse and compile} { @@ -319,6 +322,26 @@ test compExpr-6.1 {LogSyntaxError procedure, error in expr longer than 60 chars} expr {(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)/} -1 foo 3 } -returnCodes error -match glob -result * +test compExpr-7.1 {Memory Leak} -constraints memory -setup { + proc getbytes {} { + set lines [split [memory info] \n] + lindex $lines 3 3 + } +} -body { + set end [getbytes] + for {set i 0} {$i < 5} {incr i} { + interp create slave + slave eval expr 1+2+3+4+5+6+7+8+9+10+11+12+13 + interp delete slave + set tmp $end + set end [getbytes] + } + set leakedBytes [expr {$end - $tmp}] +} -cleanup { + unset end i tmp + rename getbytes {} +} -result 0 + # cleanup catch {unset a} catch {unset b} diff --git a/tests/expr.test b/tests/expr.test index daab2f4..e110c3e 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -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: expr.test,v 1.67 2006/12/06 16:37:00 kennykb Exp $ +# RCS: @(#) $Id: expr.test,v 1.67.2.1 2007/09/04 17:44:06 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -983,7 +983,127 @@ test expr-23.47 {INST_EXPON: Bug 1561260} { test expr-23.48 {INST_EXPON: TIP 274: right assoc} { expr 2**3**4 } 2417851639229258349412352 - +test expr-23.49 {INST_EXPON: optimize powers of 2} { + set trouble {test powers of 2} + for {set tval 0} {$tval <= 66} {incr tval} { + set is [expr {2 ** $tval}] + set sb [expr {1 << $tval}] + if {$is != $sb} { + append trouble \n "2**" $tval " is " $is " should be " $sb + } + if {$tval >= 1} { + set is [expr {-2 ** $tval}] + set sb [expr {1 << $tval}] + if {$tval & 1} { + set sb [expr {-$sb}] + } + if {$is != $sb} { + append trouble \n "-2**" $tval " is " $is " should be " $sb + } + } + } + set trouble +} {test powers of 2} +test expr-23.50 {INST_EXPON: small powers of 32-bit integers} { + set trouble {test small powers of 32-bit ints} + for {set base 3} {$base <= 45} {incr base} { + set sb $base + set sbm [expr {-$base}] + for {set expt 2} {$expt <= 8} {incr expt} { + set sb [expr {$sb * $base}] + set is [expr {$base ** $expt}] + if {$sb != $is} { + append trouble \n $base ** $expt " is " $is " should be " $sb + } + set sbm [expr {-$sbm * $base}] + set ism [expr {(-$base) ** $expt}] + if {$sbm != $ism} { + append trouble \n - $base ** $expt " is " $ism \ + " should be " $sbm + } + } + } + set trouble +} {test small powers of 32-bit ints} +test expr-23.51 {INST_EXPON: intermediate powers of 32-bit integers} { + set trouble {test intermediate powers of 32-bit ints} + for {set base 3} {$base <= 11} {incr base} { + set sb [expr {$base ** 8}] + set sbm $sb + for {set expt 9} {$expt <= 21} {incr expt} { + set sb [expr {$sb * $base}] + set sbm [expr {$sbm * -$base}] + set is [expr {$base ** $expt}] + set ism [expr {-$base ** $expt}] + if {$sb != $is} { + append trouble \n $base ** $expt " is " $is " should be " $sb + } + if {$sbm != $ism} { + append trouble \n - $base ** $expt " is " $ism \ + " should be " $sbm + } + } + } + set trouble +} {test intermediate powers of 32-bit ints} +test expr-23.52 {INST_EXPON: small integer powers with 64-bit results} { + set trouble {test small int powers with 64-bit results} + for {set exp 2} {$exp <= 16} {incr exp} { + set base [expr {entier(pow(double(0x7fffffffffffffff),(1.0/$exp)))}] + set sb 1 + set sbm 1 + for {set i 0} {$i < $exp} {incr i} { + set sb [expr {$sb * $base}] + set sbm [expr {$sbm * -$base}] + } + set is [expr {$base ** $exp}] + set ism [expr {-$base ** $exp}] + if {$sb != $is} { + append trouble \n $base ** $exp " is " $is " should be " $sb + } + if {$sbm != $ism} { + append trouble \n - $base ** $exp " is " $ism " should be " $sbm + } + incr base + set sb 1 + set sbm 1 + for {set i 0} {$i < $exp} {incr i} { + set sb [expr {$sb * $base}] + set sbm [expr {$sbm * -$base}] + } + set is [expr {$base ** $exp}] + set ism [expr {-$base ** $exp}] + if {$sb != $is} { + append trouble \n $base ** $exp " is " $is " should be " $sb + } + if {$sbm != $ism} { + append trouble \n - $base ** $exp " is " $ism " should be " $sbm + } + } + set trouble +} {test small int powers with 64-bit results} +test expr-23.53 {INST_EXPON: intermediate powers of 64-bit integers} { + set trouble {test intermediate powers of 64-bit ints} + for {set base 3} {$base <= 13} {incr base} { + set sb [expr {$base ** 15}] + set sbm [expr {-$sb}] + for {set expt 16} {$expt <= 39} {incr expt} { + set sb [expr {$sb * $base}] + set sbm [expr {$sbm * -$base}] + set is [expr {$base ** $expt}] + set ism [expr {-$base ** $expt}] + if {$sb != $is} { + append trouble \n $base ** $expt " is " $is " should be " $sb + } + if {$sbm != $ism} { + append trouble \n - $base ** $expt " is " $ism \ + " should be " $sbm + } + } + } + set trouble +} {test intermediate powers of 64-bit ints} + # Some compilers get this wrong; ensure that we work around it correctly test expr-24.1 {expr edge cases; shifting} {expr int(5)>>32} 0 test expr-24.2 {expr edge cases; shifting} {expr int(5)>>63} 0 @@ -6658,6 +6778,10 @@ test expr-47.12 {isqrt of various sizes of integer} { set trouble } {} +test expr-48.1 {Bug 1770224} { + expr {-0x8000000000000001 >> 0x8000000000000000} +} -1 + # cleanup if {[info exists a]} { unset a diff --git a/tests/ioUtil.test b/tests/ioUtil.test index c2894ce..9aa90b0 100644 --- a/tests/ioUtil.test +++ b/tests/ioUtil.test @@ -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: ioUtil.test,v 1.17 2006/11/03 00:34:53 hobbs Exp $ +# RCS: @(#) $Id: ioUtil.test,v 1.17.2.1 2007/09/04 17:44:07 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -301,6 +301,27 @@ test ioUtil-3.8 {TclOpenFileChannelDeleteProc: Verify that all procs have been d list $err9 $err10 $err11 } {{"TestOpenFileChannelProc1": could not be deleteed} {"TestOpenFileChannelProc2": could not be deleteed} {"TestOpenFileChannelProc3": could not be deleteed}} +test ioUtil-4.1 {open ... a+ must not use O_APPEND: Bug 1773127} -setup { + set f [tcltest::makeFile {} ioutil41.tmp] + set fid [open $f wb] + puts -nonewline $fid 123 + close $fid +} -body { + set fid [open $f ab+] + puts -nonewline $fid 456 + seek $fid 2 + set d [read $fid 2] + seek $fid 4 + puts -nonewline $fid x + close $fid + set fid [open $f rb] + append d [read $fid] + close $fid + return $d +} -cleanup { + tcltest::removeFile $f +} -result 341234x6 + cd $oldpwd # cleanup diff --git a/tests/lindex.test b/tests/lindex.test index 44ad429..a5e6b8a 100644 --- a/tests/lindex.test +++ b/tests/lindex.test @@ -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: lindex.test,v 1.14 2007/01/09 11:32:35 dkf Exp $ +# RCS: @(#) $Id: lindex.test,v 1.14.2.1 2007/09/04 17:44:07 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -428,8 +428,30 @@ test lindex-16.7 {data reuse} { set result } {} +test lindex-17.0 {Bug 1718580} {*}{ + -body { + lindex {} end foo + } + -match glob + -result {bad index "foo"*} + -returnCodes 1 +} + +test lindex-17.1 {Bug 1718580} {*}{ + -body { + lindex a end foo + } + -match glob + -result {bad index "foo"*} + -returnCodes 1 +} + catch { unset minus } # cleanup ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# End: diff --git a/tests/load.test b/tests/load.test index 373327f..f0d97d7 100644 --- a/tests/load.test +++ b/tests/load.test @@ -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: load.test,v 1.17 2006/12/17 03:47:08 das Exp $ +# RCS: @(#) $Id: load.test,v 1.17.2.1 2007/09/04 17:44:07 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -39,6 +39,10 @@ set alreadyTotalLoaded [info loaded] testConstraint teststaticpkg [llength [info commands teststaticpkg]] +# Test load-10.1 requires the 'testsimplefilesystem' command from tcltest + +testConstraint testsimplefilesystem \ + [llength [info commands testsimplefilesystem]] test load-1.1 {basic errors} {} { list [catch {load} msg] $msg @@ -196,6 +200,12 @@ test load-9.1 {Tcl_StaticPackage, load already-loaded package into another inter -result {{{{} Loadninepointone} {{} Tcltest}} {{{} Loadninepointone} {{} Tcltest}}} \ -cleanup { interp delete child1 ; interp delete child2 } +test load-10.1 {load from vfs} \ + -constraints [list $dll $loaded testsimplefilesystem] \ + -setup {set dir [pwd]; cd $testDir; testsimplefilesystem 1} \ + -body {list [catch {load simplefs:/pkgd$ext pkgd} msg] $msg} \ + -result {0 {}} \ + -cleanup {testsimplefilesystem 0; cd $dir; unset dir} # cleanup unset ext diff --git a/tests/main.test b/tests/main.test index 7842644..458ce86 100644 --- a/tests/main.test +++ b/tests/main.test @@ -1,6 +1,6 @@ # This file contains a collection of tests for generic/tclMain.c. # -# RCS: @(#) $Id: main.test,v 1.20 2006/09/04 21:34:58 dgp Exp $ +# RCS: @(#) $Id: main.test,v 1.20.6.1 2007/09/04 17:44:07 dgp Exp $ if {[catch {package require tcltest 2.0.2}]} { puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required." @@ -819,6 +819,20 @@ namespace eval ::tcl::test::main { file delete result } -result "Exit MainLoop\nIn exit\neven 0\n" + test Tcl_Main-5.13 { + Bug 1775878 + } -constraints { + exec + } -setup { + catch {set f [open "|[list [interpreter]]" w+]} + } -body { + type $f "puts \\" + type $f return + list [catch {gets $f} line] $line + } -cleanup { + close $f + } -result [list 0 return] + # Tests Tcl_Main-6.*: interactive operations with prompts test Tcl_Main-6.1 { @@ -1202,6 +1216,21 @@ namespace eval ::tcl::test::main { file delete result } -result "1\nExit MainLoop\n" + test Tcl_Main-8.13 { + Bug 1775878 + } -constraints { + exec Tcltest + } -setup { + catch {set f [open "|[list [interpreter]]" w+]} + } -body { + exec [interpreter] << "testsetmainloop\nputs \\\npwd\ntestexitmainloop" >& result + set f [open result] + read $f + } -cleanup { + close $f + file delete result + } -result "pwd\nExit MainLoop\n" + # Tests Tcl_Main-9.*: Prompt operations test Tcl_Main-9.1 { diff --git a/tests/parseExpr.test b/tests/parseExpr.test index fe90943..31b1649 100644 --- a/tests/parseExpr.test +++ b/tests/parseExpr.test @@ -1,5 +1,5 @@ # This file contains a collection of tests for the procedures in the -# file tclParseExpr.c. Sourcing this file into Tcl runs the tests and +# file tclCompExpr.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. @@ -8,14 +8,14 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: parseExpr.test,v 1.25.6.1 2007/07/19 22:52:58 dgp Exp $ +# RCS: @(#) $Id: parseExpr.test,v 1.25.6.2 2007/09/04 17:44:07 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } -# Note that the Tcl expression parser (tclParseExpr.c) does not check +# Note that the Tcl expression parser (tclCompExpr.c) does not check # the semantic validity of the expressions it parses. It does not check, # for example, that a math function actually exists, or that the operands # of "<<" are integers. diff --git a/tests/set-old.test b/tests/set-old.test index 722dbb3..0b8a694 100644 --- a/tests/set-old.test +++ b/tests/set-old.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: set-old.test,v 1.17 2003/03/27 21:44:05 msofer Exp $ +# RCS: @(#) $Id: set-old.test,v 1.17.14.1 2007/09/04 17:44:07 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -550,7 +550,7 @@ test set-old-8.38.6 {array command, set with non-existent namespace} { } {1 {can't set "bogusnamespace::var": parent namespace doesn't exist}} test set-old-8.38.7 {array command, set with non-existent namespace} { list [catch {array set bogusnamespace::var(0) {a b}} msg] $msg -} {1 {can't set "bogusnamespace::var(0)": variable isn't array}} +} {1 {can't set "bogusnamespace::var(0)": parent namespace doesn't exist}} test set-old-8.39 {array command, size option} { catch {unset a} array size a diff --git a/tests/thread.test b/tests/thread.test index 1084f5c..df830f7 100644 --- a/tests/thread.test +++ b/tests/thread.test @@ -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: thread.test,v 1.15 2006/10/09 19:15:45 msofer Exp $ +# RCS: @(#) $Id: thread.test,v 1.15.4.1 2007/09/04 17:44:08 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -195,6 +195,7 @@ test thread-4.4 {TclThreadSend preserve code} {testthread} { threadReap set len [llength [testthread names]] set serverthread [testthread create] + set ::errorInfo {} set x [catch {testthread send $serverthread {set ::errorInfo {}; break}} msg] threadReap list $len $x $msg $::errorInfo diff --git a/tests/trace.test b/tests/trace.test index 73d6fc8..a15790e 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.5 2007/06/27 22:44:48 dgp Exp $ +# RCS: @(#) $Id: trace.test,v 1.51.2.6 2007/09/04 17:44:11 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -231,6 +231,34 @@ test trace-2.5 {trace variable writes} { unset x set info } {} +test trace-2.6 {trace variable writes on compiled local} { + # + # Check correct function of whole array traces on compiled local + # arrays [Bug 1770591]. The corresponding function for read traces is + # already indirectly tested in trace-1.7 + # + catch {unset x} + set info {} + proc p {} { + trace add variable x write traceArray + set x(X) willy + } + p + set info +} {x X write 0 willy} +test trace-2.7 {trace variable writes on errorInfo} -body { + # + # Check correct behaviour of write traces on errorInfo. + # [Bug 1773040] + trace add variable ::errorInfo write traceScalar + catch {set dne} + lrange [set info] 0 2 +} -cleanup { + # always remove trace on errorInfo otherwise further tests will fail + unset ::errorInfo +} -result {::errorInfo {} write} + + # append no longer triggers read traces when fetching the old values of # variables before doing the append operation. However, lappend _does_ diff --git a/unix/Makefile.in b/unix/Makefile.in index f5e14e3..aa0956a 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -4,7 +4,7 @@ # "./configure", which is a configuration script generated by the "autoconf" # program (constructs like "@foo@" will get replaced in the actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.207.2.3 2007/07/01 17:31:25 dgp Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.207.2.4 2007/09/04 17:44:16 dgp Exp $ VERSION = @TCL_VERSION@ MAJOR_VERSION = @TCL_MAJOR_VERSION@ @@ -269,17 +269,15 @@ DDD = ddd # modify it and you shouldn't need to modify it either. #-------------------------------------------------------------------------- - -CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \ --I${BUILD_DIR} -I${UNIX_DIR} -I${GENERIC_DIR} -I${TOMMATH_DIR} \ -${AC_FLAGS} ${GENERIC_FLAGS} ${PROTO_FLAGS} \ -${NO_DEPRECATED_FLAGS} ${ENV_FLAGS} @EXTRA_CC_SWITCHES@ - STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \ -I${BUILD_DIR} -I${UNIX_DIR} -I${GENERIC_DIR} -I${TOMMATH_DIR} \ ${AC_FLAGS} ${GENERIC_FLAGS} ${PROTO_FLAGS} \ ${ENV_FLAGS} @EXTRA_CC_SWITCHES@ +CC_SWITCHES = $(STUB_CC_SWITCHES) ${NO_DEPRECATED_FLAGS} + +APP_CC_SWITCHES = $(CC_SWITCHES) @EXTRA_APP_CC_SWITCHES@ + LIBS = @TCL_LIBS@ DEPEND_SWITCHES = ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \ @@ -288,10 +286,10 @@ ${AC_FLAGS} ${GENERIC_FLAGS} ${PROTO_FLAGS} @EXTRA_CC_SWITCHES@ TCLSH_OBJS = tclAppInit.o TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \ - tclThreadTest.o tclUnixTest.o + tclThreadTest.o tclUnixTest.o XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \ - tclThreadTest.o tclUnixTest.o tclXtNotify.o tclXtTest.o + tclThreadTest.o tclUnixTest.o tclXtNotify.o tclXtTest.o GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \ tclAsync.o tclBasic.o tclBinary.o tclCkalloc.o tclClock.o \ @@ -795,8 +793,8 @@ install-libraries: libraries $(INSTALL_TZDATA) install-msgs @echo "Installing package tcltest 2.3a1 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3a1.tm; - @echo "Installing package platform 1.0.2 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.2.tm; + @echo "Installing package platform 1.0.3 as a Tcl Module"; + @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.3.tm; @echo "Installing package platform::shell 1.1.3 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.3.tm; @@ -909,7 +907,7 @@ tclTestInit.o: $(UNIX_DIR)/tclAppInit.c tclsh rm -f tclAppInit.sav; \ mv tclAppInit.o tclAppInit.sav; \ fi; - $(CC) -c $(CC_SWITCHES) \ + $(CC) -c $(APP_CC_SWITCHES) \ -DTCL_BUILDTIME_LIBRARY="\"${TCL_BUILDTIME_LIBRARY}\"" \ -DTCL_TEST $(UNIX_DIR)/tclAppInit.c rm -f tclTestInit.o @@ -923,7 +921,7 @@ xtTestInit.o: $(UNIX_DIR)/tclAppInit.c tclsh rm -f tclAppInit.sav; \ mv tclAppInit.o tclAppInit.sav; \ fi; - $(CC) -c $(CC_SWITCHES) \ + $(CC) -c $(APP_CC_SWITCHES) \ -DTCL_BUILDTIME_LIBRARY="\"${TCL_BUILDTIME_LIBRARY}\"" \ -DTCL_TEST -DTCL_XT_TEST $(UNIX_DIR)/tclAppInit.c rm -f xtTestInit.o @@ -957,7 +955,7 @@ regerror.o: $(REGHDRS) $(GENERIC_DIR)/regerrs.h $(GENERIC_DIR)/regerror.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regerror.c tclAppInit.o: $(UNIX_DIR)/tclAppInit.c - $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclAppInit.c + $(CC) -c $(APP_CC_SWITCHES) $(UNIX_DIR)/tclAppInit.c # On Unix we want to use the normal malloc/free implementation, so we # specifically set the USE_TCLALLOC flag. @@ -1188,13 +1186,13 @@ tclVar.o: $(GENERIC_DIR)/tclVar.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclVar.c tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS) - $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTest.c + $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c tclTestObj.o: $(GENERIC_DIR)/tclTestObj.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTestObj.c + $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestObj.c tclTestProcBodyObj.o: $(GENERIC_DIR)/tclTestProcBodyObj.c - $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTestProcBodyObj.c + $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestProcBodyObj.c tclTimer.o: $(GENERIC_DIR)/tclTimer.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTimer.c @@ -1212,7 +1210,7 @@ tclThreadStorage.o: $(GENERIC_DIR)/tclThreadStorage.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadStorage.c tclThreadTest.o: $(GENERIC_DIR)/tclThreadTest.c - $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadTest.c + $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclThreadTest.c tclTomMathInterface.o: $(GENERIC_DIR)/tclTomMathInterface.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTomMathInterface.c @@ -1422,7 +1420,7 @@ tclUnixSock.o: $(UNIX_DIR)/tclUnixSock.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixSock.c tclUnixTest.o: $(UNIX_DIR)/tclUnixTest.c - $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixTest.c + $(CC) -c $(APP_CC_SWITCHES) $(UNIX_DIR)/tclUnixTest.c tclUnixThrd.o: $(UNIX_DIR)/tclUnixThrd.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixThrd.c @@ -1459,11 +1457,11 @@ xttest: ${XTTEST_OBJS} ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} \ ${CC_SEARCH_FLAGS} -L/usr/openwin/lib -lXt -o xttest tclXtNotify.o: $(UNIX_DIR)/tclXtNotify.c - $(CC) -c $(CC_SWITCHES) -I/usr/openwin/include \ + $(CC) -c $(APP_CC_SWITCHES) -I/usr/openwin/include \ $(UNIX_DIR)/tclXtNotify.c tclXtTest.o: $(UNIX_DIR)/tclXtTest.c - $(CC) -c $(CC_SWITCHES) -I/usr/openwin/include \ + $(CC) -c $(APP_CC_SWITCHES) -I/usr/openwin/include \ $(UNIX_DIR)/tclXtTest.c # Compat binaries, these must be compiled for use in a shared library even diff --git a/unix/configure b/unix/configure index 381f4f4..27f01e2 100755 --- a/unix/configure +++ b/unix/configure @@ -308,7 +308,7 @@ ac_includes_default="\ # include #endif" -ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS RANLIB ac_ct_RANLIB AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT INSTALL_TZDATA TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_YEAR TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_SRC_DIR CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX TCL_SHARED_BUILD LD_LIBRARY_PATH_VAR TCL_BUILD_LIB_SPEC TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_SHARED_LIB_SUFFIX TCL_UNSHARED_LIB_SUFFIX TCL_HAS_LONGLONG BUILD_DLTEST TCL_PACKAGE_PATH TCL_MODULE_PATH TCL_LIBRARY PRIVATE_INCLUDE_DIR HTML_DIR EXTRA_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_TCLSH_LIBS DLTEST_LD DLTEST_SUFFIX' +ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS RANLIB ac_ct_RANLIB AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT INSTALL_TZDATA TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_YEAR TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_SRC_DIR CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX TCL_SHARED_BUILD LD_LIBRARY_PATH_VAR TCL_BUILD_LIB_SPEC TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_SHARED_LIB_SUFFIX TCL_UNSHARED_LIB_SUFFIX TCL_HAS_LONGLONG BUILD_DLTEST TCL_PACKAGE_PATH TCL_MODULE_PATH TCL_LIBRARY PRIVATE_INCLUDE_DIR HTML_DIR EXTRA_CC_SWITCHES EXTRA_APP_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_TCLSH_LIBS DLTEST_LD DLTEST_SUFFIX' ac_subst_files='' # Initialize some variables set by options. @@ -2356,6 +2356,78 @@ ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $ ac_compiler_gnu=$ac_cv_c_compiler_gnu +echo "$as_me:$LINENO: checking for inline" >&5 +echo $ECHO_N "checking for inline... $ECHO_C" >&6 +if test "${ac_cv_c_inline+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_cv_c_inline=no +for ac_kw in inline __inline__ __inline; do + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#ifndef __cplusplus +typedef int foo_t; +static $ac_kw foo_t static_foo () {return 0; } +$ac_kw foo_t foo () {return 0; } +#endif + +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_c_inline=$ac_kw; break +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +done + +fi +echo "$as_me:$LINENO: result: $ac_cv_c_inline" >&5 +echo "${ECHO_T}$ac_cv_c_inline" >&6 + + +case $ac_cv_c_inline in + inline | yes) ;; + *) + case $ac_cv_c_inline in + no) ac_val=;; + *) ac_val=$ac_cv_c_inline;; + esac + cat >>confdefs.h <<_ACEOF +#ifndef __cplusplus +#define inline $ac_val +#endif +_ACEOF + ;; +esac + + #-------------------------------------------------------------------- # Supply substitutes for missing POSIX header files. Special notes: # - stdlib.h doesn't define strtol, strtoul, or @@ -2365,7 +2437,6 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu # Do this early, otherwise an autoconf bug throws errors on configure #-------------------------------------------------------------------- - ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' @@ -17678,11 +17749,13 @@ echo "${ECHO_T}static library" >&6 fi TCL_SHLIB_LD_EXTRAS="-compatibility_version ${TCL_VERSION} -current_version ${TCL_VERSION}`echo ${TCL_PATCH_LEVEL} | awk '{match($0, "\\\.[0-9]+"); print substr($0,RSTART,RLENGTH)}'`" - TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -install_name ${DYLIB_INSTALL_DIR}/${TCL_LIB_FILE} -seg1addr 0xa000000' + TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -install_name ${DYLIB_INSTALL_DIR}/${TCL_LIB_FILE}' + echo "$LDFLAGS " | grep -q -- '-prebind ' && TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -seg1addr 0xa000000' TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -sectcreate __TEXT __info_plist Tcl-Info.plist' EXTRA_TCLSH_LIBS='-sectcreate __TEXT __info_plist Tclsh-Info.plist' ac_config_files="$ac_config_files Tcl-Info.plist:../macosx/Tcl-Info.plist.in Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in" + EXTRA_APP_CC_SWITCHES='-mdynamic-no-pic' fi if test "$FRAMEWORK_BUILD" = "1" ; then @@ -17758,12 +17831,14 @@ VERSION=${TCL_VERSION} #-------------------------------------------------------------------- if test "$FRAMEWORK_BUILD" = "1" ; then - TCL_PACKAGE_PATH="~/Library/Tcl /Library/Tcl /Network/Library/Tcl /System/Library/Tcl ~/Library/Frameworks /Library/Frameworks /Network/Library/Frameworks /System/Library/Frameworks" - TCL_MODULE_PATH="~/Library/Tcl /Library/Tcl /Network/Library/Tcl /System/Library/Tcl" + test -z "$TCL_PACKAGE_PATH" && \ + TCL_PACKAGE_PATH="~/Library/Tcl /Library/Tcl /Network/Library/Tcl /System/Library/Tcl ~/Library/Frameworks /Library/Frameworks /Network/Library/Frameworks /System/Library/Frameworks" + test -z "$TCL_MODULE_PATH" && \ + TCL_MODULE_PATH="~/Library/Tcl /Library/Tcl /Network/Library/Tcl /System/Library/Tcl" elif test "$prefix/lib" != "$libdir"; then - TCL_PACKAGE_PATH="${libdir} ${prefix}/lib" + TCL_PACKAGE_PATH="${libdir} ${prefix}/lib ${TCL_PACKAGE_PATH}" else - TCL_PACKAGE_PATH="${prefix}/lib" + TCL_PACKAGE_PATH="${prefix}/lib ${TCL_PACKAGE_PATH}" fi #-------------------------------------------------------------------- @@ -17852,6 +17927,7 @@ TCL_SHARED_BUILD=${SHARED_BUILD} + ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in" cat >confcache <<\_ACEOF @@ -18568,6 +18644,7 @@ s,@TCL_LIBRARY@,$TCL_LIBRARY,;t t s,@PRIVATE_INCLUDE_DIR@,$PRIVATE_INCLUDE_DIR,;t t s,@HTML_DIR@,$HTML_DIR,;t t s,@EXTRA_CC_SWITCHES@,$EXTRA_CC_SWITCHES,;t t +s,@EXTRA_APP_CC_SWITCHES@,$EXTRA_APP_CC_SWITCHES,;t t s,@EXTRA_INSTALL@,$EXTRA_INSTALL,;t t s,@EXTRA_INSTALL_BINARIES@,$EXTRA_INSTALL_BINARIES,;t t s,@EXTRA_BUILD_HTML@,$EXTRA_BUILD_HTML,;t t diff --git a/unix/configure.in b/unix/configure.in index 2ad849f..c4626d3 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.2 2007/06/12 15:56:45 dgp Exp $ +# RCS: @(#) $Id: configure.in,v 1.157.2.3 2007/09/04 17:44:20 dgp Exp $ AC_INIT([tcl],[8.5]) AC_PREREQ(2.59) @@ -61,6 +61,7 @@ if test "${CFLAGS+set}" != "set" ; then fi AC_PROG_CC +AC_C_INLINE #-------------------------------------------------------------------- # Supply substitutes for missing POSIX header files. Special notes: @@ -657,10 +658,12 @@ HTML_DIR='$(DISTDIR)/html' if test "`uname -s`" = "Darwin" ; then SC_ENABLE_FRAMEWORK TCL_SHLIB_LD_EXTRAS="-compatibility_version ${TCL_VERSION} -current_version ${TCL_VERSION}`echo ${TCL_PATCH_LEVEL} | awk ['{match($0, "\\\.[0-9]+"); print substr($0,RSTART,RLENGTH)}']`" - TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -install_name ${DYLIB_INSTALL_DIR}/${TCL_LIB_FILE} -seg1addr 0xa000000' + TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -install_name ${DYLIB_INSTALL_DIR}/${TCL_LIB_FILE}' + echo "$LDFLAGS " | grep -q -- '-prebind ' && TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -seg1addr 0xa000000' TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -sectcreate __TEXT __info_plist Tcl-Info.plist' EXTRA_TCLSH_LIBS='-sectcreate __TEXT __info_plist Tclsh-Info.plist' AC_CONFIG_FILES([Tcl-Info.plist:../macosx/Tcl-Info.plist.in Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in]) + EXTRA_APP_CC_SWITCHES='-mdynamic-no-pic' fi if test "$FRAMEWORK_BUILD" = "1" ; then @@ -737,12 +740,14 @@ VERSION=${TCL_VERSION} #-------------------------------------------------------------------- if test "$FRAMEWORK_BUILD" = "1" ; then - TCL_PACKAGE_PATH="~/Library/Tcl /Library/Tcl /Network/Library/Tcl /System/Library/Tcl ~/Library/Frameworks /Library/Frameworks /Network/Library/Frameworks /System/Library/Frameworks" - TCL_MODULE_PATH="~/Library/Tcl /Library/Tcl /Network/Library/Tcl /System/Library/Tcl" + test -z "$TCL_PACKAGE_PATH" && \ + TCL_PACKAGE_PATH="~/Library/Tcl /Library/Tcl /Network/Library/Tcl /System/Library/Tcl ~/Library/Frameworks /Library/Frameworks /Network/Library/Frameworks /System/Library/Frameworks" + test -z "$TCL_MODULE_PATH" && \ + TCL_MODULE_PATH="~/Library/Tcl /Library/Tcl /Network/Library/Tcl /System/Library/Tcl" elif test "$prefix/lib" != "$libdir"; then - TCL_PACKAGE_PATH="${libdir} ${prefix}/lib" + TCL_PACKAGE_PATH="${libdir} ${prefix}/lib ${TCL_PACKAGE_PATH}" else - TCL_PACKAGE_PATH="${prefix}/lib" + TCL_PACKAGE_PATH="${prefix}/lib ${TCL_PACKAGE_PATH}" fi #-------------------------------------------------------------------- @@ -822,6 +827,7 @@ AC_SUBST(PRIVATE_INCLUDE_DIR) AC_SUBST(HTML_DIR) AC_SUBST(EXTRA_CC_SWITCHES) +AC_SUBST(EXTRA_APP_CC_SWITCHES) AC_SUBST(EXTRA_INSTALL) AC_SUBST(EXTRA_INSTALL_BINARIES) AC_SUBST(EXTRA_BUILD_HTML) diff --git a/unix/dltest/pkga.c b/unix/dltest/pkga.c index 0e7ab90..4094742 100644 --- a/unix/dltest/pkga.c +++ b/unix/dltest/pkga.c @@ -9,8 +9,9 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: pkga.c,v 1.9.2.1 2007/05/30 03:31:31 dgp Exp $ + * RCS: @(#) $Id: pkga.c,v 1.9.2.2 2007/09/04 17:44:24 dgp Exp $ */ + #include "tcl.h" /* diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c index e290b2a..52b5b2b 100644 --- a/unix/dltest/pkgb.c +++ b/unix/dltest/pkgb.c @@ -10,8 +10,9 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: pkgb.c,v 1.6.2.1 2007/05/30 03:31:31 dgp Exp $ + * RCS: @(#) $Id: pkgb.c,v 1.6.2.2 2007/09/04 17:44:24 dgp Exp $ */ + #include "tcl.h" /* @@ -51,11 +52,11 @@ Pkgb_SubObjCmd( if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "num num"); - return TCL_ERROR; + return TCL_ERROR; } if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK) || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) { - return TCL_ERROR; + return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second)); return TCL_OK; @@ -133,7 +134,7 @@ Pkgb_Init( * Pkgb_SafeInit -- * * This is a package initialization procedure, which is called by Tcl - * when this package is to be added to an unsafe interpreter. + * when this package is to be added to a safe interpreter. * * Results: * None. diff --git a/unix/dltest/pkgc.c b/unix/dltest/pkgc.c index 8e89e9f..ad44639 100644 --- a/unix/dltest/pkgc.c +++ b/unix/dltest/pkgc.c @@ -10,8 +10,9 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: pkgc.c,v 1.6.2.1 2007/05/30 03:31:31 dgp Exp $ + * RCS: @(#) $Id: pkgc.c,v 1.6.2.2 2007/09/04 17:44:24 dgp Exp $ */ + #include "tcl.h" /* @@ -19,9 +20,9 @@ */ static int Pkgc_SubObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]); + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int Pkgc_UnsafeObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]); + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); /* *---------------------------------------------------------------------- @@ -95,8 +96,7 @@ Pkgc_UnsafeObjCmd( * Pkgc_Init -- * * This is a package initialization procedure, which is called by Tcl - * when this package is to be added to a normal (unsafe/trusted) - * interpreter. + * when this package is to be added to an interpreter. * * Results: * None. diff --git a/unix/dltest/pkge.c b/unix/dltest/pkge.c index 4cf9583..c7352d7 100644 --- a/unix/dltest/pkge.c +++ b/unix/dltest/pkge.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: pkge.c,v 1.7.2.1 2007/05/30 03:31:31 dgp Exp $ + * RCS: @(#) $Id: pkge.c,v 1.7.2.2 2007/09/04 17:44:24 dgp Exp $ */ #include "tcl.h" @@ -39,6 +39,7 @@ Pkge_Init( * made available. */ { static char script[] = "if 44 {open non_existent}"; + if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { return TCL_ERROR; } diff --git a/unix/dltest/pkgf.c b/unix/dltest/pkgf.c deleted file mode 100644 index b06de23..0000000 --- a/unix/dltest/pkgf.c +++ /dev/null @@ -1,46 +0,0 @@ -/* - * pkgf.c -- - * - * This file contains a simple Tcl package "pkgf" that is intended for - * testing the Tcl dynamic loading facilities. Its Init procedure returns - * an error in order to test how this is handled. - * - * Copyright (c) 1995 Sun Microsystems, Inc. - * - * See the file "license.terms" for information on usage and redistribution of - * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: pkgf.c,v 1.6.2.1 2007/05/30 03:31:31 dgp Exp $ - */ - -#include "tcl.h" - - -/* - *---------------------------------------------------------------------- - * - * Pkgf_Init -- - * - * This is a package initialization procedure, which is called by Tcl - * when this package is to be added to an interpreter. - * - * Results: - * Returns TCL_ERROR and leaves an error message in interp->result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -int -Pkgf_Init( - Tcl_Interp *interp) /* Interpreter in which the package is to be - * made available. */ -{ - static char script[] = "if 44 {open non_existent}"; - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { - return TCL_ERROR; - } - return Tcl_Eval(interp, script); -} diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c index a898842..b2ba1c3 100644 --- a/unix/dltest/pkgua.c +++ b/unix/dltest/pkgua.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: pkgua.c,v 1.4.2.1 2007/05/30 03:31:31 dgp Exp $ + * RCS: @(#) $Id: pkgua.c,v 1.4.2.2 2007/09/04 17:44:25 dgp Exp $ */ #include "tcl.h" @@ -50,7 +50,7 @@ PkguaInitTokensHashTable(void) Tcl_InitHashTable(&interpTokenMap, TCL_ONE_WORD_KEYS); interpTokenMapInitialised = 1; } - + void PkguaFreeTokensHashTable(void) { @@ -63,7 +63,7 @@ PkguaFreeTokensHashTable(void) } interpTokenMapInitialised = 0; } - + static Tcl_Command * PkguaInterpToTokens( Tcl_Interp *interp) @@ -85,7 +85,7 @@ PkguaInterpToTokens( } return cmdTokens; } - + static void PkguaDeleteTokens( Tcl_Interp *interp) @@ -235,7 +235,7 @@ Pkgua_Init( * Pkgua_SafeInit -- * * This is a package initialization procedure, which is called by Tcl - * when this package is to be added to an unsafe interpreter. + * when this package is to be added to a safe interpreter. * * Results: * None. @@ -260,7 +260,7 @@ Pkgua_SafeInit( * Pkgua_Unload -- * * This is a package unloading initialization procedure, which is called - * by Tcl when this package is to be unloaded form an interpreter. + * by Tcl when this package is to be unloaded from an interpreter. * * Results: * None. @@ -313,7 +313,7 @@ Pkgua_Unload( * Pkgua_SafeUnload -- * * This is a package unloading initialization procedure, which is called - * by Tcl when this package is to be unloaded form an interpreter. + * by Tcl when this package is to be unloaded from an interpreter. * * Results: * None. diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in index 4ce32be..8636c5f 100644 --- a/unix/tclConfig.h.in +++ b/unix/tclConfig.h.in @@ -475,6 +475,12 @@ /* Define to `int' if doesn't define. */ #undef gid_t +/* Define to `__inline__' or `__inline' if that's what the C compiler + calls it, or to nothing if 'inline' is not supported under any name. */ +#ifndef __cplusplus +#undef inline +#endif + /* Signed integer type wide enough to hold a pointer. */ #undef intptr_t diff --git a/unix/tclLoadDyld.c b/unix/tclLoadDyld.c index f538968..8c8ef33 100644 --- a/unix/tclLoadDyld.c +++ b/unix/tclLoadDyld.c @@ -3,7 +3,7 @@ * * This procedure provides a version of the TclLoadFile that works with * Apple's dyld dynamic loading. - * Original version of his file (now superseded long ago) provided by + * Original version of his file (superseded long ago) provided by * Wilfredo Sanchez (wsanchez@apple.com). * * Copyright (c) 1995 Apple Computer, Inc. @@ -12,10 +12,50 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLoadDyld.c,v 1.26 2007/04/23 20:37:10 das Exp $ + * RCS: @(#) $Id: tclLoadDyld.c,v 1.26.2.1 2007/09/04 17:44:21 dgp Exp $ */ #include "tclInt.h" + +#ifndef MODULE_SCOPE +#define MODULE_SCOPE extern +#endif + +#ifndef TCL_DYLD_USE_DLFCN +/* + * Use preferred dlfcn API on 10.4 and later + */ +# if !defined(NO_DLFCN_H) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1040 +# define TCL_DYLD_USE_DLFCN 1 +# else +# define TCL_DYLD_USE_DLFCN 0 +# endif +#endif +#ifndef TCL_DYLD_USE_NSMODULE +/* + * Use deprecated NSModule API only to support 10.3 and earlier: + */ +# if MAC_OS_X_VERSION_MIN_REQUIRED < 1040 +# define TCL_DYLD_USE_NSMODULE 1 +# else +# define TCL_DYLD_USE_NSMODULE 0 +# endif +#endif + +#if TCL_DYLD_USE_DLFCN +#include +#if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1040 +/* + * Support for weakly importing dlfcn API. + */ +extern void *dlopen(const char *path, int mode) WEAK_IMPORT_ATTRIBUTE; +extern void *dlsym(void *handle, const char *symbol) WEAK_IMPORT_ATTRIBUTE; +extern int dlclose(void *handle) WEAK_IMPORT_ATTRIBUTE; +extern char *dlerror(void) WEAK_IMPORT_ATTRIBUTE; +#endif +#endif + +#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY) #include #include #include @@ -27,16 +67,33 @@ typedef struct Tcl_DyldModuleHandle { struct Tcl_DyldModuleHandle *nextPtr; NSModule module; } Tcl_DyldModuleHandle; +#endif /* TCL_DYLD_USE_NSMODULE */ typedef struct Tcl_DyldLoadHandle { - CONST struct mach_header *dyldLibHeader; +#if TCL_DYLD_USE_DLFCN + void *dlHandle; +#endif +#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY) + const struct mach_header *dyldLibHeader; Tcl_DyldModuleHandle *modulePtr; +#endif } Tcl_DyldLoadHandle; -#ifdef TCL_LOAD_FROM_MEMORY +#if (TCL_DYLD_USE_DLFCN && MAC_OS_X_VERSION_MIN_REQUIRED < 1040) || \ + defined(TCL_LOAD_FROM_MEMORY) MODULE_SCOPE long tclMacOSXDarwinRelease; #endif + +#ifdef TCL_DEBUG_LOAD +#define TclLoadDbgMsg(m, ...) do { \ + fprintf(stderr, "%s:%d: %s(): " m ".\n", \ + strrchr(__FILE__, '/')+1, __LINE__, __func__, ##__VA_ARGS__); \ + } while (0) +#else +#define TclLoadDbgMsg(m, ...) +#endif +#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY) /* *---------------------------------------------------------------------- * @@ -75,6 +132,7 @@ DyldOFIErrorMsg( return "unknown error"; } } +#endif /* TCL_DYLD_USE_NSMODULE */ /* *---------------------------------------------------------------------- @@ -99,7 +157,7 @@ TclpDlopen( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Obj *pathPtr, /* Name of the file containing the desired * code (UTF-8). */ - Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded + Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr) @@ -108,10 +166,23 @@ TclpDlopen( * file. */ { Tcl_DyldLoadHandle *dyldLoadHandle; - CONST struct mach_header *dyldLibHeader; - NSObjectFileImage dyldObjFileImage = NULL; +#if TCL_DYLD_USE_DLFCN + void *dlHandle = NULL; +#endif +#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY) + const struct mach_header *dyldLibHeader = NULL; Tcl_DyldModuleHandle *modulePtr = NULL; - CONST char *native; +#endif +#if TCL_DYLD_USE_NSMODULE + NSLinkEditErrors editError; + int errorNumber; + const char *errorName, *objFileImageErrMsg = NULL; +#endif + const char *errMsg = NULL; + int result; + Tcl_DString ds; + char *fileName = NULL; + const char *nativePath, *nativeFileName = NULL; /* * First try the full path the user gave us. This is particularly @@ -119,92 +190,139 @@ TclpDlopen( * relative path. */ - native = Tcl_FSGetNativePath(pathPtr); - dyldLibHeader = NSAddImage(native, NSADDIMAGE_OPTION_RETURN_ON_ERROR); + nativePath = Tcl_FSGetNativePath(pathPtr); - if (!dyldLibHeader) { - NSLinkEditErrors editError; - int errorNumber; - CONST char *name, *msg, *objFileImageErrMsg = NULL; - - NSLinkEditError(&editError, &errorNumber, &name, &msg); - - if (editError == NSLinkEditFileAccessError) { - /* - * The requested file was not found. Let the OS loader examine the - * binary search path for whatever string the user gave us which - * hopefully refers to a file on the binary path. - */ - - Tcl_DString ds; - char *fileName = Tcl_GetString(pathPtr); - CONST char *native = - Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); - - dyldLibHeader = NSAddImage(native, NSADDIMAGE_OPTION_WITH_SEARCHING - | NSADDIMAGE_OPTION_RETURN_ON_ERROR); - Tcl_DStringFree(&ds); - if (!dyldLibHeader) { - NSLinkEditError(&editError, &errorNumber, &name, &msg); - } - } else if ((editError == NSLinkEditFileFormatError - && errorNumber == EBADMACHO) - || editError == NSLinkEditOtherError){ +#if TCL_DYLD_USE_DLFCN +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1040 + if (tclMacOSXDarwinRelease >= 8) +#endif + { + dlHandle = dlopen(nativePath, RTLD_NOW | RTLD_LOCAL); + if (!dlHandle) { /* - * The requested file was found but was not of type MH_DYLIB, - * attempt to load it as a MH_BUNDLE. + * Let the OS loader examine the binary search path for whatever + * string the user gave us which hopefully refers to a file on the + * binary path. */ - NSObjectFileImageReturnCode err = - NSCreateObjectFileImageFromFile(native, &dyldObjFileImage); - objFileImageErrMsg = DyldOFIErrorMsg(err); + fileName = Tcl_GetString(pathPtr); + nativeFileName = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); + dlHandle = dlopen(nativeFileName, RTLD_NOW | RTLD_LOCAL); } - - if (!dyldLibHeader && !dyldObjFileImage) { - Tcl_AppendResult(interp, msg, NULL); - if (msg && *msg) { - Tcl_AppendResult(interp, "\n", NULL); - } - if (objFileImageErrMsg) { - Tcl_AppendResult(interp, - "NSCreateObjectFileImageFromFile() error: ", - objFileImageErrMsg, NULL); + if (dlHandle) { + TclLoadDbgMsg("dlopen() successful"); + } else { + errMsg = dlerror(); + TclLoadDbgMsg("dlopen() failed: %s", errMsg); + } + } + if (!dlHandle) +#endif /* TCL_DYLD_USE_DLFCN */ + { +#if TCL_DYLD_USE_NSMODULE + dyldLibHeader = NSAddImage(nativePath, + NSADDIMAGE_OPTION_RETURN_ON_ERROR); + if (dyldLibHeader) { + TclLoadDbgMsg("NSAddImage() successful"); + } else { + NSLinkEditError(&editError, &errorNumber, &errorName, &errMsg); + if (editError == NSLinkEditFileAccessError) { + /* + * The requested file was not found. Let the OS loader examine + * the binary search path for whatever string the user gave us + * which hopefully refers to a file on the binary path. + */ + + if (!fileName) { + fileName = Tcl_GetString(pathPtr); + nativeFileName = Tcl_UtfToExternalDString(NULL, fileName, + -1, &ds); + } + dyldLibHeader = NSAddImage(nativeFileName, + NSADDIMAGE_OPTION_WITH_SEARCHING | + NSADDIMAGE_OPTION_RETURN_ON_ERROR); + if (dyldLibHeader) { + TclLoadDbgMsg("NSAddImage() successful"); + } else { + NSLinkEditError(&editError, &errorNumber, &errorName, + &errMsg); + TclLoadDbgMsg("NSAddImage() failed: %s", errMsg); + } + } else if ((editError == NSLinkEditFileFormatError + && errorNumber == EBADMACHO) + || editError == NSLinkEditOtherError){ + NSObjectFileImageReturnCode err; + NSObjectFileImage dyldObjFileImage; + NSModule module; + + /* + * The requested file was found but was not of type MH_DYLIB, + * attempt to load it as a MH_BUNDLE. + */ + + err = NSCreateObjectFileImageFromFile(nativePath, + &dyldObjFileImage); + if (err == NSObjectFileImageSuccess && dyldObjFileImage) { + TclLoadDbgMsg("NSCreateObjectFileImageFromFile() " + "successful"); + module = NSLinkModule(dyldObjFileImage, nativePath, + NSLINKMODULE_OPTION_BINDNOW + | NSLINKMODULE_OPTION_RETURN_ON_ERROR); + NSDestroyObjectFileImage(dyldObjFileImage); + if (module) { + modulePtr = (Tcl_DyldModuleHandle *) + ckalloc(sizeof(Tcl_DyldModuleHandle)); + modulePtr->module = module; + modulePtr->nextPtr = NULL; + TclLoadDbgMsg("NSLinkModule() successful"); + } else { + NSLinkEditError(&editError, &errorNumber, &errorName, + &errMsg); + TclLoadDbgMsg("NSLinkModule() failed: %s", errMsg); + } + } else { + objFileImageErrMsg = DyldOFIErrorMsg(err); + TclLoadDbgMsg("NSCreateObjectFileImageFromFile() failed: " + "%s", objFileImageErrMsg); + } } - return TCL_ERROR; } +#endif /* TCL_DYLD_USE_NSMODULE */ } - - if (dyldObjFileImage) { - NSModule module; - - module = NSLinkModule(dyldObjFileImage, native, - NSLINKMODULE_OPTION_BINDNOW - | NSLINKMODULE_OPTION_RETURN_ON_ERROR); - NSDestroyObjectFileImage(dyldObjFileImage); - - if (!module) { - NSLinkEditErrors editError; - int errorNumber; - CONST char *name, *msg; - - NSLinkEditError(&editError, &errorNumber, &name, &msg); - Tcl_AppendResult(interp, msg, NULL); - return TCL_ERROR; + if (0 +#if TCL_DYLD_USE_DLFCN + || dlHandle +#endif +#if TCL_DYLD_USE_NSMODULE + || dyldLibHeader || modulePtr +#endif + ) { + dyldLoadHandle = (Tcl_DyldLoadHandle *) + ckalloc(sizeof(Tcl_DyldLoadHandle)); +#if TCL_DYLD_USE_DLFCN + dyldLoadHandle->dlHandle = dlHandle; +#endif +#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY) + dyldLoadHandle->dyldLibHeader = dyldLibHeader; + dyldLoadHandle->modulePtr = modulePtr; +#endif + *loadHandle = (Tcl_LoadHandle) dyldLoadHandle; + *unloadProcPtr = &TclpUnloadFile; + result = TCL_OK; + } else { + Tcl_AppendResult(interp, errMsg, NULL); +#if TCL_DYLD_USE_NSMODULE + if (objFileImageErrMsg) { + Tcl_AppendResult(interp, "\nNSCreateObjectFileImageFromFile() " + "error: ", objFileImageErrMsg, NULL); } - - modulePtr = (Tcl_DyldModuleHandle *) - ckalloc(sizeof(Tcl_DyldModuleHandle)); - modulePtr->module = module; - modulePtr->nextPtr = NULL; +#endif + result = TCL_ERROR; } - - dyldLoadHandle = (Tcl_DyldLoadHandle *) - ckalloc(sizeof(Tcl_DyldLoadHandle)); - dyldLoadHandle->dyldLibHeader = dyldLibHeader; - dyldLoadHandle->modulePtr = modulePtr; - *loadHandle = (Tcl_LoadHandle) dyldLoadHandle; - *unloadProcPtr = &TclpUnloadFile; - return TCL_OK; + if(fileName) { + Tcl_DStringFree(&ds); + } + return result; } /* @@ -229,68 +347,97 @@ TclpFindSymbol( Tcl_LoadHandle loadHandle, /* Handle from TclpDlopen. */ CONST char *symbol) /* Symbol name to look up. */ { - NSSymbol nsSymbol; - CONST char *native; - Tcl_DString newName, ds; - Tcl_PackageInitProc *proc = NULL; Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *) loadHandle; - - /* - * dyld adds an underscore to the beginning of symbol names. - */ + Tcl_PackageInitProc *proc = NULL; + const char *errMsg = NULL; + Tcl_DString ds; + const char *native; native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds); - Tcl_DStringInit(&newName); - Tcl_DStringAppend(&newName, "_", 1); - native = Tcl_DStringAppend(&newName, native, -1); - - if (dyldLoadHandle->dyldLibHeader) { - nsSymbol = NSLookupSymbolInImage(dyldLoadHandle->dyldLibHeader, native, - NSLOOKUPSYMBOLINIMAGE_OPTION_BIND_NOW | - NSLOOKUPSYMBOLINIMAGE_OPTION_RETURN_ON_ERROR); - if (nsSymbol) { - /* - * Until dyld supports unloading of MY_DYLIB binaries, the - * following is not needed. - */ +#if TCL_DYLD_USE_DLFCN + if (dyldLoadHandle->dlHandle) { + proc = dlsym(dyldLoadHandle->dlHandle, native); + if (proc) { + TclLoadDbgMsg("dlsym() successful"); + } else { + errMsg = dlerror(); + TclLoadDbgMsg("dlsym() failed: %s", errMsg); + } + } else +#endif /* TCL_DYLD_USE_DLFCN */ + { +#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY) + NSSymbol nsSymbol = NULL; + Tcl_DString newName; -#ifdef DYLD_SUPPORTS_DYLIB_UNLOADING - NSModule module = NSModuleForSymbol(nsSymbol); - Tcl_DyldModuleHandle *modulePtr = dyldLoadHandle->modulePtr; + /* + * dyld adds an underscore to the beginning of symbol names. + */ - while (modulePtr != NULL) { - if (module == modulePtr->module) { - break; + Tcl_DStringInit(&newName); + Tcl_DStringAppend(&newName, "_", 1); + native = Tcl_DStringAppend(&newName, native, -1); + if (dyldLoadHandle->dyldLibHeader) { + nsSymbol = NSLookupSymbolInImage(dyldLoadHandle->dyldLibHeader, + native, NSLOOKUPSYMBOLINIMAGE_OPTION_BIND_NOW | + NSLOOKUPSYMBOLINIMAGE_OPTION_RETURN_ON_ERROR); + if (nsSymbol) { + TclLoadDbgMsg("NSLookupSymbolInImage() successful"); +#ifdef DYLD_SUPPORTS_DYLIB_UNLOADING + /* + * Until dyld supports unloading of MY_DYLIB binaries, the + * following is not needed. + */ + + NSModule module = NSModuleForSymbol(nsSymbol); + Tcl_DyldModuleHandle *modulePtr = dyldLoadHandle->modulePtr; + + while (modulePtr != NULL) { + if (module == modulePtr->module) { + break; + } + modulePtr = modulePtr->nextPtr; + } + if (modulePtr == NULL) { + modulePtr = (Tcl_DyldModuleHandle *) + ckalloc(sizeof(Tcl_DyldModuleHandle)); + modulePtr->module = module; + modulePtr->nextPtr = dyldLoadHandle->modulePtr; + dyldLoadHandle->modulePtr = modulePtr; } - modulePtr = modulePtr->nextPtr; - } - if (modulePtr == NULL) { - modulePtr = (Tcl_DyldModuleHandle *) - ckalloc(sizeof(Tcl_DyldModuleHandle)); - modulePtr->module = module; - modulePtr->nextPtr = dyldLoadHandle->modulePtr; - dyldLoadHandle->modulePtr = modulePtr; - } #endif /* DYLD_SUPPORTS_DYLIB_UNLOADING */ + } else { + NSLinkEditErrors editError; + int errorNumber; + const char *errorName; - } else { - NSLinkEditErrors editError; - int errorNumber; - CONST char *name, *msg; - - NSLinkEditError(&editError, &errorNumber, &name, &msg); - Tcl_AppendResult(interp, msg, NULL); + NSLinkEditError(&editError, &errorNumber, &errorName, &errMsg); + TclLoadDbgMsg("NSLookupSymbolInImage() failed: %s", errMsg); + } + } else if (dyldLoadHandle->modulePtr) { + nsSymbol = NSLookupSymbolInModule( + dyldLoadHandle->modulePtr->module, native); + if (nsSymbol) { + TclLoadDbgMsg("NSLookupSymbolInModule() successful"); + } else { + TclLoadDbgMsg("NSLookupSymbolInModule() failed"); + } } - } else { - nsSymbol = NSLookupSymbolInModule(dyldLoadHandle->modulePtr->module, - native); - } - if (nsSymbol) { - proc = NSAddressOfSymbol(nsSymbol); + if (nsSymbol) { + proc = NSAddressOfSymbol(nsSymbol); + if (proc) { + TclLoadDbgMsg("NSAddressOfSymbol() successful"); + } else { + TclLoadDbgMsg("NSAddressOfSymbol() failed"); + } + } + Tcl_DStringFree(&newName); +#endif /* TCL_DYLD_USE_NSMODULE */ } - Tcl_DStringFree(&newName); Tcl_DStringFree(&ds); - + if (errMsg) { + Tcl_AppendResult(interp, errMsg, NULL); + } return proc; } @@ -321,16 +468,39 @@ TclpUnloadFile( * that represents the loaded file. */ { Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *) loadHandle; - Tcl_DyldModuleHandle *modulePtr = dyldLoadHandle->modulePtr; - while (modulePtr != NULL) { - void *ptr; +#if TCL_DYLD_USE_DLFCN + if (dyldLoadHandle->dlHandle) { + int result; - NSUnLinkModule(modulePtr->module, - NSUNLINKMODULE_OPTION_RESET_LAZY_REFERENCES); - ptr = modulePtr; - modulePtr = modulePtr->nextPtr; - ckfree(ptr); + result = dlclose(dyldLoadHandle->dlHandle); + if (!result) { + TclLoadDbgMsg("dlclose() successful"); + } else { + TclLoadDbgMsg("dlclose() failed: %s", dlerror()); + } + } else +#endif /* TCL_DYLD_USE_DLFCN */ + { +#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY) + Tcl_DyldModuleHandle *modulePtr = dyldLoadHandle->modulePtr; + + while (modulePtr != NULL) { + void *ptr; + bool result; + + result = NSUnLinkModule(modulePtr->module, + NSUNLINKMODULE_OPTION_RESET_LAZY_REFERENCES); + if (result) { + TclLoadDbgMsg("NSUnLinkModule() successful"); + } else { + TclLoadDbgMsg("NSUnLinkModule() failed"); + } + ptr = modulePtr; + modulePtr = modulePtr->nextPtr; + ckfree(ptr); + } +#endif /* TCL_DYLD_USE_NSMODULE */ } ckfree((char*) dyldLoadHandle); } @@ -434,7 +604,7 @@ TclpLoadMemory( int codeSize, /* Size of code data read into buffer or -1 if * an error occurred and the buffer should * just be freed. */ - Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded + Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr) @@ -446,7 +616,7 @@ TclpLoadMemory( NSObjectFileImage dyldObjFileImage = NULL; Tcl_DyldModuleHandle *modulePtr; NSModule module; - CONST char *objFileImageErrMsg = NULL; + const char *objFileImageErrMsg = NULL; /* * Try to create an object file image that we can load from. @@ -454,64 +624,88 @@ TclpLoadMemory( if (codeSize >= 0) { NSObjectFileImageReturnCode err = NSObjectFileImageSuccess; - CONST struct fat_header *fh = buffer; + const struct fat_header *fh = buffer; uint32_t ms = 0; #ifndef __LP64__ - CONST struct mach_header *mh = NULL; - #define mh_magic OSSwapHostToBigInt32(MH_MAGIC) + const struct mach_header *mh = NULL; #define mh_size sizeof(struct mach_header) + #define mh_magic MH_MAGIC + #define arch_abi 0 #else - CONST struct mach_header_64 *mh = NULL; - #define mh_magic OSSwapHostToBigInt32(MH_MAGIC_64) + const struct mach_header_64 *mh = NULL; #define mh_size sizeof(struct mach_header_64) + #define mh_magic MH_MAGIC_64 + #define arch_abi CPU_ARCH_ABI64 #endif - + if ((size_t) codeSize >= sizeof(struct fat_header) && fh->magic == OSSwapHostToBigInt32(FAT_MAGIC)) { + uint32_t fh_nfat_arch = OSSwapBigToHostInt32(fh->nfat_arch); + /* * Fat binary, try to find mach_header for our architecture */ - uint32_t fh_nfat_arch = OSSwapBigToHostInt32(fh->nfat_arch); - - if ((size_t) codeSize >= sizeof(struct fat_header) + + + TclLoadDbgMsg("Fat binary, %d archs", fh_nfat_arch); + if ((size_t) codeSize >= sizeof(struct fat_header) + fh_nfat_arch * sizeof(struct fat_arch)) { void *fatarchs = (char*)buffer + sizeof(struct fat_header); - CONST NXArchInfo *arch = NXGetLocalArchInfo(); + const NXArchInfo *arch = NXGetLocalArchInfo(); struct fat_arch *fa; - + if (fh->magic != FAT_MAGIC) { swap_fat_arch(fatarchs, fh_nfat_arch, arch->byteorder); } - fa = NXFindBestFatArch(arch->cputype, arch->cpusubtype, - fatarchs, fh_nfat_arch); + fa = NXFindBestFatArch(arch->cputype | arch_abi, + arch->cpusubtype, fatarchs, fh_nfat_arch); if (fa) { + TclLoadDbgMsg("NXFindBestFatArch() successful: " + "local cputype %d subtype %d, " + "fat cputype %d subtype %d", + arch->cputype | arch_abi, arch->cpusubtype, + fa->cputype, fa->cpusubtype); mh = (void*)((char*)buffer + fa->offset); ms = fa->size; } else { + TclLoadDbgMsg("NXFindBestFatArch() failed"); err = NSObjectFileImageInappropriateFile; } if (fh->magic != FAT_MAGIC) { swap_fat_arch(fatarchs, fh_nfat_arch, arch->byteorder); } } else { + TclLoadDbgMsg("Fat binary header failure"); err = NSObjectFileImageInappropriateFile; } } else { /* * Thin binary */ + + TclLoadDbgMsg("Thin binary"); mh = buffer; ms = codeSize; } if (ms && !(ms >= mh_size && mh->magic == mh_magic && - mh->filetype == OSSwapHostToBigInt32(MH_BUNDLE))) { + mh->filetype == MH_BUNDLE)) { + TclLoadDbgMsg("Inappropriate file: magic %x filetype %d", + mh->magic, mh->filetype); err = NSObjectFileImageInappropriateFile; } if (err == NSObjectFileImageSuccess) { err = NSCreateObjectFileImageFromMemory(buffer, codeSize, &dyldObjFileImage); + if (err == NSObjectFileImageSuccess) { + TclLoadDbgMsg("NSCreateObjectFileImageFromMemory() " + "successful"); + } else { + objFileImageErrMsg = DyldOFIErrorMsg(err); + TclLoadDbgMsg("NSCreateObjectFileImageFromMemory() failed: %s", + objFileImageErrMsg); + } + } else { + objFileImageErrMsg = DyldOFIErrorMsg(err); } - objFileImageErrMsg = DyldOFIErrorMsg(err); } /* @@ -522,9 +716,8 @@ TclpLoadMemory( if (dyldObjFileImage == NULL) { vm_deallocate(mach_task_self(), (vm_address_t) buffer, size); if (objFileImageErrMsg != NULL) { - Tcl_AppendResult(interp, - "NSCreateObjectFileImageFromMemory() error: ", - objFileImageErrMsg, NULL); + Tcl_AppendResult(interp, "NSCreateObjectFileImageFromMemory() " + "error: ", objFileImageErrMsg, NULL); } return TCL_ERROR; } @@ -536,14 +729,16 @@ TclpLoadMemory( module = NSLinkModule(dyldObjFileImage, "[Memory Based Bundle]", NSLINKMODULE_OPTION_BINDNOW | NSLINKMODULE_OPTION_RETURN_ON_ERROR); NSDestroyObjectFileImage(dyldObjFileImage); - - if (!module) { + if (module) { + TclLoadDbgMsg("NSLinkModule() successful"); + } else { NSLinkEditErrors editError; int errorNumber; - CONST char *name, *msg; + const char *errorName, *errMsg; - NSLinkEditError(&editError, &errorNumber, &name, &msg); - Tcl_AppendResult(interp, msg, NULL); + NSLinkEditError(&editError, &errorNumber, &errorName, &errMsg); + TclLoadDbgMsg("NSLinkModule() failed: %s", errMsg); + Tcl_AppendResult(interp, errMsg, NULL); return TCL_ERROR; } @@ -554,21 +749,23 @@ TclpLoadMemory( modulePtr = (Tcl_DyldModuleHandle *) ckalloc(sizeof(Tcl_DyldModuleHandle)); modulePtr->module = module; modulePtr->nextPtr = NULL; - dyldLoadHandle = (Tcl_DyldLoadHandle *) ckalloc(sizeof(Tcl_DyldLoadHandle)); +#if TCL_DYLD_USE_DLFCN + dyldLoadHandle->dlHandle = NULL; +#endif dyldLoadHandle->dyldLibHeader = NULL; dyldLoadHandle->modulePtr = modulePtr; *loadHandle = (Tcl_LoadHandle) dyldLoadHandle; *unloadProcPtr = &TclpUnloadFile; return TCL_OK; } -#endif +#endif /* TCL_LOAD_FROM_MEMORY */ /* * Local Variables: * mode: c * c-basic-offset: 4 - * fill-column: 78 + * fill-column: 79 * End: */ diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index 4d341d4..afa66ab 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.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: tclUnixChan.c,v 1.77.2.1 2007/07/03 02:28:37 dgp Exp $ + * RCS: @(#) $Id: tclUnixChan.c,v 1.77.2.2 2007/09/04 17:44:21 dgp Exp $ */ #include "tclInt.h" /* Internal definitions for Tcl. */ @@ -128,6 +128,15 @@ #endif /* !USE_TERMIOS */ /* + * Helper macros to make parts of this file clearer. The macros do exactly + * what they say on the tin. :-) They also only ever refer to their arguments + * once, and so can be used without regard to side effects. + */ + +#define SET_BITS(var, bits) ((var) |= (bits)) +#define CLEAR_BITS(var, bits) ((var) &= ~(bits)) + +/* * This structure describes per-instance state of a file based channel. */ @@ -224,9 +233,9 @@ typedef struct TcpState { * Static routines for this file: */ -static TcpState * CreateSocket(Tcl_Interp *interp, - int port, const char *host, int server, - const char *myaddr, int myport, int async); +static TcpState * CreateSocket(Tcl_Interp *interp, int port, + const char *host, int server, const char *myaddr, + int myport, int async); static int CreateSocketAddress(struct sockaddr_in *sockaddrPtr, const char *host, int port); static int FileBlockModeProc(ClientData instanceData, int mode); @@ -234,12 +243,12 @@ static int FileCloseProc(ClientData instanceData, Tcl_Interp *interp); static int FileGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr); -static int FileInputProc(ClientData instanceData, - char *buf, int toRead, int *errorCode); +static int FileInputProc(ClientData instanceData, char *buf, + int toRead, int *errorCode); static int FileOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCode); -static int FileSeekProc(ClientData instanceData, - long offset, int mode, int *errorCode); +static int FileSeekProc(ClientData instanceData, long offset, + int mode, int *errorCode); static int FileTruncateProc(ClientData instanceData, Tcl_WideInt length); static Tcl_WideInt FileWideSeekProc(ClientData instanceData, @@ -254,8 +263,8 @@ static int TcpGetHandleProc(ClientData instanceData, static int TcpGetOptionProc(ClientData instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); -static int TcpInputProc(ClientData instanceData, - char *buf, int toRead, int *errorCode); +static int TcpInputProc(ClientData instanceData, char *buf, + int toRead, int *errorCode); static int TcpOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCode); static void TcpWatchProc(ClientData instanceData, int mask); @@ -277,8 +286,8 @@ static int TtyOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCode); #endif /* BAD_TIP35_FLUSH */ static int TtyParseMode(Tcl_Interp *interp, const char *mode, - int *speedPtr, int *parityPtr, - int *dataPtr, int *stopPtr); + int *speedPtr, int *parityPtr, int *dataPtr, + int *stopPtr); static void TtySetAttributes(int fd, TtyAttrs *ttyPtr); static int TtySetOptionProc(ClientData instanceData, Tcl_Interp *interp, const char *optionName, @@ -399,9 +408,9 @@ FileBlockModeProc( #ifndef USE_FIONBIO curStatus = fcntl(fsPtr->fd, F_GETFL); if (mode == TCL_MODE_BLOCKING) { - curStatus &= (~(O_NONBLOCK)); + CLEAR_BITS(curStatus, O_NONBLOCK); } else { - curStatus |= O_NONBLOCK; + SET_BITS(curStatus, O_NONBLOCK); } if (fcntl(fsPtr->fd, F_SETFL, curStatus) < 0) { return errno; @@ -592,7 +601,7 @@ FileSeekProc( oldLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) 0, SEEK_CUR); if (oldLoc == Tcl_LongAsWide(-1)) { /* - * Bad things are happening. Error out... + * Bad things are happening. Error out... */ *errorCodePtr = errno; @@ -679,9 +688,9 @@ FileWatchProc( FileState *fsPtr = (FileState *) instanceData; /* - * Make sure we only register for events that are valid on this file. - * Note that we are passing Tcl_NotifyChannel directly to - * Tcl_CreateFileHandler with the channel pointer as the client data. + * Make sure we only register for events that are valid on this file. Note + * that we are passing Tcl_NotifyChannel directly to Tcl_CreateFileHandler + * with the channel pointer as the client data. */ mask &= fsPtr->validMask; @@ -716,16 +725,15 @@ static int FileGetHandleProc( ClientData instanceData, /* The file state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - ClientData *handlePtr) /* Where to store the handle. */ + ClientData *handlePtr) /* Where to store the handle. */ { FileState *fsPtr = (FileState *) instanceData; if (direction & fsPtr->validMask) { *handlePtr = (ClientData) INT2PTR(fsPtr->fd); return TCL_OK; - } else { - return TCL_ERROR; } + return TCL_ERROR; } #ifdef SUPPORTS_TTY @@ -806,14 +814,14 @@ TtyOutputProc( { if (TclInExit()) { /* - * Do not write data during Tcl exit. Serial port may block - * preventing Tcl from exit. + * Do not write data during Tcl exit. Serial port may block preventing + * Tcl from exit. */ return toWrite; - } else { - return FileOutputProc(instanceData, buf, toWrite, errorCodePtr); } + + return FileOutputProc(instanceData, buf, toWrite, errorCodePtr); } #endif /* BAD_TIP35_FLUSH */ @@ -830,8 +838,8 @@ TtyOutputProc( static void TtyModemStatusStr( - int status, /* RS232 modem status */ - Tcl_DString *dsPtr) /* Where to store string */ + int status, /* RS232 modem status */ + Tcl_DString *dsPtr) /* Where to store string */ { #ifdef TIOCM_CTS Tcl_DStringAppendElement(dsPtr, "CTS"); @@ -919,17 +927,17 @@ TtySetOptionProc( */ GETIOSTATE(fsPtr->fd, &iostate); - iostate.c_iflag &= ~(IXON | IXOFF | IXANY); + CLEAR_BITS(iostate.c_iflag, IXON | IXOFF | IXANY); #ifdef CRTSCTS - iostate.c_cflag &= ~CRTSCTS; + CLEAR_BITS(iostate.c_cflag, CRTSCTS); #endif /* CRTSCTS */ if (strncasecmp(value, "NONE", vlen) == 0) { /* leave all handshake options disabled */ } else if (strncasecmp(value, "XONXOFF", vlen) == 0) { - iostate.c_iflag |= (IXON | IXOFF | IXANY); + SET_BITS(iostate.c_iflag, IXON | IXOFF | IXANY); } else if (strncasecmp(value, "RTSCTS", vlen) == 0) { #ifdef CRTSCTS - iostate.c_cflag |= CRTSCTS; + SET_BITS(iostate.c_cflag, CRTSCTS); #else /* !CRTSTS */ UNSUPPORTED_OPTION("-handshake RTSCTS"); return TCL_ERROR; @@ -963,9 +971,8 @@ TtySetOptionProc( iostate.c_cc[VSTOP] = argv[1][0]; } else { if (interp) { - Tcl_AppendResult(interp, - "bad value for -xchar: should be a list of two elements", - NULL); + Tcl_AppendResult(interp, "bad value for -xchar: " + "should be a list of two elements", NULL); } ckfree((char *) argv); return TCL_ERROR; @@ -986,8 +993,8 @@ TtySetOptionProc( if (Tcl_GetInt(interp, value, &msec) != TCL_OK) { return TCL_ERROR; } - iostate.c_cc[VMIN] = 0; - iostate.c_cc[VTIME] = (msec == 0) ? 0 : (msec < 100) ? 1 : (msec+50)/100; + iostate.c_cc[VMIN] = 0; + iostate.c_cc[VTIME] = (msec==0) ? 0 : (msec<100) ? 1 : (msec+50)/100; SETIOSTATE(fsPtr->fd, &iostate); return TCL_OK; } @@ -998,14 +1005,14 @@ TtySetOptionProc( if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) { int i; + if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; } if ((argc % 2) == 1) { if (interp) { - Tcl_AppendResult(interp, - "bad value for -ttycontrol: should be a list of" - "signal,value pairs", NULL); + Tcl_AppendResult(interp, "bad value for -ttycontrol: " + "should be a list of signal,value pairs", NULL); } ckfree((char *) argv); return TCL_ERROR; @@ -1020,9 +1027,9 @@ TtySetOptionProc( if (strncasecmp(argv[i], "DTR", strlen(argv[i])) == 0) { #ifdef TIOCM_DTR if (flag) { - control |= TIOCM_DTR; + SET_BITS(control, TIOCM_DTR); } else { - control &= ~TIOCM_DTR; + CLEAR_BITS(control, TIOCM_DTR); } #else /* !TIOCM_DTR */ UNSUPPORTED_OPTION("-ttycontrol DTR"); @@ -1032,9 +1039,9 @@ TtySetOptionProc( } else if (strncasecmp(argv[i], "RTS", strlen(argv[i])) == 0) { #ifdef TIOCM_RTS if (flag) { - control |= TIOCM_RTS; + SET_BITS(control, TIOCM_RTS); } else { - control &= ~TIOCM_RTS; + CLEAR_BITS(control, TIOCM_RTS); } #else /* !TIOCM_RTS*/ UNSUPPORTED_OPTION("-ttycontrol RTS"); @@ -1066,7 +1073,7 @@ TtySetOptionProc( } return Tcl_BadChannelOption(interp, optionName, - "mode handshake timeout ttycontrol xchar "); + "mode handshake timeout ttycontrol xchar"); #else /* !USE_TERMIOS */ return Tcl_BadChannelOption(interp, optionName, "mode"); @@ -1079,7 +1086,7 @@ TtySetOptionProc( * TtyGetOptionProc -- * * Gets a mode associated with an IO channel. If the optionName arg is - * non NULL, retrieves the value of that option. If the optionName arg is + * non-NULL, retrieves the value of that option. If the optionName arg is * NULL, retrieves a list of alternating option names and values for the * given channel. * @@ -1089,7 +1096,7 @@ TtySetOptionProc( * * Side effects: * The string returned by this function is in static storage and may be - * reused at any time subsequent to the call. Sets Error message if + * reused at any time subsequent to the call. Sets error message if * needed (by calling Tcl_BadChannelOption). * *---------------------------------------------------------------------- @@ -1104,9 +1111,8 @@ TtyGetOptionProc( { FileState *fsPtr = (FileState *) instanceData; unsigned int len; - char buf[3 * TCL_INTEGER_SPACE + 16]; - TtyAttrs tty; - int valid = 0; /* flag if valid option parsed */ + char buf[3*TCL_INTEGER_SPACE + 16]; + int valid = 0; /* Flag if valid option parsed. */ if (optionName == NULL) { len = 0; @@ -1117,6 +1123,8 @@ TtyGetOptionProc( Tcl_DStringAppendElement(dsPtr, "-mode"); } if (len==0 || (len>2 && strncmp(optionName, "-mode", len)==0)) { + TtyAttrs tty; + valid = 1; TtyGetAttributes(fsPtr->fd, &tty); sprintf(buf, "%d,%c,%d,%d", tty.baud, tty.parity, tty.data, tty.stop); @@ -1125,7 +1133,7 @@ TtyGetOptionProc( #ifdef USE_TERMIOS /* - * get option -xchar + * Get option -xchar */ if (len == 0) { @@ -1134,8 +1142,8 @@ TtyGetOptionProc( } if (len==0 || (len>1 && strncmp(optionName, "-xchar", len)==0)) { IOSTATE iostate; - valid = 1; + valid = 1; GETIOSTATE(fsPtr->fd, &iostate); sprintf(buf, "%c", iostate.c_cc[VSTART]); Tcl_DStringAppendElement(dsPtr, buf); @@ -1147,14 +1155,14 @@ TtyGetOptionProc( } /* - * get option -queue - * option is readonly and returned by [fconfigure chan -queue] but not - * returned by unnamed [fconfigure chan] + * Get option -queue + * Option is readonly and returned by [fconfigure chan -queue] but not + * returned by unnamed [fconfigure chan]. */ if ((len > 1) && (strncmp(optionName, "-queue", len) == 0)) { - int inQueue=0, outQueue=0; - int inBuffered, outBuffered; + int inQueue=0, outQueue=0, inBuffered, outBuffered; + valid = 1; #ifdef GETREADQUEUE GETREADQUEUE(fsPtr->fd, inQueue); @@ -1162,7 +1170,7 @@ TtyGetOptionProc( #ifdef GETWRITEQUEUE GETWRITEQUEUE(fsPtr->fd, outQueue); #endif /* GETWRITEQUEUE */ - inBuffered = Tcl_InputBuffered(fsPtr->channel); + inBuffered = Tcl_InputBuffered(fsPtr->channel); outBuffered = Tcl_OutputBuffered(fsPtr->channel); sprintf(buf, "%d", inBuffered+inQueue); @@ -1172,12 +1180,13 @@ TtyGetOptionProc( } /* - * get option -ttystatus - * option is readonly and returned by [fconfigure chan -ttystatus] but not - * returned by unnamed [fconfigure chan] + * Get option -ttystatus + * Option is readonly and returned by [fconfigure chan -ttystatus] but not + * returned by unnamed [fconfigure chan]. */ if ((len > 4) && (strncmp(optionName, "-ttystatus", len) == 0)) { int status; + valid = 1; GETCONTROL(fsPtr->fd, &status); TtyModemStatusStr(status, dsPtr); @@ -1186,20 +1195,17 @@ TtyGetOptionProc( if (valid) { return TCL_OK; - } else { - return Tcl_BadChannelOption(interp, optionName, + } + return Tcl_BadChannelOption(interp, optionName, "mode" #ifdef USE_TERMIOS - "mode queue ttystatus xchar" -#else /* !USE_TERMIOS */ - "mode" + " queue ttystatus xchar" #endif /* USE_TERMIOS */ ); - } } #ifdef DIRECT_BAUD -# define TtyGetSpeed(baud) ((unsigned) (baud)) -# define TtyGetBaud(speed) ((int) (speed)) +# define TtyGetSpeed(baud) ((unsigned) (baud)) +# define TtyGetBaud(speed) ((int) (speed)) #else /* !DIRECT_BAUD */ static struct {int baud; unsigned long speed;} speeds[] = { @@ -1348,7 +1354,7 @@ TtyGetSpeed( * get the baus rate that corresponds to that mask value. * * Results: - * As above. If the mask value was not recognized, 0 is returned. + * As above. If the mask value was not recognized, 0 is returned. * * Side effects: * None. @@ -1496,25 +1502,28 @@ TtySetAttributes( flag = 0; parity = ttyPtr->parity; if (parity != 'n') { - flag |= PARENB; + SET_BITS(flag, PARENB); #ifdef PAREXT - iostate.c_cflag &= ~PAREXT; + CLEAR_BITS(iostate.c_cflag, PAREXT); if ((parity == 'm') || (parity == 's')) { - flag |= PAREXT; + SET_BITS(flag, PAREXT); } #endif /* PAREXT */ if ((parity == 'm') || (parity == 'o')) { - flag |= PARODD; + SET_BITS(flag, PARODD); } } data = ttyPtr->data; - flag |= (data == 5) ? CS5 : (data == 6) ? CS6 : (data == 7) ? CS7 : CS8; + SET_BITS(flag, + (data == 5) ? CS5 : + (data == 6) ? CS6 : + (data == 7) ? CS7 : CS8); if (ttyPtr->stop == 2) { - flag |= CSTOPB; + SET_BITS(flag, CSTOPB); } - iostate.c_cflag &= ~(PARENB | PARODD | CSIZE | CSTOPB); - iostate.c_cflag |= flag; + CLEAR_BITS(iostate.c_cflag, PARENB | PARODD | CSIZE | CSTOPB); + SET_BITS(iostate.c_cflag, flag); #endif /* USE_TERMIOS */ @@ -1522,28 +1531,31 @@ TtySetAttributes( int parity, data, flag; GETIOSTATE(fd, &iostate); - iostate.c_cflag &= ~CBAUD; - iostate.c_cflag |= TtyGetSpeed(ttyPtr->baud); + CLEAR_BITS(iostate.c_cflag, CBAUD); + SET_BITS(iostate.c_cflag, TtyGetSpeed(ttyPtr->baud)); flag = 0; parity = ttyPtr->parity; if (parity != 'n') { - flag |= PARENB; + SET_BITS(flag, PARENB); if ((parity == 'm') || (parity == 's')) { - flag |= PAREXT; + SET_BITS(flag, PAREXT); } if ((parity == 'm') || (parity == 'o')) { - flag |= PARODD; + SET_BITS(flag, PARODD); } } data = ttyPtr->data; - flag |= (data == 5) ? CS5 : (data == 6) ? CS6 : (data == 7) ? CS7 : CS8; + SET_BITS(flag, + (data == 5) ? CS5 : + (data == 6) ? CS6 : + (data == 7) ? CS7 : CS8); if (ttyPtr->stop == 2) { - flag |= CSTOPB; + SET_BITS(flag, CSTOPB); } - iostate.c_cflag &= ~(PARENB | PARODD | PAREXT | CSIZE | CSTOPB); - iostate.c_cflag |= flag; + CLEAR_BITS(iostate.c_cflag, PARENB | PARODD | PAREXT | CSIZE | CSTOPB); + SET_BITS(iostate.c_cflag, flag); #endif /* USE_TERMIO */ @@ -1556,11 +1568,11 @@ TtySetAttributes( parity = ttyPtr->parity; if (parity == 'e') { - iostate.sg_flags &= ~ODDP; - iostate.sg_flags |= EVENP; + CLEAR_BITS(iostate.sg_flags, ODDP); + SET_BITS(iostate.sg_flags, EVENP); } else if (parity == 'o') { - iostate.sg_flags &= ~EVENP; - iostate.sg_flags |= ODDP; + CLEAR_BITS(iostate.sg_flags, EVENP); + SET_BITS(iostate.sg_flags, ODDP); } #endif /* USE_SGTTY */ @@ -1597,7 +1609,7 @@ TtyParseMode( { int i, end; char parity; - static char *bad = "bad value for -mode"; + static const char *bad = "bad value for -mode"; i = sscanf(mode, "%d,%c,%d,%d%n", speedPtr, &parity, dataPtr, stopPtr, &end); @@ -1611,7 +1623,7 @@ TtyParseMode( /* * Only allow setting mark/space parity on platforms that support it Make - * sure to allow for the case where strchr is a macro. [Bug: 5089] + * sure to allow for the case where strchr is a macro. [Bug: 5089] */ #if defined(PAREXT) || defined(USE_TERMIO) @@ -1654,9 +1666,9 @@ TtyParseMode( * * Given file descriptor that refers to a serial port, initialize the * serial port to a set of sane values so that Tcl can talk to a device - * located on the serial port. Note that no initialization happens if - * the initialize flag is not set; this is necessary for the correct - * handling of UNIX console TTYs at startup. + * located on the serial port. Note that no initialization happens if the + * initialize flag is not set; this is necessary for the correct handling + * of UNIX console TTYs at startup. * * Results: * A pointer to a FileState suitable for use with Tcl_CreateChannel and @@ -1664,7 +1676,7 @@ TtyParseMode( * * Side effects: * Serial device initialized to non-blocking raw mode, similar to sockets - * (if initialize flag is non-zero.) All other modes can be simulated on + * (if initialize flag is non-zero.) All other modes can be simulated on * top of this in Tcl. * *--------------------------------------------------------------------------- @@ -1696,7 +1708,7 @@ TtyInit( iostate.c_iflag = IGNBRK; iostate.c_oflag = 0; iostate.c_lflag = 0; - iostate.c_cflag |= CREAD; + SET_BITS(iostate.c_cflag, CREAD); iostate.c_cc[VMIN] = 1; iostate.c_cc[VTIME] = 0; #endif /* USE_TERMIOS|USE_TERMIO */ @@ -1706,8 +1718,8 @@ TtyInit( !(iostate.sg_flags & RAW)) { ttyPtr->stateUpdated = 1; } - iostate.sg_flags &= (EVENP | ODDP); - iostate.sg_flags |= RAW; + iostate.sg_flags &= EVENP | ODDP; + SET_BITS(iostate.sg_flags, RAW); #endif /* USE_SGTTY */ /* @@ -1782,7 +1794,7 @@ TclpOpenFileChannel( } #ifdef DJGPP - mode |= O_BINARY; + SET_BITS(mode, O_BINARY); #endif fd = TclOSopen(native, mode, permissions); @@ -1947,24 +1959,24 @@ TcpBlockModeProc( #ifndef USE_FIONBIO setting = fcntl(statePtr->fd, F_GETFL); if (mode == TCL_MODE_BLOCKING) { - statePtr->flags &= (~(TCP_ASYNC_SOCKET)); - setting &= (~(O_NONBLOCK)); + CLEAR_BITS(statePtr->flags, TCP_ASYNC_SOCKET); + CLEAR_BITS(setting, O_NONBLOCK); } else { - statePtr->flags |= TCP_ASYNC_SOCKET; - setting |= O_NONBLOCK; + SET_BITS(statePtr->flags, TCP_ASYNC_SOCKET); + SET_BITS(setting, O_NONBLOCK); } if (fcntl(statePtr->fd, F_SETFL, setting) < 0) { return errno; } #else /* USE_FIONBIO */ if (mode == TCL_MODE_BLOCKING) { - statePtr->flags &= (~(TCP_ASYNC_SOCKET)); + CLEAR_BITS(statePtr->flags, TCP_ASYNC_SOCKET); setting = 0; if (ioctl(statePtr->fd, (int) FIONBIO, &setting) == -1) { return errno; } } else { - statePtr->flags |= TCP_ASYNC_SOCKET; + SET_BITS(statePtr->flags, TCP_ASYNC_SOCKET); setting = 1; if (ioctl(statePtr->fd, (int) FIONBIO, &setting) == -1) { return errno; @@ -2018,7 +2030,7 @@ WaitForConnect( if (!(statePtr->flags & TCP_ASYNC_SOCKET)) { #ifndef USE_FIONBIO flags = fcntl(statePtr->fd, F_GETFL); - flags &= (~(O_NONBLOCK)); + CLEAR_BITS(flags, O_NONBLOCK); (void) fcntl(statePtr->fd, F_SETFL, flags); #else /* USE_FIONBIO */ flags = 0; @@ -2029,7 +2041,7 @@ WaitForConnect( return -1; } if (state & TCL_WRITABLE) { - statePtr->flags &= (~(TCP_ASYNC_CONNECT)); + CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT); } else if (timeOut == 0) { *errorCodePtr = errno = EWOULDBLOCK; return -1; @@ -2205,13 +2217,13 @@ TcpCloseProc( static int TcpGetOptionProc( - ClientData instanceData, /* Socket state. */ - Tcl_Interp *interp, /* For error reporting - can be NULL. */ - const char *optionName, /* Name of the option to retrieve the value - * for, or NULL to get all options and their - * values. */ - Tcl_DString *dsPtr) /* Where to store the computed value; - * initialized by caller. */ + ClientData instanceData, /* Socket state. */ + Tcl_Interp *interp, /* For error reporting - can be NULL. */ + const char *optionName, /* Name of the option to retrieve the value + * for, or NULL to get all options and their + * values. */ + Tcl_DString *dsPtr) /* Where to store the computed value; + * initialized by caller. */ { TcpState *statePtr = (TcpState *) instanceData; struct sockaddr_in sockname; @@ -2360,9 +2372,9 @@ TcpWatchProc( TcpState *statePtr = (TcpState *) instanceData; /* - * Make sure we don't mess with server sockets since they will never - * be readable or writable at the Tcl level. This keeps Tcl scripts - * from interfering with the -accept behavior. + * Make sure we don't mess with server sockets since they will never be + * readable or writable at the Tcl level. This keeps Tcl scripts from + * interfering with the -accept behavior. */ if (!statePtr->acceptProc) { @@ -2399,7 +2411,7 @@ static int TcpGetHandleProc( ClientData instanceData, /* The socket state. */ int direction, /* Not used. */ - ClientData *handlePtr) /* Where to store the handle. */ + ClientData *handlePtr) /* Where to store the handle. */ { TcpState *statePtr = (TcpState *) instanceData; @@ -2446,11 +2458,11 @@ CreateSocket( sock = -1; origState = 0; - if (! CreateSocketAddress(&sockaddr, host, port)) { + if (!CreateSocketAddress(&sockaddr, host, port)) { goto addressError; } if ((myaddr != NULL || myport != 0) && - ! CreateSocketAddress(&mysockaddr, myaddr, myport)) { + !CreateSocketAddress(&mysockaddr, myaddr, myport)) { goto addressError; } @@ -2509,8 +2521,8 @@ CreateSocket( if (async) { #ifndef USE_FIONBIO - origState = fcntl(sock, F_GETFL); - curState = origState | O_NONBLOCK; + curState = fcntl(sock, F_GETFL); + SET_BITS(curState, O_NONBLOCK); status = fcntl(sock, F_SETFL, curState); #else /* USE_FIONBIO */ curState = 1; @@ -2531,15 +2543,15 @@ CreateSocket( /* * Here we are if the connect succeeds. In case of an * asynchronous connect we have to reset the channel to - * blocking mode. This appears to happen not very often, but + * blocking mode. This appears to happen not very often, but * e.g. on a HP 9000/800 under HP-UX B.11.00 we enter this * stage. [Bug: 4388] */ if (async) { #ifndef USE_FIONBIO - origState = fcntl(sock, F_GETFL); - curState = origState & ~(O_NONBLOCK); + curState = fcntl(sock, F_GETFL); + CLEAR_BITS(curState, O_NONBLOCK); status = fcntl(sock, F_SETFL, curState); #else /* USE_FIONBIO */ curState = 0; @@ -2612,7 +2624,7 @@ CreateSocketAddress( struct hostent *hostent; /* Host database entry */ struct in_addr addr; /* For 64/32 bit madness */ - (void) memset((void *) sockaddrPtr, '\0', sizeof(struct sockaddr_in)); + (void) memset(sockaddrPtr, '\0', sizeof(struct sockaddr_in)); sockaddrPtr->sin_family = AF_INET; sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF)); if (host == NULL) { @@ -2627,17 +2639,15 @@ CreateSocketAddress( native = Tcl_UtfToExternalDString(NULL, host, -1, &ds); } addr.s_addr = inet_addr(native); /* INTL: Native. */ + /* - * This is 0xFFFFFFFF to ensure that it compares as a 32bit -1 - * on either 32 or 64 bits systems. + * This is 0xFFFFFFFF to ensure that it compares as a 32bit -1 on + * either 32 or 64 bits systems. */ + if (addr.s_addr == 0xFFFFFFFF) { hostent = gethostbyname(native); /* INTL: Native. */ - if (hostent != NULL) { - memcpy((void *) &addr, - (void *) hostent->h_addr_list[0], - (size_t) hostent->h_length); - } else { + if (hostent == NULL) { #ifdef EHOSTUNREACH errno = EHOSTUNREACH; #else /* !EHOSTUNREACH */ @@ -2648,8 +2658,11 @@ CreateSocketAddress( if (native != NULL) { Tcl_DStringFree(&ds); } - return 0; /* error */ + return 0; /* Error. */ } + + memcpy(&addr, (void *) hostent->h_addr_list[0], + (size_t) hostent->h_length); } if (native != NULL) { Tcl_DStringFree(&ds); @@ -2659,12 +2672,12 @@ CreateSocketAddress( /* * NOTE: On 64 bit machines the assignment below is rumored to not do the * right thing. Please report errors related to this if you observe - * incorrect behavior on 64 bit machines such as DEC Alphas. Should we + * incorrect behavior on 64 bit machines such as DEC Alphas. Should we * modify this code to do an explicit memcpy? */ sockaddrPtr->sin_addr.s_addr = addr.s_addr; - return 1; /* Success. */ + return 1; /* Success. */ } /* @@ -3032,10 +3045,9 @@ Tcl_GetOpenFile( ClientData *filePtr) /* Store pointer to FILE structure here. */ { Tcl_Channel chan; - int chanMode; + int chanMode, fd; const Tcl_ChannelType *chanTypePtr; ClientData data; - int fd; FILE *f; chan = Tcl_GetChannel(interp, chanID, &chanMode); @@ -3106,7 +3118,7 @@ Tcl_GetOpenFile( * present on file at the time of the return. This function will not * return until either "timeout" milliseconds have elapsed or at least * one of the conditions given by mask has occurred for file (a return - * value of 0 means that a timeout occurred). No normal events will be + * value of 0 means that a timeout occurred). No normal events will be * serviced during the execution of this function. * * Side effects: @@ -3166,9 +3178,9 @@ TclUnixWaitForFile( Tcl_Panic("TclWaitForFile can't handle file id %d", fd); /* must never get here, or readyMasks overrun will occur below */ } - memset((void *) readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask)); - index = fd/(NBBY*sizeof(fd_mask)); - bit = ((fd_mask)1) << (fd%(NBBY*sizeof(fd_mask))); + memset(readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask)); + index = fd / (NBBY*sizeof(fd_mask)); + bit = ((fd_mask)1) << (fd % (NBBY*sizeof(fd_mask))); /* * Loop in a mini-event loop of our own, waiting for either the file to @@ -3219,13 +3231,13 @@ TclUnixWaitForFile( (SELECT_MASK *) maskp[2], timeoutPtr); if (numFound == 1) { if (readyMasks[index] & bit) { - result |= TCL_READABLE; + SET_BITS(result, TCL_READABLE); } if ((readyMasks+MASK_SIZE)[index] & bit) { - result |= TCL_WRITABLE; + SET_BITS(result, TCL_WRITABLE); } if ((readyMasks+2*(MASK_SIZE))[index] & bit) { - result |= TCL_EXCEPTION; + SET_BITS(result, TCL_EXCEPTION); } result &= mask; if (result) { @@ -3245,8 +3257,7 @@ TclUnixWaitForFile( Tcl_GetTime(&now); if ((abortTime.sec < now.sec) - || ((abortTime.sec == now.sec) - && (abortTime.usec <= now.usec))) { + || (abortTime.sec==now.sec && abortTime.usec<=now.usec)) { break; } } diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c index 23905a4..f7e0857 100644 --- a/unix/tclUnixCompat.c +++ b/unix/tclUnixCompat.c @@ -3,10 +3,10 @@ * * Written by: Zoran Vasiljevic (vasiljevic@users.sourceforge.net). * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixCompat.c,v 1.9 2007/04/16 13:36:36 dkf Exp $ + * RCS: @(#) $Id: tclUnixCompat.c,v 1.9.2.1 2007/09/04 17:44:21 dgp Exp $ * */ @@ -20,11 +20,11 @@ /* * Used to pad structures at size'd boundaries * - * This macro assumes that the pointer 'buffer' was created from an - * aligned pointer by adding the 'length'. If this 'length' was not a - * multiple of the 'size' the result is unaligned and PadBuffer - * corrects both the pointer, _and_ the 'length'. The latter means - * that future increments of 'buffer' by 'length' stay aligned. + * This macro assumes that the pointer 'buffer' was created from an aligned + * pointer by adding the 'length'. If this 'length' was not a multiple of the + * 'size' the result is unaligned and PadBuffer corrects both the pointer, + * _and_ the 'length'. The latter means that future increments of 'buffer' by + * 'length' stay aligned. */ #define PadBuffer(buffer, length, size) \ @@ -34,14 +34,13 @@ } /* - * Per-thread private storage used to store values - * returned from MT-unsafe library calls. + * Per-thread private storage used to store values returned from MT-unsafe + * library calls. */ #ifdef TCL_THREADS typedef struct ThreadSpecificData { - struct passwd pwd; char pbuf[2048]; @@ -52,322 +51,51 @@ typedef struct ThreadSpecificData { struct hostent hent; char hbuf[2048]; #endif - } ThreadSpecificData; - static Tcl_ThreadDataKey dataKey; #if ((!defined(HAVE_GETHOSTBYNAME_R) || !defined(HAVE_GETHOSTBYADDR_R)) && \ - (!defined(HAVE_MTSAFE_GETHOSTBYNAME) || !defined(HAVE_MTSAFE_GETHOSTBYADDR))) || \ + (!defined(HAVE_MTSAFE_GETHOSTBYNAME) || \ + !defined(HAVE_MTSAFE_GETHOSTBYADDR))) || \ !defined(HAVE_GETPWNAM_R) || !defined(HAVE_GETPWUID_R) || \ !defined(HAVE_GETGRNAM_R) || !defined(HAVE_GETGRGID_R) - /* - * Mutex to lock access to MT-unsafe calls. This is just to protect - * our own usage. It does not protect us from others calling the - * same functions without (or using some different) lock. + * Mutex to lock access to MT-unsafe calls. This is just to protect our own + * usage. It does not protect us from others calling the same functions + * without (or using some different) lock. */ static Tcl_Mutex compatLock; - -/* - *--------------------------------------------------------------------------- - * - * CopyArray -- - * - * Copies array of NULL-terminated or fixed-length strings - * to the private buffer, honouring the size of the buffer. - * - * Results: - * Number of bytes copied on success or -1 on error (errno = ERANGE) - * - * Side effects: - * None. - * - *--------------------------------------------------------------------------- - */ - -static int -CopyArray( - char **src, - int elsize, - char *buf, - int buflen) -{ - int i, j, len = 0; - char *p, **new; - - if (src == NULL) { - return 0; - } - for (i = 0; src[i] != NULL; i++) { - /* Empty loop to count howmany */ - } - if ((sizeof(char *)*(i + 1)) > buflen) { - return -1; - } - len = (sizeof(char *)*(i + 1)); /* Leave place for the array */ - new = (char **)buf; - p = buf + (sizeof(char *)*(i + 1)); - for (j = 0; j < i; j++) { - if (elsize < 0) { - len += strlen(src[j]) + 1; - } else { - len += elsize; - } - if (len > buflen) { - return -1; - } - if (elsize < 0) { - strcpy(p, src[j]); - } else { - memcpy(p, src[j], elsize); - } - new[j] = p; - p = buf + len; - } - new[j] = NULL; - - return len; -} - - -/* - *--------------------------------------------------------------------------- - * - * CopyString -- - * - * Copies a NULL-terminated string to the private buffer, - * honouring the size of the buffer - * - * Results: - * 0 success or -1 on error (errno = ERANGE) - * - * Side effects: - * None - * - *--------------------------------------------------------------------------- - */ - - -static int -CopyString( - char *src, - char *buf, - int buflen) -{ - int len = 0; - - if (src != NULL) { - len += strlen(src) + 1; - if (len > buflen) { - return -1; - } - strcpy(buf, src); - } - - return len; -} -#endif /* ((!defined(HAVE_GETHOSTBYNAME_R) || !defined(HAVE_GETHOSTBYADDR_R)) && \ - (!defined(HAVE_MTSAFE_GETHOSTBYNAME) || !defined(HAVE_MTSAFE_GETHOSTBYADDR))) || \ - !defined(HAVE_GETPWNAM_R) || !defined(HAVE_GETPWUID_R) || \ - !defined(HAVE_GETGRNAM_R) || !defined(HAVE_GETGRGID_R) */ - -#if (!defined(HAVE_GETHOSTBYNAME_R) || !defined(HAVE_GETHOSTBYADDR_R)) && \ - (!defined(HAVE_MTSAFE_GETHOSTBYNAME) || !defined(HAVE_MTSAFE_GETHOSTBYADDR)) - -/* - *--------------------------------------------------------------------------- - * - * CopyHostnent -- - * - * Copies string fields of the hostnent structure to the - * private buffer, honouring the size of the buffer. - * - * Results: - * Number of bytes copied on success or -1 on error (errno = ERANGE) - * - * Side effects: - * None - * - *--------------------------------------------------------------------------- - */ - -static int -CopyHostent( - struct hostent *tgtPtr, - char *buf, - int buflen) -{ - char *p = buf; - int copied, len = 0; - - copied = CopyString(tgtPtr->h_name, p, buflen - len); - if (copied == -1) { - range: - errno = ERANGE; - return -1; - } - tgtPtr->h_name = (copied > 0) ? p : NULL; - len += copied; - p = buf + len; - - PadBuffer(p, len, sizeof(char *)); - copied = CopyArray(tgtPtr->h_aliases, -1, p, buflen - len); - if (copied == -1) { - goto range; - } - tgtPtr->h_aliases = (copied > 0) ? (char **)p : NULL; - len += copied; - p += len; - - PadBuffer(p, len, sizeof(char *)); - copied = CopyArray(tgtPtr->h_addr_list, tgtPtr->h_length, p, buflen - len); - if (copied == -1) { - goto range; - } - tgtPtr->h_addr_list = (copied > 0) ? (char **)p : NULL; - - return 0; -} -#endif /* (!defined(HAVE_GETHOSTBYNAME_R) || !defined(HAVE_GETHOSTBYADDR_R)) && \ - (!defined(HAVE_MTSAFE_GETHOSTBYNAME) || !defined(HAVE_MTSAFE_GETHOSTBYADDR)) */ -#if !defined(HAVE_GETPWNAM_R) || !defined(HAVE_GETPWUID_R) - /* - *--------------------------------------------------------------------------- - * - * CopyPwd -- - * - * Copies string fields of the passwd structure to the - * private buffer, honouring the size of the buffer. - * - * Results: - * 0 on success or -1 on error (errno = ERANGE) - * - * Side effects: - * We are not copying the gecos field as it may not be supported - * on all platforms. - * - *--------------------------------------------------------------------------- + * Helper function declarations. Note that these are only used if needed and + * only defined if used (via the NEED_* macros). */ -static int -CopyPwd( - struct passwd *tgtPtr, - char *buf, - int buflen) -{ - char *p = buf; - int copied, len = 0; - - copied = CopyString(tgtPtr->pw_name, p, buflen - len); - if (copied == -1) { - range: - errno = ERANGE; - return -1; - } - tgtPtr->pw_name = (copied > 0) ? p : NULL; - len += copied; - p = buf + len; - - copied = CopyString(tgtPtr->pw_passwd, p, buflen - len); - if (copied == -1) { - goto range; - } - tgtPtr->pw_passwd = (copied > 0) ? p : NULL; - len += copied; - p = buf + len; - - copied = CopyString(tgtPtr->pw_dir, p, buflen - len); - if (copied == -1) { - goto range; - } - tgtPtr->pw_dir = (copied > 0) ? p : NULL; - len += copied; - p = buf + len; - - copied = CopyString(tgtPtr->pw_shell, p, buflen - len); - if (copied == -1) { - goto range; - } - tgtPtr->pw_shell = (copied > 0) ? p : NULL; +#undef NEED_COPYARRAY +#undef NEED_COPYGRP +#undef NEED_COPYHOSTENT +#undef NEED_COPYPWD +#undef NEED_COPYSTRING - return 0; -} -#endif /* !defined(HAVE_GETPWNAM_R) || !defined(HAVE_GETPWUID_R) */ - -#if !defined(HAVE_GETGRNAM_R) || !defined(HAVE_GETGRGID_R) - -/* - *--------------------------------------------------------------------------- - * - * CopyGrp -- - * - * Copies string fields of the group structure to the - * private buffer, honouring the size of the buffer. - * - * Results: - * 0 on success or -1 on error (errno = ERANGE) - * - * Side effects: - * None. - * - *--------------------------------------------------------------------------- - */ - -static int -CopyGrp( - struct group *tgtPtr, - char *buf, - int buflen) -{ - register char *p = buf; - register int copied, len = 0; - - /* Copy username */ - copied = CopyString(tgtPtr->gr_name, p, buflen - len); - if (copied == -1) { - range: - errno = ERANGE; - return -1; - } - tgtPtr->gr_name = (copied > 0) ? p : NULL; - len += copied; - p = buf + len; - - /* Copy password */ - copied = CopyString(tgtPtr->gr_passwd, p, buflen - len); - if (copied == -1) { - goto range; - } - tgtPtr->gr_passwd = (copied > 0) ? p : NULL; - len += copied; - p = buf + len; - - /* Copy group members */ - PadBuffer(p, len, sizeof(char *)); - copied = CopyArray((char **)tgtPtr->gr_mem, -1, p, buflen - len); - if (copied == -1) { - goto range; - } - tgtPtr->gr_mem = (copied > 0) ? (char **)p : NULL; - - return 0; -} -#endif /* !defined(HAVE_GETGRNAM_R) || !defined(HAVE_GETGRGID_R) */ +static int CopyArray(char **src, int elsize, char *buf, + int buflen); +static int CopyGrp(struct group *tgtPtr, char *buf, int buflen); +static int CopyHostent(struct hostent *tgtPtr, char *buf, + int buflen); +static int CopyPwd(struct passwd *tgtPtr, char *buf, int buflen); +static int CopyString(char *src, char *buf, int buflen); +#endif #endif /* TCL_THREADS */ - /* *--------------------------------------------------------------------------- * * TclpGetPwNam -- * - * Thread-safe wrappers for getpwnam(). - * See "man getpwnam" for more details. + * Thread-safe wrappers for getpwnam(). See "man getpwnam" for more + * details. * * Results: * Pointer to struct passwd on success or NULL on error. @@ -389,6 +117,7 @@ TclpGetPwNam( #if defined(HAVE_GETPWNAM_R_5) struct passwd *pwPtr = NULL; + return (getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf), &pwPtr) == 0 && pwPtr != NULL) ? &tsdPtr->pwd : NULL; @@ -396,7 +125,9 @@ TclpGetPwNam( return getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf)); #else +#define NEED_COPYPWD 1 struct passwd *pwPtr; + Tcl_MutexLock(&compatLock); pwPtr = getpwnam(name); if (pwPtr != NULL) { @@ -409,18 +140,18 @@ TclpGetPwNam( Tcl_MutexUnlock(&compatLock); return pwPtr; #endif - return NULL; /* Not reached */ + + return NULL; /* Not reached. */ #endif /* TCL_THREADS */ } - /* *--------------------------------------------------------------------------- * * TclpGetPwUid -- * - * Thread-safe wrappers for getpwuid(). - * See "man getpwuid" for more details. + * Thread-safe wrappers for getpwuid(). See "man getpwuid" for more + * details. * * Results: * Pointer to struct passwd on success or NULL on error. @@ -442,6 +173,7 @@ TclpGetPwUid( #if defined(HAVE_GETPWUID_R_5) struct passwd *pwPtr = NULL; + return (getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf), &pwPtr) == 0 && pwPtr != NULL) ? &tsdPtr->pwd : NULL; @@ -449,7 +181,9 @@ TclpGetPwUid( return getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf)); #else +#define NEED_COPYPWD 1 struct passwd *pwPtr; + Tcl_MutexLock(&compatLock); pwPtr = getpwuid(uid); if (pwPtr != NULL) { @@ -462,18 +196,18 @@ TclpGetPwUid( Tcl_MutexUnlock(&compatLock); return pwPtr; #endif - return NULL; /* Not reached */ + + return NULL; /* Not reached. */ #endif /* TCL_THREADS */ } - /* *--------------------------------------------------------------------------- * * TclpGetGrNam -- * - * Thread-safe wrappers for getgrnam(). - * See "man getgrnam" for more details. + * Thread-safe wrappers for getgrnam(). See "man getgrnam" for more + * details. * * Results: * Pointer to struct group on success or NULL on error. @@ -495,6 +229,7 @@ TclpGetGrNam( #if defined(HAVE_GETGRNAM_R_5) struct group *grPtr = NULL; + return (getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf), &grPtr) == 0 && grPtr != NULL) ? &tsdPtr->grp : NULL; @@ -502,7 +237,9 @@ TclpGetGrNam( return getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf)); #else +#define NEED_COPYGRP 1 struct group *grPtr; + Tcl_MutexLock(&compatLock); grPtr = getgrnam(name); if (grPtr != NULL) { @@ -515,18 +252,18 @@ TclpGetGrNam( Tcl_MutexUnlock(&compatLock); return grPtr; #endif - return NULL; /* Not reached */ + + return NULL; /* Not reached. */ #endif /* TCL_THREADS */ } - /* *--------------------------------------------------------------------------- * * TclpGetGrGid -- * - * Thread-safe wrappers for getgrgid(). - * See "man getgrgid" for more details. + * Thread-safe wrappers for getgrgid(). See "man getgrgid" for more + * details. * * Results: * Pointer to struct group on success or NULL on error. @@ -548,6 +285,7 @@ TclpGetGrGid( #if defined(HAVE_GETGRGID_R_5) struct group *grPtr = NULL; + return (getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf), &grPtr) == 0 && grPtr != NULL) ? &tsdPtr->grp : NULL; @@ -555,7 +293,9 @@ TclpGetGrGid( return getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf)); #else +#define NEED_COPYGRP 1 struct group *grPtr; + Tcl_MutexLock(&compatLock); grPtr = getgrgid(gid); if (grPtr != NULL) { @@ -568,18 +308,18 @@ TclpGetGrGid( Tcl_MutexUnlock(&compatLock); return grPtr; #endif - return NULL; /* Not reached */ + + return NULL; /* Not reached. */ #endif /* TCL_THREADS */ } - /* *--------------------------------------------------------------------------- * * TclpGetHostByName -- * - * Thread-safe wrappers for gethostbyname(). - * See "man gethostbyname" for more details. + * Thread-safe wrappers for gethostbyname(). See "man gethostbyname" for + * more details. * * Results: * Pointer to struct hostent on success or NULL on error. @@ -601,47 +341,53 @@ TclpGetHostByName( #if defined(HAVE_GETHOSTBYNAME_R_5) int h_errno; + return gethostbyname_r(name, &tsdPtr->hent, tsdPtr->hbuf, sizeof(tsdPtr->hbuf), &h_errno); #elif defined(HAVE_GETHOSTBYNAME_R_6) struct hostent *hePtr; int h_errno; + return (gethostbyname_r(name, &tsdPtr->hent, tsdPtr->hbuf, - sizeof(tsdPtr->hbuf), &hePtr, &h_errno) == 0) ? - &tsdPtr->hent : NULL; + sizeof(tsdPtr->hbuf), &hePtr, &h_errno) == 0) + ? &tsdPtr->hent : NULL; #elif defined(HAVE_GETHOSTBYNAME_R_3) struct hostent_data data; - return (gethostbyname_r(name, &tsdPtr->hent, &data) == 0) ? - &tsdPtr->hent : NULL; + + return (gethostbyname_r(name, &tsdPtr->hent, &data) == 0) + ? &tsdPtr->hent : NULL; + #else +#define NEED_COPYHOSTENT 1 struct hostent *hePtr; + Tcl_MutexLock(&compatLock); hePtr = gethostbyname(name); if (hePtr != NULL) { tsdPtr->hent = *hePtr; hePtr = &tsdPtr->hent; if (CopyHostent(&tsdPtr->hent, tsdPtr->hbuf, - sizeof(tsdPtr->hbuf)) == -1) { + sizeof(tsdPtr->hbuf)) == -1) { hePtr = NULL; } } Tcl_MutexUnlock(&compatLock); return hePtr; #endif - return NULL; /* Not reached */ + + return NULL; /* Not reached. */ #endif /* TCL_THREADS */ } - /* *--------------------------------------------------------------------------- * * TclpGetHostByAddr -- * - * Thread-safe wrappers for gethostbyaddr(). - * See "man gethostbyaddr" for more details. + * Thread-safe wrappers for gethostbyaddr(). See "man gethostbyaddr" for + * more details. * * Results: * Pointer to struct hostent on success or NULL on error. @@ -665,30 +411,346 @@ TclpGetHostByAddr( #if defined(HAVE_GETHOSTBYADDR_R_7) int h_errno; + return gethostbyaddr_r(addr, length, type, &tsdPtr->hent, tsdPtr->hbuf, - sizeof(tsdPtr->hbuf), &h_errno); + sizeof(tsdPtr->hbuf), &h_errno); #elif defined(HAVE_GETHOSTBYADDR_R_8) struct hostent *hePtr; int h_errno; + return (gethostbyaddr_r(addr, length, type, &tsdPtr->hent, tsdPtr->hbuf, - sizeof(tsdPtr->hbuf), &hePtr, &h_errno) == 0) ? - &tsdPtr->hent : NULL; + sizeof(tsdPtr->hbuf), &hePtr, &h_errno) == 0) + ? &tsdPtr->hent : NULL; #else +#define NEED_COPYHOSTENT 1 struct hostent *hePtr; + Tcl_MutexLock(&compatLock); hePtr = gethostbyaddr(addr, length, type); if (hePtr != NULL) { tsdPtr->hent = *hePtr; hePtr = &tsdPtr->hent; if (CopyHostent(&tsdPtr->hent, tsdPtr->hbuf, - sizeof(tsdPtr->hbuf)) == -1) { + sizeof(tsdPtr->hbuf)) == -1) { hePtr = NULL; } } Tcl_MutexUnlock(&compatLock); return hePtr; #endif - return NULL; /* Not reached */ + + return NULL; /* Not reached. */ #endif /* TCL_THREADS */ } + +/* + *--------------------------------------------------------------------------- + * + * CopyGrp -- + * + * Copies string fields of the group structure to the private buffer, + * honouring the size of the buffer. + * + * Results: + * 0 on success or -1 on error (errno = ERANGE). + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +#ifdef NEED_COPYGRP +#define NEED_COPYARRAY 1 +#define NEED_COPYSTRING 1 + +static int +CopyGrp( + struct group *tgtPtr, + char *buf, + int buflen) +{ + register char *p = buf; + register int copied, len = 0; + + /* + * Copy username. + */ + + copied = CopyString(tgtPtr->gr_name, p, buflen - len); + if (copied == -1) { + goto range; + } + tgtPtr->gr_name = (copied > 0) ? p : NULL; + len += copied; + p = buf + len; + + /* + * Copy password. + */ + + copied = CopyString(tgtPtr->gr_passwd, p, buflen - len); + if (copied == -1) { + goto range; + } + tgtPtr->gr_passwd = (copied > 0) ? p : NULL; + len += copied; + p = buf + len; + + /* + * Copy group members. + */ + + PadBuffer(p, len, sizeof(char *)); + copied = CopyArray((char **)tgtPtr->gr_mem, -1, p, buflen - len); + if (copied == -1) { + goto range; + } + tgtPtr->gr_mem = (copied > 0) ? (char **)p : NULL; + + return 0; + + range: + errno = ERANGE; + return -1; +} +#endif /* NEED_COPYGRP */ + +/* + *--------------------------------------------------------------------------- + * + * CopyHostent -- + * + * Copies string fields of the hostnent structure to the private buffer, + * honouring the size of the buffer. + * + * Results: + * Number of bytes copied on success or -1 on error (errno = ERANGE) + * + * Side effects: + * None + * + *--------------------------------------------------------------------------- + */ + +#ifdef NEED_COPYHOSTENT +#define NEED_COPYSTRING 1 +#define NEED_COPYARRAY 1 + +static int +CopyHostent( + struct hostent *tgtPtr, + char *buf, + int buflen) +{ + char *p = buf; + int copied, len = 0; + + copied = CopyString(tgtPtr->h_name, p, buflen - len); + if (copied == -1) { + goto range; + } + tgtPtr->h_name = (copied > 0) ? p : NULL; + len += copied; + p = buf + len; + + PadBuffer(p, len, sizeof(char *)); + copied = CopyArray(tgtPtr->h_aliases, -1, p, buflen - len); + if (copied == -1) { + goto range; + } + tgtPtr->h_aliases = (copied > 0) ? (char **)p : NULL; + len += copied; + p += len; + + PadBuffer(p, len, sizeof(char *)); + copied = CopyArray(tgtPtr->h_addr_list, tgtPtr->h_length, p, buflen-len); + if (copied == -1) { + goto range; + } + tgtPtr->h_addr_list = (copied > 0) ? (char **)p : NULL; + + return 0; + + range: + errno = ERANGE; + return -1; +} +#endif /* NEED_COPYHOSTENT */ + +/* + *--------------------------------------------------------------------------- + * + * CopyPwd -- + * + * Copies string fields of the passwd structure to the private buffer, + * honouring the size of the buffer. + * + * Results: + * 0 on success or -1 on error (errno = ERANGE). + * + * Side effects: + * We are not copying the gecos field as it may not be supported on all + * platforms. + * + *--------------------------------------------------------------------------- + */ + +#ifdef NEED_COPYPWD +#define NEED_COPYSTRING 1 + +static int +CopyPwd( + struct passwd *tgtPtr, + char *buf, + int buflen) +{ + char *p = buf; + int copied, len = 0; + + copied = CopyString(tgtPtr->pw_name, p, buflen - len); + if (copied == -1) { + range: + errno = ERANGE; + return -1; + } + tgtPtr->pw_name = (copied > 0) ? p : NULL; + len += copied; + p = buf + len; + + copied = CopyString(tgtPtr->pw_passwd, p, buflen - len); + if (copied == -1) { + goto range; + } + tgtPtr->pw_passwd = (copied > 0) ? p : NULL; + len += copied; + p = buf + len; + + copied = CopyString(tgtPtr->pw_dir, p, buflen - len); + if (copied == -1) { + goto range; + } + tgtPtr->pw_dir = (copied > 0) ? p : NULL; + len += copied; + p = buf + len; + + copied = CopyString(tgtPtr->pw_shell, p, buflen - len); + if (copied == -1) { + goto range; + } + tgtPtr->pw_shell = (copied > 0) ? p : NULL; + + return 0; +} +#endif /* NEED_COPYPWD */ + +/* + *--------------------------------------------------------------------------- + * + * CopyArray -- + * + * Copies array of NULL-terminated or fixed-length strings to the private + * buffer, honouring the size of the buffer. + * + * Results: + * Number of bytes copied on success or -1 on error (errno = ERANGE) + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +#ifdef NEED_COPYARRAY +static int +CopyArray( + char **src, /* Array of elements to copy. */ + int elsize, /* Size of each element, or -1 to indicate + * that they are C strings of dynamic + * length. */ + char *buf, /* Buffer to copy into. */ + int buflen) /* Size of buffer. */ +{ + int i, j, len = 0; + char *p, **new; + + if (src == NULL) { + return 0; + } + + for (i = 0; src[i] != NULL; i++) { + /* + * Empty loop to count how many. + */ + } + len = sizeof(char *) * (i + 1); /* Leave place for the array. */ + if (len > buflen) { + return -1; + } + + new = (char **) buf; + p = buf + len; + + for (j = 0; j < i; j++) { + int sz = (elsize<0 ? strlen(src[j])+1 : elsize); + + len += sz; + if (len > buflen) { + return -1; + } + memcpy(p, src[j], sz); + new[j] = p; + p = buf + len; + } + new[j] = NULL; + + return len; +} +#endif /* NEED_COPYARRAY */ + +/* + *--------------------------------------------------------------------------- + * + * CopyString -- + * + * Copies a NULL-terminated string to the private buffer, honouring the + * size of the buffer + * + * Results: + * 0 success or -1 on error (errno = ERANGE) + * + * Side effects: + * None + * + *--------------------------------------------------------------------------- + */ + +#ifdef NEED_COPYSTRING +static int +CopyString( + char *src, /* String to copy. */ + char *buf, /* Buffer to copy into. */ + int buflen) /* Size of buffer. */ +{ + int len = 0; + + if (src != NULL) { + len = strlen(src) + 1; + if (len > buflen) { + return -1; + } + memcpy(buf, src, len); + } + + return len; +} +#endif /* NEED_COPYSTRING */ + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index aef6b5b..5185eb8 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -2,7 +2,7 @@ * tclUnixFCmd.c * * This file implements the unix specific portion of file manipulation - * subcommands of the "file" command. All filename arguments should + * subcommands of the "file" command. All filename arguments should * already be translated to native format. * * Copyright (c) 1996-1998 Sun Microsystems, Inc. @@ -10,13 +10,13 @@ * 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 2007/04/23 20:35:55 das Exp $ + * RCS: @(#) $Id: tclUnixFCmd.c,v 1.61.2.1 2007/09/04 17:44:22 dgp Exp $ * * Portions of this code were derived from NetBSD source code which has the * following copyright notice: * * Copyright (c) 1988, 1993, 1994 - * The Regents of the University of California. All rights reserved. + * The Regents of the University of California. All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are met: @@ -63,7 +63,7 @@ * TraverseUnixTree() calls the traverseProc() */ -#define DOTREE_PRED 1 /* pre-order directory */ +#define DOTREE_PRED 1 /* pre-order directory */ #define DOTREE_POSTD 2 /* post-order directory */ #define DOTREE_F 3 /* regular file */ @@ -164,11 +164,11 @@ CONST TclFileAttrProcs tclpFileAttrProcs[] = { * This is the maximum number of consecutive readdir/unlink calls that can be * made (with no intervening rewinddir or closedir/opendir) before triggering * a bug that makes readdir return NULL even though some directory entries - * have not been processed. The bug afflicts SunOS's readdir when applied to - * ufs file systems and Darwin 6.5's (and OSX v.10.3.8's) HFS+. JH found the - * Darwin readdir to reset at 147, so 130 is chosen to be conservative. We + * have not been processed. The bug afflicts SunOS's readdir when applied to + * ufs file systems and Darwin 6.5's (and OSX v.10.3.8's) HFS+. JH found the + * Darwin readdir to reset at 147, so 130 is chosen to be conservative. We * can't do a general rewind on failure as NFS can create special files that - * recreate themselves when you try and delete them. 8.4.8 added a solution + * recreate themselves when you try and delete them. 8.4.8 added a solution * that was affected by a single such NFS file, this solution should not be * affected by less than THRESHOLD such files. [Bug 1034337] */ @@ -224,10 +224,11 @@ Realpath( defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \ MAC_OS_X_VERSION_MIN_REQUIRED < 1030 /* - * prior to Darwin 7, realpath is not threadsafe, c.f. bug 711232; - * if we might potentially be running on pre-10.3 OSX, - * check Darwin release at runtime before using realpath. + * Prior to Darwin 7, realpath is not thread-safe, c.f. Bug 711232; if we + * might potentially be running on pre-10.3 OSX, check Darwin release at + * runtime before using realpath. */ + MODULE_SCOPE long tclMacOSXDarwinRelease; #define haveRealpath (tclMacOSXDarwinRelease >= 7) #else @@ -243,25 +244,25 @@ MODULE_SCOPE long tclMacOSXDarwinRelease; defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \ MAC_OS_X_VERSION_MIN_REQUIRED < 1050 /* - * prior to Darwin 9, 64bit fts_open() without FTS_NOSTAT may crash (due to a + * Prior to Darwin 9, 64bit fts_open() without FTS_NOSTAT may crash (due to a * 64bit-unsafe ALIGN macro); if we could be running on pre-10.5 OSX, check * Darwin release at runtime and do a separate stat() if necessary. */ + MODULE_SCOPE long tclMacOSXDarwinRelease; #define noFtsStat (tclMacOSXDarwinRelease < 9) #else #define noFtsStat 0 #endif #endif /* HAVE_FTS */ - /* *--------------------------------------------------------------------------- * * TclpObjRenameFile, DoRenameFile -- * - * Changes the name of an existing file or directory, from src to dst. - * If src and dst refer to the same file or directory, does nothing and + * Changes the name of an existing file or directory, from src to dst. If + * src and dst refer to the same file or directory, does nothing and * returns success. Otherwise if dst already exists, it will be deleted * and replaced by src subject to the following conditions: * If src is a directory, dst may be an empty directory. @@ -269,7 +270,7 @@ MODULE_SCOPE long tclMacOSXDarwinRelease; * In any other situation where dst already exists, the rename will fail. * * Results: - * If the directory was successfully created, returns TCL_OK. Otherwise + * If the directory was successfully created, returns TCL_OK. Otherwise * the return value is TCL_ERROR and errno is set to indicate the error. * Some possible values for errno are: * @@ -388,12 +389,12 @@ DoRenameFile( * * Results: * If the file was successfully copied, returns TCL_OK. Otherwise the - * return value is TCL_ERROR and errno is set to indicate the error. - * Some possible values for errno are: + * return value is TCL_ERROR and errno is set to indicate the error. Some + * possible values for errno are: * * EACCES: src or dst parent directory can't be read and/or written. * EISDIR: src or dst is a directory. - * ENOENT: src doesn't exist. src or dst is "". + * ENOENT: src doesn't exist. src or dst is "". * * Side effects: * This procedure will also copy symbolic links, block, and character @@ -435,7 +436,7 @@ DoCopyFile( } /* - * symlink, and some of the other calls will fail if the target exists, so + * Symlink, and some of the other calls will fail if the target exists, so * we remove it first. */ @@ -501,7 +502,7 @@ DoCopyFile( * A standard Tcl result. * * Side effects: - * A file is copied. Dst will be overwritten if it exists. + * A file is copied. Dst will be overwritten if it exists. * *---------------------------------------------------------------------- */ @@ -545,8 +546,7 @@ TclUnixCopyFile( #ifdef HAVE_ST_BLKSIZE blockSize = statBufPtr->st_blksize; -#else -#ifndef NO_FSTATFS +#elif !defined(NO_FSTATFS) { struct statfs fs; @@ -558,18 +558,17 @@ TclUnixCopyFile( } #else blockSize = 4096; -#endif -#endif +#endif /* HAVE_ST_BLKSIZE */ - /* [SF Tcl Bug 1586470] Even if we HAVE_ST_BLKSIZE, there are - * filesystems which report a bogus value for the blocksize. An - * example is the Andrew Filesystem (afs), reporting a blocksize - * of 0. When detecting such a situation we now simply fall back - * to a hardwired default size. + /* + * [SF Tcl Bug 1586470] Even if we HAVE_ST_BLKSIZE, there are filesystems + * which report a bogus value for the blocksize. An example is the Andrew + * Filesystem (afs), reporting a blocksize of 0. When detecting such a + * situation we now simply fall back to a hardwired default size. */ if (blockSize <= 0) { - blockSize = 4096; + blockSize = 4096; } buffer = ckalloc(blockSize); while (1) { @@ -610,8 +609,8 @@ TclUnixCopyFile( * * Results: * If the file was successfully deleted, returns TCL_OK. Otherwise the - * return value is TCL_ERROR and errno is set to indicate the error. - * Some possible values for errno are: + * return value is TCL_ERROR and errno is set to indicate the error. Some + * possible values for errno are: * * EACCES: a parent directory can't be read and/or written. * EISDIR: path is a directory. @@ -756,7 +755,6 @@ TclpObjCopyDirectory( } return ret; } - /* *--------------------------------------------------------------------------- @@ -1010,8 +1008,8 @@ TraverseUnixTree( if (doRewind && (numProcessed > MAX_READDIR_UNLINK_THRESHOLD)) { /* * Call rewinddir if we've called unlink or rmdir so many times - * (since the opendir or the previous rewinddir), to avoid - * a NULL-return that may a symptom of a buggy readdir. + * (since the opendir or the previous rewinddir), to avoid a + * NULL-return that may a symptom of a buggy readdir. */ rewinddir(dirPtr); @@ -1041,7 +1039,7 @@ TraverseUnixTree( #else /* HAVE_FTS */ paths[0] = source; fts = fts_open((char**)paths, FTS_PHYSICAL | FTS_NOCHDIR | - (noFtsStat || doRewind ? FTS_NOSTAT : 0), NULL); + (noFtsStat || doRewind ? FTS_NOSTAT : 0), NULL); if (fts == NULL) { errfile = source; goto end; @@ -1068,15 +1066,15 @@ TraverseUnixTree( Tcl_DStringAppend(targetPtr, path, pathlen); } switch (info) { - case FTS_D: - type = DOTREE_PRED; - break; - case FTS_DP: - type = DOTREE_POSTD; - break; - default: - type = DOTREE_F; - break; + case FTS_D: + type = DOTREE_PRED; + break; + case FTS_DP: + type = DOTREE_POSTD; + break; + default: + type = DOTREE_F; + break; } if (!doRewind) { /* no need to stat for delete */ if (noFtsStat) { @@ -1288,7 +1286,6 @@ CopyFileAtts( #endif return TCL_OK; } - /* *---------------------------------------------------------------------- @@ -1311,7 +1308,7 @@ static int GetGroupAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ - Tcl_Obj *fileName, /* The name of the file (UTF-8). */ + Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { Tcl_StatBuf statBuf; @@ -1366,7 +1363,7 @@ static int GetOwnerAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ - Tcl_Obj *fileName, /* The name of the file (UTF-8). */ + Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { Tcl_StatBuf statBuf; @@ -1421,7 +1418,7 @@ static int GetPermissionsAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ - Tcl_Obj *fileName, /* The name of the file (UTF-8). */ + Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { Tcl_StatBuf statBuf; @@ -1560,7 +1557,7 @@ SetOwnerAttribute( } native = Tcl_FSGetNativePath(fileName); - result = chown(native, (uid_t) uid, (gid_t) -1); /* INTL: Native. */ + result = chown(native, (uid_t) uid, (gid_t) -1); /* INTL: Native. */ if (result != 0) { if (interp != NULL) { @@ -1852,13 +1849,13 @@ GetModeFromPermString( } } switch (op) { - case 1 : + case 1: *modePtr = oldMode | (who & what); continue; - case 2 : + case 2: *modePtr = oldMode & ~(who & what); continue; - case 3 : + case 3: *modePtr = (oldMode & ~who) | (who & what); continue; } @@ -2018,12 +2015,12 @@ TclpObjNormalizePath( Tcl_DStringFree(&ds); /* - * Enable this to have the native FS claim normalization of the - * whole path for existing files. That would permit the caller - * to declare normalization complete without calls to additional - * filesystems. Saving lots of calls is probably worth the extra - * access() time here. When no other FS's are registered though, - * things are less clear. + * Enable this to have the native FS claim normalization of + * the whole path for existing files. That would permit the + * caller to declare normalization complete without calls to + * additional filesystems. Saving lots of calls is probably + * worth the extra access() time here. When no other FS's are + * registered though, things are less clear. * if (0 == access(normPath, F_OK)) { return pathLen; diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index d4f1003..c611067 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -7,7 +7,7 @@ * Copyright (c) 1999 by Scriptics Corporation. * All rights reserved. * - * RCS: @(#) $Id: tclUnixInit.c,v 1.70 2007/04/23 20:35:55 das Exp $ + * RCS: @(#) $Id: tclUnixInit.c,v 1.70.2.1 2007/09/04 17:44:22 dgp Exp $ */ #include "tclInt.h" @@ -415,7 +415,8 @@ TclpInitPlatform(void) /* * Find local symbols. Don't report an error if we fail. */ - (void) dlopen (NULL, RTLD_NOW); /* INTL: Native. */ + + (void) dlopen(NULL, RTLD_NOW); /* INTL: Native. */ #endif /* @@ -441,6 +442,7 @@ TclpInitPlatform(void) #ifdef GET_DARWIN_RELEASE { struct utsname name; + if (!uname(&name)) { tclMacOSXDarwinRelease = strtol(name.release, NULL, 10); } @@ -762,7 +764,6 @@ TclpSetVariables( struct utsname name; #endif int unameOK; - CONST char *user; Tcl_DString ds; #ifdef HAVE_COREFOUNDATION @@ -772,6 +773,7 @@ TclpSetVariables( /* * Set msgcat fallback locale to current CFLocale identifier. */ + CFLocaleRef localeRef; if (CFLocaleCopyCurrent != NULL && CFLocaleGetIdentifier != NULL && @@ -790,11 +792,10 @@ TclpSetVariables( } CFRelease(localeRef); } -#endif +#endif /* MAC_OS_X_VERSION_MAX_ALLOWED > 1020 */ if (MacOSXGetLibraryPath(interp, MAXPATHLEN, tclLibPath) == TCL_OK) { CONST char *str; - Tcl_DString ds; CFBundleRef bundleRef; Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath, TCL_GLOBAL_ONLY); @@ -912,12 +913,12 @@ TclpSetVariables( Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE); -#endif +#endif /* DJGPP */ } Tcl_SetVar2(interp, "tcl_platform", "machine", name.machine, TCL_GLOBAL_ONLY); } -#endif +#endif /* !NO_UNAME */ if (!unameOK) { Tcl_SetVar2(interp, "tcl_platform", "os", "", TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "tcl_platform", "osVersion", "", TCL_GLOBAL_ONLY); @@ -925,19 +926,24 @@ TclpSetVariables( } /* - * Copy USER or LOGNAME environment variable into tcl_platform(user). + * Copy the username of the real user (according to getuid()) into + * tcl_platform(user). */ - Tcl_DStringInit(&ds); - user = TclGetEnv("USER", &ds); - if (user == NULL) { - user = TclGetEnv("LOGNAME", &ds); - if (user == NULL) { + { + struct passwd *pwEnt = TclpGetPwUid(getuid()); + const char *user; + + if (pwEnt == NULL) { user = ""; + Tcl_DStringInit(&ds); /* ensure cleanliness */ + } else { + user = Tcl_ExternalToUtfDString(NULL, pwEnt->pw_name, -1, &ds); } + + Tcl_SetVar2(interp, "tcl_platform", "user", user, TCL_GLOBAL_ONLY); + Tcl_DStringFree(&ds); } - Tcl_SetVar2(interp, "tcl_platform", "user", user, TCL_GLOBAL_ONLY); - Tcl_DStringFree(&ds); } /* diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h index 99dc65b..cd01440 100644 --- a/unix/tclUnixPort.h +++ b/unix/tclUnixPort.h @@ -19,7 +19,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixPort.h,v 1.56 2006/11/13 08:23:11 das Exp $ + * RCS: @(#) $Id: tclUnixPort.h,v 1.56.2.1 2007/09/04 17:44:23 dgp Exp $ */ #ifndef _TCLUNIXPORT @@ -484,10 +484,16 @@ extern int errno; * Variables provided by the C library: */ -#if defined(_sgi) || defined(__sgi) || (defined(__APPLE__) && defined(__DYNAMIC__)) -# define environ _environ -#endif +#if defined(__APPLE__) && defined(__DYNAMIC__) +# include +# define environ (*_NSGetEnviron()) +# define USE_PUTENV 1 +#else +# if defined(_sgi) || defined(__sgi) +# define environ _environ +# endif extern char **environ; +#endif /* * At present (12/91) not all stdlib.h implementations declare strtod. diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index 934b8ec..df165af 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.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: tclUnixSock.c,v 1.18 2007/04/16 13:36:36 dkf Exp $ + * RCS: @(#) $Id: tclUnixSock.c,v 1.18.2.1 2007/09/04 17:44:23 dgp Exp $ */ #include "tclInt.h" @@ -48,9 +48,9 @@ InitializeHostName( struct utsname u; struct hostent *hp; - (void *) memset((void *) &u, (int) 0, sizeof(struct utsname)); + memset(&u, (int) 0, sizeof(struct utsname)); if (uname(&u) > -1) { /* INTL: Native. */ - hp = TclpGetHostByName(u.nodename); /* INTL: Native. */ + hp = TclpGetHostByName(u.nodename); /* INTL: Native. */ if (hp == NULL) { /* * Sometimes the nodename is fully qualified, but gets truncated @@ -108,7 +108,7 @@ InitializeHostName( *encodingPtr = Tcl_GetEncoding(NULL, NULL); *lengthPtr = strlen(native); *valuePtr = ckalloc((unsigned int) (*lengthPtr)+1); - memcpy((void *) *valuePtr, (void *) native, (size_t)(*lengthPtr)+1); + memcpy(*valuePtr, (void *) native, (size_t)(*lengthPtr)+1); } /* diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index d4f2067..c99af02 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.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: tclUnixTime.c,v 1.30 2007/04/17 14:49:53 dkf Exp $ + * RCS: @(#) $Id: tclUnixTime.c,v 1.30.2.1 2007/09/04 17:44:23 dgp Exp $ */ #include "tclInt.h" @@ -401,8 +401,7 @@ TclpGetDate( * * TclpGmtime -- * - * Wrapper around the 'gmtime' library function to make it thread - * safe. + * Wrapper around the 'gmtime' library function to make it thread safe. * * Results: * Returns a pointer to a 'struct tm' in thread-specific data. diff --git a/win/Makefile.in b/win/Makefile.in index 53421e0..6caee7a 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -4,7 +4,7 @@ # "./configure", which is a configuration script generated by the "autoconf" # program (constructs like "@foo@" will get replaced in the actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.115.2.1 2007/07/01 17:31:27 dgp Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.115.2.2 2007/09/04 17:44:25 dgp Exp $ VERSION = @TCL_VERSION@ @@ -107,6 +107,10 @@ GENERIC_DIR_NATIVE = $(shell $(CYGPATH) '$(GENERIC_DIR)' | sed 's!\\!/!g') TOMMATH_DIR_NATIVE = $(shell $(CYGPATH) '$(TOMMATH_DIR)' | sed 's!\\!/!g') WIN_DIR_NATIVE = $(shell $(CYGPATH) '$(WIN_DIR)' | sed 's!\\!/!g') ROOT_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)' | sed 's!\\!/!g') +#GENERIC_DIR_NATIVE = $(GENERIC_DIR) +#TOMMATH_DIR_NATIVE = $(TOMMATH_DIR) +#WIN_DIR_NATIVE = $(WIN_DIR) +#ROOT_DIR_NATIVE = $(ROOT_DIR) # Fully qualify library path so that `make test` # does not depend on the current directory. @@ -645,8 +649,8 @@ install-libraries: libraries install-tzdata install-msgs @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.2.tm; @echo "Installing package tcltest 2.3a1 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3a1.tm; - @echo "Installing package platform 1.0.2 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.2.tm; + @echo "Installing package platform 1.0.3 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.3.tm; @echo "Installing package platform::shell 1.1.3 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.3.tm; @echo "Installing encodings"; diff --git a/win/configure b/win/configure index 763faa8..eb76682 100755 --- a/win/configure +++ b/win/configure @@ -2236,6 +2236,78 @@ ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $ ac_compiler_gnu=$ac_cv_c_compiler_gnu +echo "$as_me:$LINENO: checking for inline" >&5 +echo $ECHO_N "checking for inline... $ECHO_C" >&6 +if test "${ac_cv_c_inline+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_cv_c_inline=no +for ac_kw in inline __inline__ __inline; do + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#ifndef __cplusplus +typedef int foo_t; +static $ac_kw foo_t static_foo () {return 0; } +$ac_kw foo_t foo () {return 0; } +#endif + +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_c_inline=$ac_kw; break +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +done + +fi +echo "$as_me:$LINENO: result: $ac_cv_c_inline" >&5 +echo "${ECHO_T}$ac_cv_c_inline" >&6 + + +case $ac_cv_c_inline in + inline | yes) ;; + *) + case $ac_cv_c_inline in + no) ac_val=;; + *) ac_val=$ac_cv_c_inline;; + esac + cat >>confdefs.h <<_ACEOF +#ifndef __cplusplus +#define inline $ac_val +#endif +_ACEOF + ;; +esac + + # To properly support cross-compilation, one would # need to use these tool checks instead of # the ones below and reconfigure with @@ -2411,8 +2483,7 @@ echo $ECHO_N "checking for Cygwin version of gcc... $ECHO_C" >&6 if test "${ac_cv_cygwin+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else - -cat >conftest.$ac_ext <<_ACEOF + cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext diff --git a/win/configure.in b/win/configure.in index bd3b2ff..8e2ca72 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.1 2007/05/22 20:34:30 dgp Exp $ +# RCS: @(#) $Id: configure.in,v 1.92.2.2 2007/09/04 17:44:26 dgp Exp $ AC_INIT(../generic/tcl.h) AC_PREREQ(2.59) @@ -55,6 +55,7 @@ if test "${CFLAGS+set}" != "set" ; then fi AC_PROG_CC +AC_C_INLINE # To properly support cross-compilation, one would # need to use these tool checks instead of diff --git a/win/makefile.vc b/win/makefile.vc index dbcb582..20bebf0 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -12,7 +12,7 @@ # Copyright (c) 2001-2004 David Gravereaux. # #------------------------------------------------------------------------------ -# RCS: @(#) $Id: makefile.vc,v 1.160.2.1 2007/07/01 17:31:27 dgp Exp $ +# RCS: @(#) $Id: makefile.vc,v 1.160.2.2 2007/09/04 17:44:26 dgp Exp $ #------------------------------------------------------------------------------ # Check to see we are configured to build with MSVC (MSDEVDIR or MSVCDIR) @@ -456,7 +456,7 @@ crt = -MT TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" -I"$(TOMMATHDIR)" BASE_CFLAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) \ -DTCL_PIPE_DLL=\"$(TCLPIPEDLLNAME)\" -DTCL_TOMMATH \ - -DMP_PREC=4 + -DMP_PREC=4 -Dinline=__inline CON_CFLAGS = $(cflags) $(cdebug) $(crt) -DCONSOLE TCL_CFLAGS = $(BASE_CFLAGS) $(OPTDEFINES) STUB_CFLAGS = $(cflags) $(cdebug) $(OPTDEFINES) diff --git a/win/tclWinTest.c b/win/tclWinTest.c index 575c3c2..ac00411 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 2007/04/16 13:36:36 dkf Exp $ + * RCS: @(#) $Id: tclWinTest.c,v 1.19.2.1 2007/09/04 17:44:27 dgp Exp $ */ #include "tclInt.h" @@ -676,10 +676,11 @@ TestplatformChmod( *(getSidSubAuthorityProc( userSid, 0)) = SECURITY_WORLD_RID; /* If curAclPresent == false then curAcl and curAclDefaulted not valid */ - if (!getSecurityDescriptorDaclProc(secDesc, &curAclPresent, - &curAcl, &curAclDefaulted)) + if (!getSecurityDescriptorDaclProc((PSECURITY_DESCRIPTOR)secDesc, + &curAclPresent, &curAcl, + &curAclDefaulted)) { goto done; - + } if (!curAclPresent || !curAcl) { ACLSize.AclBytesInUse = 0; ACLSize.AceCount = 0; -- cgit v0.12