diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2013-12-30 10:24:20 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2013-12-30 10:24:20 (GMT) |
| commit | ea905988fa8cfecafe48a591a899f1275d7d3ca3 (patch) | |
| tree | 9dd08e96712d0bbeb26b46b3c2ac5d1312d63be7 | |
| parent | 48d8cf61b7fd0af160956618fdf9e4cbccebf078 (diff) | |
| parent | 1749e8cdf33e8232f22acc08f9ce4301b00ba7eb (diff) | |
| download | tcl-ea905988fa8cfecafe48a591a899f1275d7d3ca3.zip tcl-ea905988fa8cfecafe48a591a899f1275d7d3ca3.tar.gz tcl-ea905988fa8cfecafe48a591a899f1275d7d3ca3.tar.bz2 | |
merge main working branch
624 files changed, 23013 insertions, 13499 deletions
diff --git a/.fossil-settings/binary-glob b/.fossil-settings/binary-glob new file mode 100644 index 0000000..ca85874 --- /dev/null +++ b/.fossil-settings/binary-glob @@ -0,0 +1,3 @@ +*.bmp +*.gif +*.png diff --git a/.fossil-settings/crnl-glob b/.fossil-settings/crnl-glob new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/.fossil-settings/crnl-glob diff --git a/.fossil-settings/ignore-glob b/.fossil-settings/ignore-glob new file mode 100644 index 0000000..9ed86b1 --- /dev/null +++ b/.fossil-settings/ignore-glob @@ -0,0 +1,24 @@ +*.a +*.dll +*.dylib +*.exe +*.exp +*.lib +*.o +*.obj +*.res +*.sl +*.so +*/Makefile +*/config.cache +*/config.log +*/config.status +*/tclConfig.sh +*/tclsh* +*/tcltest* +*/versions.vc +unix/dltest.marker +unix/tcl.pc +unix/pkgs/* +win/pkgs/* +win/tcl.hpj diff --git a/.project b/.project new file mode 100644 index 0000000..358cc74 --- /dev/null +++ b/.project @@ -0,0 +1,11 @@ +<?xml version="1.0" encoding="UTF-8"?> +<projectDescription> + <name>tcl8.6</name> + <comment></comment> + <projects> + </projects> + <buildSpec> + </buildSpec> + <natures> + </natures> +</projectDescription> diff --git a/.settings/org.eclipse.core.resources.prefs b/.settings/org.eclipse.core.resources.prefs new file mode 100644 index 0000000..99f26c0 --- /dev/null +++ b/.settings/org.eclipse.core.resources.prefs @@ -0,0 +1,2 @@ +eclipse.preferences.version=1 +encoding/<project>=UTF-8 diff --git a/.settings/org.eclipse.core.runtime.prefs b/.settings/org.eclipse.core.runtime.prefs new file mode 100644 index 0000000..5a0ad22 --- /dev/null +++ b/.settings/org.eclipse.core.runtime.prefs @@ -0,0 +1,2 @@ +eclipse.preferences.version=1 +line.separator=\n @@ -1,5 +1,589 @@ +A NOTE ON THE CHANGELOG: +Starting in early 2011, Tcl source code has been under the management of +fossil, hosted at http://core.tcl.tk/tcl/ . Fossil presents a "Timeline" +view of changes made that is superior in every way to a hand edited log file. +Because of this, many Tcl developers are now out of the habit of maintaining +this log file. You may still find useful things in it, but the Timeline is +a better first place to look now. +============================================================================ + +2013-09-19 Don Porter <dgp@users.sourceforge.net> + + *** 8.6.1 TAGGED FOR RELEASE *** + + * generic/tcl.h: Bump version number to 8.6.1. + * library/init.tcl: + * unix/configure.in: + * win/configure.in: + * unix/tcl.spec: + * README: + + * unix/configure: autoconf-2.59 + * win/configure: + +2013-09-19 Donal Fellows <dkf@users.sf.net> + + * doc/next.n (METHOD SEARCH ORDER): Bug [3606943]: Corrected + description of method search order. + +2013-09-18 Donal Fellows <dkf@users.sf.net> + + Bump TclOO version to 1.0.1 for release. + +2013-09-17 Donal Fellows <dkf@users.sf.net> + + * generic/tclBinary.c (BinaryEncodeUu, BinaryDecodeUu): [Bug 2152292]: + Corrected implementation of the core of uuencode handling so that the + line length processing is correctly applied. + ***POTENTIAL INCOMPATIBILITY*** + Existing code that was using the old versions and working around the + limitations will now need to do far less. The -maxlen option now has + strict limits on the range of supported lengths; this is a limitation + of the format itself. + +2013-09-09 Donal Fellows <dkf@users.sf.net> + + * generic/tclOOMethod.c (CloneProcedureMethod): [Bug 3609693]: Strip + the internal representation of method bodies during cloning in order + to ensure that any bound references to instance variables are removed. + +2013-09-01 Donal Fellows <dkf@users.sf.net> + + * generic/tclBinary.c (BinaryDecodeHex): [Bug b98fa55285]: Ensure that + whitespace at the end of a string don't cause the decoder to drop the + last decoded byte. + +2013-08-03 Donal Fellows <dkf@users.sf.net> + + * library/auto.tcl: [Patch 3611643]: Allow TclOO classes to be found + by the autoloading mechanism. + +2013-08-02 Donal Fellows <dkf@users.sf.net> + + * generic/tclOODefineCmds.c (ClassSuperSet): Bug [9d61624b3d]: Stop + crashes when emptying the superclass slot, even when doing elaborate + things with metaclasses. + +2013-08-01 Harald Oehlmann <oehhar@users.sf.net> + + * tclUnixNotify.c (Tcl_InitNotifier): Bug [a0bc856dcd]: Start notifier + thread again if we were forked, to solve Rivet bug 55153. + +2013-07-05 Kevin B. Kenny <kennykb@acm.org> + + * library/tzdata/Africa/Casablanca: + * library/tzdata/America/Asuncion: + * library/tzdata/Antarctica/Macquarie: + * library/tzdata/Asia/Gaza: + * library/tzdata/Asia/Hebron: + * library/tzdata/Asia/Jerusalem: + http://www.iana.org/time-zones/repository/releases/tzdata2013d.tar.gz + +2013-07-03 Jan Nijtmans <nijtmans@users.sf.net> + + * unix/tclXtNotify.c: Bug [817249]: bring tclXtNotify.c up to date with + Tcl_SetNotifier() change. + +2013-07-02 Jan Nijtmans <nijtmans@users.sf.net> + + * unix/tcl.m4: Bug [32afa6e256]: dirent64 check is incorrect in tcl.m4 + * unix/configure: (thanks to Brian Griffin) + +2013-06-27 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclConfig.c: Bug [9b2e636361]: Tcl_CreateInterp() needs + * generic/tclMain.c: initialized encodings. + +2013-06-18 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclEvent.c: Bug [3611974]: InitSubsystems multiple thread + issue. + +2013-06-17 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/regc_locale.c: Bug [a876646efe]: re_expr character class + [:cntrl:] should contain \u0000 - \u001f + +2013-06-09 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclCompCmdsSZ.c (TclCompileTryCmd): [Bug 779d38b996]: + Rewrote the [try] compiler to generate better code in some cases and + to behave correctly in others; when an error happens during the + processing of an exception-trap clause or a finally clause, the + *original* return options are now captured in a -during option, even + when fully compiled. + +2013-06-05 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclExecute.c (INST_EXPAND_DROP): [Bugs 2835313, 3614226]: + New opcode to allow resetting the stack to get rid of an expansion, + restoring the stack to a known state in the process. + * generic/tclCompile.c, generic/tclCompCmds.c: Adjusted the compilers + for [break] and [continue] to get stack cleanup right in the majority + of cases. + * tests/for.test (for-7.*): Set of tests for these evil cases. + +2013-06-04 Jan Nijtmans <nijtmans@users.sf.net> + + * unix/tcl.m4: Eliminate NO_VIZ macro as current zlib uses HAVE_HIDDEN + instead. One more last-moment fix for FreeBSD by Pietro Cerutti + +2013-06-03 Miguel Sofer <msofer@users.sf.net> + + * generic/tclExecute.c: fix for perf bug detected by Kieran + (https://groups.google.com/forum/?fromgroups#!topic/comp.lang.tcl/vfpI3bc-DkQ), + diagnosed by dgp to be a close relative of [Bug 781585], which was + fixed by commit [f46fb50cb3]. This bug was introduced by myself in + commit [cbfe055d8c]. + +2013-06-03 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclCompCmds.c (TclCompileBreakCmd, TclCompileContinueCmd): + Added code to allow [break] and [continue] to be issued as a jump (in + the most common cases) rather than using the more expensive exception + processing path in the bytecode engine. [Bug 3614226]: Partial fix for + the issues relating to cleaning up the stack when dealing with [break] + and [continue]. + +2013-05-27 Harald Oehlmann <oehhar@users.sf.net> + + * library/msgcat/msgcat.tcl: [Bug 3036566]: Also get locale from + registry key HCU\Control Panel\Desktop : PreferredUILanguages to honor + installed language packs on Vista+. + Bumped msgcat version to 1.5.2 + +2013-05-22 Andreas Kupries <andreask@activestate.com> + + * tclCompile.c: Removed duplicate const qualifier causing the HP + native cc to error out. + +2013-05-22 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclUtf.c (TclUtfCasecmp): [Bug 3613609]: Replace problematic + uses of strcasecmp with a proper UTF-8-aware version. Affects both + [lsearch -nocase] and [lsort -nocase]. + +2013-05-22 Donal K. Fellows <dkf@users.sf.net> + + * doc/file.n: [Bug 3613671]: Added note to portability section on the + fact that [file owned] does not produce useful results on Windows. + +2013-05-20 Donal K. Fellows <dkf@users.sf.net> + + * unix/tclUnixFCmd.c (DefaultTempDir): [Bug 3613567]: Corrected logic + for checking return code of access() system call, which was inverted. + +2013-05-19 Jan Nijtmans <nijtmans@users.sf.net> + + * unix/tcl.m4: Fix for FreeBSD, and remove support for older + * unix/configure: FreeBSD versions. Patch by Pietro Cerutti. + +2013-05-18 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclCompCmdsGR.c: Split tclCompCmds.c again to keep size of + code down. + +2013-05-16 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclBasic.c: Add panic in order to detect incompatible + mingw32 sys/stat.h and sys/time.h headers. + +2013-05-13 Jan Nijtmans <nijtmans@users.sf.net> + + * compat/zlib/*: Upgrade to zlib 1.2.8 + +2013-05-10 Donal K. Fellows <dkf@users.sf.net> + + Optimizations and general bytecode generation improvements. + * generic/tclCompCmds.c (TclCompileAppendCmd, TclCompileLappendCmd): + (TclCompileReturnCmd): Make these generate bytecode in more cases. + (TclCompileListCmd): Make this able to push a literal when it can. + * generic/tclCompile.c (TclSetByteCodeFromAny, PeepholeOptimize): + Added checks to see if we can apply some simple cross-command-boundary + optimizations, and defined a small number of such optimizations. + (TclCompileScript): Added the special ability to compile the list + command with expansion ([list {*}blah]) into bytecode that does not + call an external command. + +2013-05-06 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclStubInit.c: Add support for Cygwin64, which has a 64-bit + * generic/tclDecls.h: "long" type. Binary compatibility with win64 + requires that all stub entries use 32-bit long's, therefore the need + for various wrapper functions/macros. For Tcl 9 a better solution is + needed, but that cannot be done without introducing binary + incompatibility. + +2013-04-30 Andreas Kupries <andreask@activestate.com> + + * library/platform/platform.tcl (::platform::LibcVersion): + * library/platform/pkgIndex.tcl: Followup to the 2013-01-30 change. + The RE become too restrictive again. SuSe added a timestamp after the + version. Loosened up a bit. Bumped package to version 1.0.12. + +2013-04-29 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclCompCmds.c (TclCompileArraySetCmd): Generate better code + when the list of things to set is a literal. + +2013-04-25 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclDecls.h: Implement Tcl_NewBooleanObj, Tcl_DbNewBooleanObj + and Tcl_SetBooleanObj as macros using Tcl_NewIntObj, Tcl_DbNewLongObj + and Tcl_SetIntObj. Starting with Tcl 8.5, this is exactly the same, it + only eliminates code duplication. + * generic/tclInt.h: Eliminate use of NO_WIDE_TYPE everywhere: It's + exactly the same as TCL_WIDE_INT_IS_LONG + +2013-04-19 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclDecls.h: Implement many Tcl_*Var* functions and + Tcl_GetIndexFromObj as (faster/stack-saving) macros around resp their + Tcl_*Var*2 equivalent and Tcl_GetIndexFromObjStruct. + +2013-04-12 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclDecls.h: Implement Tcl_Pkg* functions as + (faster/stack-saving) macros around Tcl_Pkg*Ex functions. + +2013-04-08 Don Porter <dgp@users.sourceforge.net> + + * generic/regc_color.c: [Bug 3610026]: Stop crash when the number of + * generic/regerrs.h: "colors" in a regular expression overflows a + * generic/regex.h: short int. Thanks to Heikki Linnakangas for + * generic/regguts.h: the report and the patch. + * tests/regexp.test: + +2013-04-04 Reinhard Max <max@suse.de> + + * library/http/http.tcl (http::geturl): Allow URLs that don't have a + path, but a query query, e.g. http://example.com?foo=bar + * Bump the http package to 2.8.7. + +2013-03-22 Venkat Iyer <venkat@comit.com> + * library/tzdata/Africa/Cairo: Update to tzdata2013b. + * library/tzdata/Africa/Casablanca: + * library/tzdata/Africa/Gaborone: + * library/tzdata/Africa/Tripoli: + * library/tzdata/America/Asuncion: + * library/tzdata/America/Barbados: + * library/tzdata/America/Bogota: + * library/tzdata/America/Costa_Rica: + * library/tzdata/America/Curacao: + * library/tzdata/America/Nassau: + * library/tzdata/America/Port-au-Prince: + * library/tzdata/America/Santiago: + * library/tzdata/Antarctica/Palmer: + * library/tzdata/Asia/Aden: + * library/tzdata/Asia/Hong_Kong: + * library/tzdata/Asia/Muscat: + * library/tzdata/Asia/Rangoon: + * library/tzdata/Asia/Shanghai: + * library/tzdata/Atlantic/Bermuda: + * library/tzdata/Europe/Vienna: + * library/tzdata/Pacific/Easter: + * library/tzdata/Pacific/Fiji: + * library/tzdata/Asia/Khandyga: (new) + * library/tzdata/Asia/Ust-Nera: (new) + * library/tzdata/Europe/Busingen: (new) + +2013-03-21 Don Porter <dgp@users.sourceforge.net> + + * library/auto.tcl: [Bug 2102614]: Add ensemble indexing support to + * tests/autoMkindex.test: [auto_mkindex]. Thanks Brian Griffin. + +2013-03-19 Don Porter <dgp@users.sourceforge.net> + + * generic/tclFCmd.c: [Bug 3597000]: Consistent [file copy] result. + * tests/fileSystem.test: + +2013-03-19 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tclWinFile.c: [Bug 3608360]: Incompatible behaviour of "file + exists". + +2013-03-18 Donal K. Fellows <dkf@users.sf.net> + + * tests/cmdAH.test (cmdAH-19.12): [Bug 3608360]: Added test to ensure + that we never ever allow [file exists] to do globbing. + +2013-03-12 Jan Nijtmans <nijtmans@users.sf.net> + + * unix/tcl.m4: Patch by Andrew Shadura, providing better support for + three architectures they have in Debian. + +2013-03-11 Don Porter <dgp@users.sourceforge.net> + + * generic/tclCompile.c: [Bugs 3607246,3607372]: Unbalanced refcounts + * generic/tclLiteral.c: of literals in the global literal table. + +2013-03-06 Don Porter <dgp@users.sourceforge.net> + + * generic/regc_nfa.c: [Bugs 3604074,3606683]: Rewrite of the + * generic/regcomp.c: fixempties() routine (and supporting routines) + to completely eliminate the infinite loop hazard. Thanks to Tom Lane + for the much improved solution. + +2013-02-28 Don Porter <dgp@users.sourceforge.net> + + * generic/tclLiteral.c: Revise TclReleaseLiteral() to tolerate a NULL + interp argument. + + * generic/tclCompile.c: Update callers and revise mistaken comments. + * generic/tclProc.c: + +2013-02-27 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/regcomp.c: [Bug 3606139]: missing error check allows + * tests/regexp.test: regexp to crash Tcl. Thanks to Tom Lane for + providing the test-case and the patch. + +2013-02-26 Donal K. Fellows <dkf@users.sf.net> + + * tests/chanio.test (chan-io-28.7): [Bug 3605120]: Stop test from + hanging when run standalone. + +2013-02-26 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclObj.c: Don't panic if Tcl_ConvertToType is called for a + type that doesn't have a setFromAnyProc, create a proper error message. + +2013-02-25 Donal K. Fellows <dkf@users.sf.net> + + * tests/binary.test (binary-41.*): [Bug 3605721]: Test independence + fixes. Thanks to Rolf Ade for pointing out the problem. + +2013-02-25 Don Porter <dgp@users.sourceforge.net> + + * tests/assocd.test: [Bugs 3605719,3605720]: Test independence. + * tests/basic.test: Thanks Rolf Ade for patches. + +2013-02-23 Jan Nijtmans <nijtmans@users.sf.net> + + * compat/fake-rfc2553.c: [Bug 3599194]: compat/fake-rfc2553.c is + broken. + +2013-02-22 Don Porter <dgp@users.sourceforge.net> + + * generic/tclAssembly.c: Shift more burden of smart cleanup + * generic/tclCompile.c: onto the TclFreeCompileEnv() routine. + Stop crashes when the hookProc raises an error. + +2013-02-20 Don Porter <dgp@users.sourceforge.net> + + * generic/tclNamesp.c: [Bug 3605447]: Make sure the -clear option + * tests/namespace.test: to [namespace export] always clears, whether + or not new export patterns are specified. + +2013-02-20 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tclWinDde.c: [Bug 3605401]: Compiler error with latest mingw-w64 + headers. + +2013-02-19 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclTrace.c: [Bug 2438181]: Incorrect error reporting in + * tests/trace.test: traces. Test-case and fix provided by Poor + Yorick. + +2013-02-15 Don Porter <dgp@users.sourceforge.net> + + * generic/regc_nfa.c: [Bug 3604074]: Fix regexp optimization to + * tests/regexp.test: stop hanging on the expression + ((((((((a)*)*)*)*)*)*)*)* . Thanks to Bjørn Grathwohl for discovery. + +2013-02-14 Harald Oehlmann <oehhar@users.sf.net> + + * library/msgcat/msgcat.tcl: [Bug 3604576]: Catch missing registry + entry "HCU\Control Panel\International". + Bumped msgcat version to 1.5.1 + +2013-02-11 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclZlib.c (ZlibTransformOutput): [Bug 3603553]: Ensure that + data gets written to the underlying stream by compressing transforms + when the amount of data to be written is one buffer's-worth; problem + was particularly likely to occur when compressing large quantities of + not-very-compressible data. Many thanks to Piera Poggio (vampiera) for + reporting. + +2013-02-09 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclOOBasic.c (TclOO_Object_VarName): [Bug 3603695]: Change + the way that the 'varname' method is implemented so that there are no + longer problems with interactions due to the resolver. Thanks to + Taylor Venable <tcvena@gmail.com> for identifying the problem. + +2013-02-08 Donal K. Fellows <dkf@users.sf.net> + + * generic/regc_nfa.c (duptraverse): [Bug 3603557]: Increase the + maximum depth of recursion used when duplicating an automaton in + response to encountering a "wild" RE that hit the previous limit. + Allow the limit (DUPTRAVERSE_MAX_DEPTH) to be set by defining its + value in the Makefile. Problem reported by Jonathan Mills. + +2013-02-05 Don Porter <dgp@users.sourceforge.net> + + * win/tclWinFile.c: [Bug 3603434]: Make sure TclpObjNormalizePath() + properly declares "a:/" to be normalized, even when no "A:" drive is + present on the system. + +2013-02-05 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclLoadNone.c (TclpLoadMemory): [Bug 3433012]: Added dummy + version of this function to use in the event that a platform thinks it + can load from memory but cannot actually do so due to it being + disabled at configuration time. + +2013-02-04 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclCompCmds.c (TclCompileArraySetCmd): [Bug 3603163]: Stop + crash in weird case where [eval] is used to make [array set] get + confused about whether there is a local variable table or not. Thanks + to Poor Yorick for identifying a reproducible crashing case. + +2013-01-30 Andreas Kupries <andreask@activestate.com> + + * library/platform/platform.tcl (::platform::LibcVersion): See + * library/platform/pkgIndex.tcl: [Bug 3599098]: Fixed the RE + * unix/Makefile.in: extracting the version to avoid issues with + * win/Makefile.in: recent changes to the glibc banner. Now targeting a + less variable part of the string. Bumped package to version 1.0.11. + +2013-01-28 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclCompCmds.c (TclCompileArraySetCmd) + (TclCompileArrayUnsetCmd, TclCompileDictAppendCmd) + (TclCompileDictCreateCmd, CompileDictEachCmd, TclCompileDictIncrCmd) + (TclCompileDictLappendCmd, TclCompileDictMergeCmd) + (TclCompileDictUnsetCmd, TclCompileDictUpdateCmd) + (TclCompileDictWithCmd, TclCompileInfoCommandsCmd): + * generic/tclCompCmdsSZ.c (TclCompileStringMatchCmd) + (TclCompileStringMapCmd): Improve the code generation in cases where + full compilation is impossible but a full ensemble invoke is provably + not necessary. + +2013-01-26 Jan Nijtmans <nijtmans@users.sf.net> + + * unix/tclUnixCompat.c: [Bug 3601804]: platformCPUID segmentation + fault on Darwin. + +2013-01-23 Donal K. Fellows <dkf@users.sf.net> + + * library/http/http.tcl (http::geturl): [Bug 2911139]: Do not do vwait + for connect to avoid reentrancy problems (except when operating + without a -command option). Internally, this means that all sockets + created by the http package will always be operated in asynchronous + mode. + +2013-01-21 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclInt.decls: Put back Tcl[GS]etStartupScript(Path|FileName) + in private stub table, so extensions using this (like Tk 8.4) will + continue to work in all Tcl 8.x versions. Extensions using this + still cannot be compiled against Tcl 8.6 headers. + +2013-01-18 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclPort.h: [Bug 3598300]: unix: tcl.h does not include + sys/stat.h + +2013-01-17 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclCompCmds.c (PushVarName): [Bug 3600328]: Added mechanism + for suppressing compilation of variables when we couldn't cope with + the results. Useful for some [array] subcommands. + * generic/tclEnsemble.c (CompileToCompiledCommand): Must restore the + compilation environment when a command compiler fails. + +2013-01-16 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclZlib.c (TclZlibInit): [Bug 3601086]: Register the config + info in the iso8859-1 encoding as that is guaranteed to be present. + +2013-01-16 Jan Nijtmans <nijtmans@users.sf.net> + + * Makefile.in: Allow win32 build with -DTCL_NO_DEPRECATED, just as + * generic/tcl.h: in the UNIX build. Define Tcl_EvalObj and + * generic/tclDecls.h: Tcl_GlobalEvalObj as macros, even when + * generic/tclBasic.c: TCL_NO_DEPRECATED is defined, so Tk can benefit + from it too. + +2013-01-14 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tcl.m4: More flexible search for win32 tclConfig.sh, backported + from TEA (not actually used in Tcl, only for Tk) + +2013-01-14 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclInt.decls: Put back Tcl_[GS]etStartupScript in internal + stub table, so extensions using this, compiled against 8.5 headers + still run in Tcl 8.6. + +2013-01-13 Alexandre Ferrieux <ferrieux@users.sourceforge.net> + + * doc/fileevent.n: [Bug 3436609]: Clarify readable fileevent "false + positives" in the case of multibyte encodings/transforms. + +2013-01-13 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclIntDecls.h: If TCL_NO_DEPRECATED is defined, make sure + that TIP #139 functions all are taken from the public stub table, even + if the inclusion is through tclInt.h. + +2013-01-12 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclInt.decls: Put back TclBackgroundException in internal + stub table, so extensions using this, compiled against 8.5 headers + still run in Tcl 8.6. + +2013-01-09 Jan Nijtmans <nijtmans@users.sf.net> + + * library/http/http.tcl: [Bug 3599395]: http assumes status line is a + proper Tcl list. + +2013-01-08 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tclWinFile.c: [Bug 3092089]: [file normalize] can remove path + components. [Bug 3587096]: win vista/7: "can't find init.tcl" when + called via junction without folder list access. + +2013-01-07 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclOOStubLib.c: Restrict the stub library to only use + * generic/tclTomMathStubLib.c: Tcl_PkgRequireEx, Tcl_ResetResult and + Tcl_AppendResult, not any other function. This puts least restrictions + on eventual Tcl 9 stubs re-organization, and it works on the widest + range of Tcl versions. + +2013-01-06 Jan Nijtmans <nijtmans@users.sf.net> + + * library/http/http.tcl: Don't depend on Spencer-specific regexp + * tests/env.test: syntax (/u and /U) any more in unrelated places. + * tests/exec.test: + Bump http package to 2.8.6. + +2013-01-04 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclEnsemble.c (CompileBasicNArgCommand): Added very simple + compiler (which just compiles to a normal invoke of the implementation + command) for many ensemble subcommands where we can prove that there + is no way for scripts to detect the difference even through error + handling or [info level]/[info frame]. This improves the code produced + from some ensembles (e.g., [info], [string]) to the point where the + ensemble is now not normally seen at the bytecode level at all. + +2013-01-04 Miguel Sofer <msofer@users.sf.net> + + * generic/tclInt.h: Insure that PURIFY builds cannot exploit the + * generic/tclExecute.c: Tcl stack to hide mem defects. + 2013-01-03 Donal K. Fellows <dkf@users.sf.net> + * doc/fconfigure.n, doc/CrtChannel.3: Updated to reflect the fact that + the minimum buffer size is one byte, not ten. Identified by Schelte + Bron on the Tcler's Chat. + * generic/tclExecute.c (TEBCresume:INST_INVOKE_REPLACE): * generic/tclEnsemble.c (TclCompileEnsemble): Added new mechanism to allow for more efficient dispatch of non-bytecode-compiled subcommands @@ -8,9 +592,9 @@ 2013-01-02 Miguel Sofer <msofer@users.sf.net> - * generic/tclEnsemble.c: Remove stray calls to Tcl_Alloc and - * generic/tclExecute.c: friends: the core should only use ckalloc - * generic/tclIORTrans.c: to allow MEM_DEBUG to work properly + * generic/tclEnsemble.c: Remove stray calls to Tcl_Alloc and friends: + * generic/tclExecute.c: the core should only use ckalloc to allow + * generic/tclIORTrans.c: MEM_DEBUG to work properly. * generic/tclTomMathInterface.c: 2012-12-31 Donal K. Fellows <dkf@users.sf.net> @@ -22,18 +606,18 @@ 2012-12-27 Jan Nijtmans <nijtmans@users.sf.net> * generic/tclListObj.c: [Bug 3598580]: Tcl_ListObjReplace may release - deleted elements too early + deleted elements too early. 2012-12-22 Alexandre Ferrieux <ferrieux@users.sourceforge.net> - * generic/tclUtil.c: Stop leaking allocated space when objifying a - zero-length DString. [Bug 3598150] spotted by afredd. + * generic/tclUtil.c: [Bug 3598150]: Stop leaking allocated space when + objifying a zero-length DString. Spotted by afredd. 2012-12-21 Jan Nijtmans <nijtmans@users.sf.net> * unix/dltest/pkgb.c: Inline compat Tcl_GetDefaultEncodingDir. - * generic/tclStubLib.c: Eliminate unnecessary static HasStubSupport() and - isDigit() functions, just do the same inline. + * generic/tclStubLib.c: Eliminate unnecessary static HasStubSupport() + and isDigit() functions, just do the same inline. 2012-12-18 Donal K. Fellows <dkf@users.sf.net> @@ -4067,6 +4651,7 @@ * generic/*Decls.h: (regenerated) 2010-08-18 Miguel Sofer <msofer@users.sf.net> + * generic/tclBasic.c: New redesign of [tailcall]: find * generic/tclExecute.c: errors early on, so that errorInfo * generic/tclInt.h: contains the proper info [Bug 3047235] @@ -4437,8 +5022,7 @@ 2010-05-19 Alexandre Ferrieux <ferrieux@users.sourceforge.net> * tests/dict.test: Add missing tests for [Bug 3004007], fixed under - the radar on 2010-02-24 (dkf): EIAS violation in - list-dict conversions. + the radar on 2010-02-24 (dkf): EIAS violation in list-dict conversions 2010-05-19 Jan Nijtmans <nijtmans@users.sf.net> @@ -6292,10 +6876,9 @@ 2009-11-11 Alexandre Ferrieux <ferrieux@users.sourceforge.net> - * generic/tclIO.c: Fix [Bug 2888099] (close discards ENOSPC error) - by saving the errno from the first of two - FlushChannel()s. Uneasy to test; might need - specific channel drivers. Four-hands with aku. + * generic/tclIO.c: Fix [Bug 2888099] (close discards ENOSPC error) by + saving the errno from the first of two FlushChannel()s. Uneasy to + test; might need specific channel drivers. Four-hands with aku. 2009-11-10 Pat Thoyts <patthoyts@users.sourceforge.net> @@ -8252,15 +8835,14 @@ implementation of the mkstemp() function, which is apparently needed on some platforms. - ****************************************************************** - *** CHANGELOG ENTRIES FOR 2008 IN "ChangeLog.2008" *** - *** CHANGELOG ENTRIES FOR 2006-2007 IN "ChangeLog.2007" *** - *** CHANGELOG ENTRIES FOR 2005 IN "ChangeLog.2005" *** - *** CHANGELOG ENTRIES FOR 2004 IN "ChangeLog.2004" *** - *** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003" *** - *** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002" *** - *** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001" *** - *** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000" *** - *** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" *** - ****************************************************************** - + ****************************************************************** + *** CHANGELOG ENTRIES FOR 2008 IN "ChangeLog.2008" *** + *** CHANGELOG ENTRIES FOR 2006-2007 IN "ChangeLog.2007" *** + *** CHANGELOG ENTRIES FOR 2005 IN "ChangeLog.2005" *** + *** CHANGELOG ENTRIES FOR 2004 IN "ChangeLog.2004" *** + *** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003" *** + *** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002" *** + *** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001" *** + *** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000" *** + *** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" *** + ****************************************************************** @@ -1,8 +1,7 @@ README: Tcl - This is the Tcl 8.6.0 source distribution. - http://tcl.sourceforge.net/ - You can get any source release of Tcl from the file distributions - link at the above URL. + This is the Tcl 8.6.1 source distribution. + http://sourceforge.net/projects/tcl/files/Tcl/ + You can get any source release of Tcl from the URL above. Contents -------- @@ -27,9 +26,14 @@ Tcl can also be used for a variety of web-related tasks and for creating powerful command languages for applications. Tcl is maintained, enhanced, and distributed freely by the Tcl community. -The home for Tcl/Tk releases and bug/patch database is on SourceForge: +Source code development and tracking of bug reports and feature requests +takes place at: - http://tcl.sourceforge.net/ + http://core.tcl.tk/ + +Tcl/Tk release and mailing list services are hosted by SourceForge: + + http://sourceforge.net/projects/tcl/ with the Tcl Developer Xchange hosted at: @@ -49,7 +53,7 @@ The home page for this release, including new features, is Detailed release notes can be found at the file distributions page by clicking on the relevant version. - http://sourceforge.net/projects/tcl/files/ + http://sourceforge.net/projects/tcl/files/Tcl/ Information about Tcl itself can be found at http://www.tcl.tk/about/ @@ -146,18 +150,13 @@ and go to the Mailing Lists page. ------------------------ We are very interested in receiving bug reports, patches, and suggestions -for improvements. We prefer that you send this information to us via the -bug form at SourceForge, rather than emailing us directly. The bug -database is at: - - http://tcl.sourceforge.net/ +for improvements. We prefer that you send this information to us as +tickets entered into our tracker at: -The bug form was designed to give uniform structure to bug reports as -well as to solicit enough information to minimize followup questions. + http://core.tcl.tk/tcl/reportlist We will log and follow-up on each bug, although we cannot promise a -specific turn-around time. Enhancements, reported via the Feature -Requests form at the same web site, may take longer and may not happen +specific turn-around time. Enhancements may take longer and may not happen at all unless there is widespread support for them (we're trying to slow the rate at which Tcl/Tk turns into a kitchen sink). It's very difficult to make incompatible changes to Tcl/Tk at this point, due to @@ -8163,3 +8163,144 @@ Dropped support for OS X versions less than 10.4 (Tiger) (fellows) 2012-12-13 (bug fix) crash: [zlib gunzip $data -header noSuchNs::var] (porter) --- Released 8.6.0, December 20, 2012 --- See ChangeLog for details --- + +2012-12-22 (bug fix)[3598150] DString to Tcl_Obj memleak (afredd) + +2012-12-27 (bug fix)[3598580] Tcl_ListObjReplace() refcount fix (nijtmans) + +2013-01-04 (bug fix) memleak in [format] compiler (fellows) + +2013-01-08 (bug fix)[3092089,3587096] [file normalize] on junction points + +2013-01-09 (bug fix)[3599395] status line processing (nijtmans) +2013-01-23 (bug fix)[2911139] repair async connection management (fellows) +=> http 2.8.6 + +2013-01-26 (bug fix)[3601804] Darwin segfault platformCPUID (nijtmans) + +2013-01-28 (enhancement) improve ensemble bytecode (fellows) + +2013-01-30 (enhancement) selected script code improvements (fradin) +=> tcltest 2.3.6 + +2013-01-30 (bug fix)[3599098] update to handle glibc banner changes (kupries) +=> platform 1.0.11 + +2013-01-31 (bug fix)[3598282] make install DESTDIR support (cassoff) + +2013-02-05 (bug fix)[3603434] [file normalize a:/] flaw in VFS (porter,griffin) + +2013-02-09 (bug fix)[3603695] $obj varname resolution rules (venable,fellows) + +2013-02-11 (bug fix)[3603553] zlib flushing errors (vampiera,fellows) + +2013-02-14 (bug fix)[3604576] msgcat use of Windows registry (oehlmann,nijtmans) +=> msgcat 1.5.1 + +2013-02-19 (bug fix)[2438181] report errors in trace handlers (yorick) + +2013-02-21 (bug fix)[3605447] unbreak [namespace export -clear] (porter) + +2013-02-23 (bug fix)[3599194] fallback IPv6 routines (afredd,max) + +2013-02-27 (bug fix)[3606139] stop crash in [regexp] (lane) + +2013-03-03 (bug fix)[3606258] major serial port update (english) + +2013-03-06 (bug fix)[3606683] [regexp (((((a)*)*)*)*)* {}] hangs +(grathwohl,lane,porter) + +2013-03-12 (enhancement) better build support for Debian arch (shadura) + +2013-03-19 (bug fix)[2893771] [file stat] on locked files (thoyts,nijtmans) + +2013-03-21 (bug fix)[2102614] [auto_mkindex] ensemble support (griffin) + +2013-03-27 Tcl_Zlib*() routines tolerate NULL interps (porter + +2013-04-04 (bug fix) Support URLs with query but no path (max) +=> http 2.8.7 + +2013-04-08 (bug fix)[3610026] regexp crash on color overflow (linnakangas) + +2013-04-29 (enhancement) [array set] compile improvement (fellows) + +2013-04-30 (enhancement) broaden glibc version detection (kupries) +=> platform 1.0.12 + +2013-05-06 (platform support) Cygwin64 (nijtmans) + +2013-05-15 (enhancement) Improved [list {*}...] compile (fellows) + +2013-05-16 (platform support) mingw-4.0 (nijtmans) + +2013-05-19 (platform support) FreeBSD updates (cerutti) + +2013-05-20 (bug fix)[3613567] access error temp file creation (keene) + +2013-05-20 (bug fix)[3613569] temp file open fail can crash [load] (keene) + +2013-05-22 (bug fix)[3613609] [lsort -nocase] failed on non-ASCII (fellows) + +2013-05-28 (bug fix)[3036566] Use language packs (Vista+) locale (oehlmann) +=> msgcat 1.5.2 + +2013-05-29 (bug fix)[3614102] [apply {{} {list [if 1]}}] stack woes (porter) + +2013-06-03 Restored lost performance appending to long strings (elby,porter) + +2013-06-05 (bug fix)[2835313] [while 1 {foo [continue]}] crash (fellows) + +2013-06-17 (bug fix)[a876646] [:cntrl:] includes \x00 to \x1f (nijtmans) + +2013-06-27 (bug fix)[983509] missing encodings for config values (nijtmans) + +2013-06-27 (bug fix)[34538b] apply DST in 2099 (lang) + +2013-07-02 (bug fix)[32afa6] corrected dirent64 check (griffin) + +2013-07-06 tzdata updated to Olson's tzdata2013d (kenny) + +2013-07-10 (bug fix)[86fb5e] [info frame] in compiled ensembles (porter) + +2013-07-18 (bug fix)[1c17fb] revisd syntax errorinfo that shows error (porter) + +2013-07-26 (bug fix)[6585b2] regexp {(\w).*?\1} abb (lane) + +2013-07-29 [string is space \u202f] => 1 (nijtmans) + +2013-08-01 [a0bc85] Limited support for fork with threads (for Rivet) (nijtmans) + +2013-08-01 (bug fix)[1905562] RE recursion limit increased to support +reported usage of large expressions (porter) + +2013-08-02 (bug fix)[9d6162] superclass slot empty crash (vdgoot,fellows)2013-08-02 (bug fix)[9d6162] superclass slot empty crash (vdgoot,fellows) + +2013-08-03 (enhancement)[3611643] [auto_mkindex] support TclOO (fellows) + +2013-08-14 (bug fix)[a16752] Missing command delete callbacks (porter) + +2013-08-15 (bug fix)[3610404] reresolve traced forwards (porter) + +2013-08-15 Errors from execution traces become errors of the command (porter) + +2013-08-23 (bug fix)[8ff0cb9] Tcl_NR*Eval*() schedule only, as doc'd (porter) + +2013-08-29 (bug fix)[2486550] enable [interp invokehidden {} yield] (porter) + +2013-09-01 (bug fix)[b98fa55] [binary decode] fail on whitespace (reche,fellows) + +2013-09-07 (bug fix)[86ceb4] have tm path favor first provider (neumann,porter) + +2013-09-09 (bug fix)[3609693] copied object member variable confusion (fellows) +=> TclOO 1.0.1 + +2013-09-17 (bug fix)[2152292] [binary encode uuencode] corrected (fellows) + +2013-09-19 (bug fix)[3487626] segfaults in [dict] compilers (porter) + +2013-09-19 (bug fix)[31661d2] mem leak in [lreplace] (ade,porter) + +Many optmizations, improvements, and tightened stack management in bytecode. + +--- Released 8.6.1, Septemer 20, 2013 --- http://core.tcl.tk/tcl/ for details diff --git a/compat/fake-rfc2553.c b/compat/fake-rfc2553.c index 666144f..3b91041 100644 --- a/compat/fake-rfc2553.c +++ b/compat/fake-rfc2553.c @@ -84,7 +84,7 @@ int fake_getnameinfo(const struct sockaddr *sa, size_t salen, char *host, if (host != NULL) { if (flags & NI_NUMERICHOST) { - int len; + size_t len; Tcl_MutexLock(&netdbMutex); len = strlcpy(host, inet_ntoa(sin->sin_addr), hostlen); Tcl_MutexUnlock(&netdbMutex); @@ -135,7 +135,7 @@ fake_gai_strerror(int err) #ifndef HAVE_FREEADDRINFO void -freeaddrinfo(struct addrinfo *ai) +fake_freeaddrinfo(struct addrinfo *ai) { struct addrinfo *next; @@ -199,7 +199,7 @@ fake_getaddrinfo(const char *hostname, const char *servname, port = strtol(servname, &cp, 10); if (port > 0 && port <= 65535 && *cp == '\0') - port = htons(port); + port = htons((unsigned short)port); else if ((sp = getservbyname(servname, NULL)) != NULL) port = sp->s_port; else diff --git a/compat/zlib/CMakeLists.txt b/compat/zlib/CMakeLists.txt index 7ee3bc4..0c0247c 100644 --- a/compat/zlib/CMakeLists.txt +++ b/compat/zlib/CMakeLists.txt @@ -3,7 +3,10 @@ set(CMAKE_ALLOW_LOOSE_LOOP_CONSTRUCTS ON) project(zlib C) -set(VERSION "1.2.7") +set(VERSION "1.2.8") + +option(ASM686 "Enable building i686 assembly implementation") +option(AMD64 "Enable building amd64 assembly implementation") set(INSTALL_BIN_DIR "${CMAKE_INSTALL_PREFIX}/bin" CACHE PATH "Installation directory for executables") set(INSTALL_LIB_DIR "${CMAKE_INSTALL_PREFIX}/lib" CACHE PATH "Installation directory for libraries") @@ -121,11 +124,44 @@ set(ZLIB_SRCS ) if(NOT MINGW) - set(ZLIB_SRCS ${ZLIB_SRCS} + set(ZLIB_DLL_SRCS win32/zlib1.rc # If present will override custom build rule below. ) endif() +if(CMAKE_COMPILER_IS_GNUCC) + if(ASM686) + set(ZLIB_ASMS contrib/asm686/match.S) + elseif (AMD64) + set(ZLIB_ASMS contrib/amd64/amd64-match.S) + endif () + + if(ZLIB_ASMS) + add_definitions(-DASMV) + set_source_files_properties(${ZLIB_ASMS} PROPERTIES LANGUAGE C COMPILE_FLAGS -DNO_UNDERLINE) + endif() +endif() + +if(MSVC) + if(ASM686) + ENABLE_LANGUAGE(ASM_MASM) + set(ZLIB_ASMS + contrib/masmx86/inffas32.asm + contrib/masmx86/match686.asm + ) + elseif (AMD64) + ENABLE_LANGUAGE(ASM_MASM) + set(ZLIB_ASMS + contrib/masmx64/gvmat64.asm + contrib/masmx64/inffasx64.asm + ) + endif() + + if(ZLIB_ASMS) + add_definitions(-DASMV -DASMINF) + endif() +endif() + # parse the full version number from zlib.h and include in ZLIB_FULL_VERSION file(READ ${CMAKE_CURRENT_SOURCE_DIR}/zlib.h _zlib_h_contents) string(REGEX REPLACE ".*#define[ \t]+ZLIB_VERSION[ \t]+\"([-0-9A-Za-z.]+)\".*" @@ -134,7 +170,7 @@ string(REGEX REPLACE ".*#define[ \t]+ZLIB_VERSION[ \t]+\"([-0-9A-Za-z.]+)\".*" if(MINGW) # This gets us DLL resource information when compiling on MinGW. if(NOT CMAKE_RC_COMPILER) - SET(CMAKE_RC_COMPILER windres.exe) + set(CMAKE_RC_COMPILER windres.exe) endif() add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/zlib1rc.obj @@ -144,11 +180,11 @@ if(MINGW) -I ${CMAKE_CURRENT_BINARY_DIR} -o ${CMAKE_CURRENT_BINARY_DIR}/zlib1rc.obj -i ${CMAKE_CURRENT_SOURCE_DIR}/win32/zlib1.rc) - set(ZLIB_SRCS ${ZLIB_SRCS} ${CMAKE_CURRENT_BINARY_DIR}/zlib1rc.obj) + set(ZLIB_DLL_SRCS ${CMAKE_CURRENT_BINARY_DIR}/zlib1rc.obj) endif(MINGW) -add_library(zlib SHARED ${ZLIB_SRCS} ${ZLIB_PUBLIC_HDRS} ${ZLIB_PRIVATE_HDRS}) -add_library(zlibstatic STATIC ${ZLIB_SRCS} ${ZLIB_PUBLIC_HDRS} ${ZLIB_PRIVATE_HDRS}) +add_library(zlib SHARED ${ZLIB_SRCS} ${ZLIB_ASMS} ${ZLIB_DLL_SRCS} ${ZLIB_PUBLIC_HDRS} ${ZLIB_PRIVATE_HDRS}) +add_library(zlibstatic STATIC ${ZLIB_SRCS} ${ZLIB_ASMS} ${ZLIB_PUBLIC_HDRS} ${ZLIB_PRIVATE_HDRS}) set_target_properties(zlib PROPERTIES DEFINE_SYMBOL ZLIB_DLL) set_target_properties(zlib PROPERTIES SOVERSION 1) @@ -166,7 +202,9 @@ endif() if(UNIX) # On unix-like platforms the library is almost always called libz set_target_properties(zlib zlibstatic PROPERTIES OUTPUT_NAME z) - set_target_properties(zlib PROPERTIES LINK_FLAGS "-Wl,--version-script,${CMAKE_CURRENT_SOURCE_DIR}/zlib.map") + if(NOT APPLE) + set_target_properties(zlib PROPERTIES LINK_FLAGS "-Wl,--version-script,\"${CMAKE_CURRENT_SOURCE_DIR}/zlib.map\"") + endif() elseif(BUILD_SHARED_LIBS AND WIN32) # Creates zlib1.dll when building shared library version set_target_properties(zlib PROPERTIES SUFFIX "1.dll") diff --git a/compat/zlib/ChangeLog b/compat/zlib/ChangeLog index c2c643a..f22aaba 100644 --- a/compat/zlib/ChangeLog +++ b/compat/zlib/ChangeLog @@ -1,6 +1,69 @@ ChangeLog file for zlib +Changes in 1.2.8 (28 Apr 2013) +- Update contrib/minizip/iowin32.c for Windows RT [Vollant] +- Do not force Z_CONST for C++ +- Clean up contrib/vstudio [Ro§] +- Correct spelling error in zlib.h +- Fix mixed line endings in contrib/vstudio + +Changes in 1.2.7.3 (13 Apr 2013) +- Fix version numbers and DLL names in contrib/vstudio/*/zlib.rc + +Changes in 1.2.7.2 (13 Apr 2013) +- Change check for a four-byte type back to hexadecimal +- Fix typo in win32/Makefile.msc +- Add casts in gzwrite.c for pointer differences + +Changes in 1.2.7.1 (24 Mar 2013) +- Replace use of unsafe string functions with snprintf if available +- Avoid including stddef.h on Windows for Z_SOLO compile [Niessink] +- Fix gzgetc undefine when Z_PREFIX set [Turk] +- Eliminate use of mktemp in Makefile (not always available) +- Fix bug in 'F' mode for gzopen() +- Add inflateGetDictionary() function +- Correct comment in deflate.h +- Use _snprintf for snprintf in Microsoft C +- On Darwin, only use /usr/bin/libtool if libtool is not Apple +- Delete "--version" file if created by "ar --version" [Richard G.] +- Fix configure check for veracity of compiler error return codes +- Fix CMake compilation of static lib for MSVC2010 x64 +- Remove unused variable in infback9.c +- Fix argument checks in gzlog_compress() and gzlog_write() +- Clean up the usage of z_const and respect const usage within zlib +- Clean up examples/gzlog.[ch] comparisons of different types +- Avoid shift equal to bits in type (caused endless loop) +- Fix unintialized value bug in gzputc() introduced by const patches +- Fix memory allocation error in examples/zran.c [Nor] +- Fix bug where gzopen(), gzclose() would write an empty file +- Fix bug in gzclose() when gzwrite() runs out of memory +- Check for input buffer malloc failure in examples/gzappend.c +- Add note to contrib/blast to use binary mode in stdio +- Fix comparisons of differently signed integers in contrib/blast +- Check for invalid code length codes in contrib/puff +- Fix serious but very rare decompression bug in inftrees.c +- Update inflateBack() comments, since inflate() can be faster +- Use underscored I/O function names for WINAPI_FAMILY +- Add _tr_flush_bits to the external symbols prefixed by --zprefix +- Add contrib/vstudio/vc10 pre-build step for static only +- Quote --version-script argument in CMakeLists.txt +- Don't specify --version-script on Apple platforms in CMakeLists.txt +- Fix casting error in contrib/testzlib/testzlib.c +- Fix types in contrib/minizip to match result of get_crc_table() +- Simplify contrib/vstudio/vc10 with 'd' suffix +- Add TOP support to win32/Makefile.msc +- Suport i686 and amd64 assembler builds in CMakeLists.txt +- Fix typos in the use of _LARGEFILE64_SOURCE in zconf.h +- Add vc11 and vc12 build files to contrib/vstudio +- Add gzvprintf() as an undocumented function in zlib +- Fix configure for Sun shell +- Remove runtime check in configure for four-byte integer type +- Add casts and consts to ease user conversion to C++ +- Add man pages for minizip and miniunzip +- In Makefile uninstall, don't rm if preceding cd fails +- Do not return Z_BUF_ERROR if deflateParam() has nothing to write + Changes in 1.2.7 (2 May 2012) - Replace use of memmove() with a simple copy for portability - Test for existence of strerror diff --git a/compat/zlib/Makefile.in b/compat/zlib/Makefile.in index 241deed..c61aa30 100644 --- a/compat/zlib/Makefile.in +++ b/compat/zlib/Makefile.in @@ -1,5 +1,5 @@ # Makefile for zlib -# Copyright (C) 1995-2011 Jean-loup Gailly. +# Copyright (C) 1995-2013 Jean-loup Gailly, Mark Adler # For conditions of distribution and use, see copyright notice in zlib.h # To compile and test, type: @@ -32,7 +32,7 @@ CPP=$(CC) -E STATICLIB=libz.a SHAREDLIB=libz.so -SHAREDLIBV=libz.so.1.2.7 +SHAREDLIBV=libz.so.1.2.8 SHAREDLIBM=libz.so.1 LIBS=$(STATICLIB) $(SHAREDLIBV) @@ -83,7 +83,7 @@ check: test test: all teststatic testshared teststatic: static - @TMPST=`mktemp fooXXXXXX`; \ + @TMPST=tmpst_$$; \ if echo hello world | ./minigzip | ./minigzip -d && ./example $$TMPST ; then \ echo ' *** zlib test OK ***'; \ else \ @@ -96,7 +96,7 @@ testshared: shared LD_LIBRARYN32_PATH=`pwd`:$(LD_LIBRARYN32_PATH) ; export LD_LIBRARYN32_PATH; \ DYLD_LIBRARY_PATH=`pwd`:$(DYLD_LIBRARY_PATH) ; export DYLD_LIBRARY_PATH; \ SHLIB_PATH=`pwd`:$(SHLIB_PATH) ; export SHLIB_PATH; \ - TMPSH=`mktemp fooXXXXXX`; \ + TMPSH=tmpsh_$$; \ if echo hello world | ./minigzipsh | ./minigzipsh -d && ./examplesh $$TMPSH; then \ echo ' *** zlib shared test OK ***'; \ else \ @@ -105,7 +105,7 @@ testshared: shared rm -f $$TMPSH test64: all64 - @TMP64=`mktemp fooXXXXXX`; \ + @TMP64=tmp64_$$; \ if echo hello world | ./minigzip64 | ./minigzip64 -d && ./example64 $$TMP64; then \ echo ' *** zlib 64-bit test OK ***'; \ else \ @@ -216,13 +216,13 @@ install: install-libs chmod 644 $(DESTDIR)$(includedir)/zlib.h $(DESTDIR)$(includedir)/zconf.h uninstall: - cd $(DESTDIR)$(includedir); rm -f zlib.h zconf.h - cd $(DESTDIR)$(libdir); rm -f libz.a; \ + cd $(DESTDIR)$(includedir) && rm -f zlib.h zconf.h + cd $(DESTDIR)$(libdir) && rm -f libz.a; \ if test -n "$(SHAREDLIBV)" -a -f $(SHAREDLIBV); then \ rm -f $(SHAREDLIBV) $(SHAREDLIB) $(SHAREDLIBM); \ fi - cd $(DESTDIR)$(man3dir); rm -f zlib.3 - cd $(DESTDIR)$(pkgconfigdir); rm -f zlib.pc + cd $(DESTDIR)$(man3dir) && rm -f zlib.3 + cd $(DESTDIR)$(pkgconfigdir) && rm -f zlib.pc docs: zlib.3.pdf @@ -230,7 +230,7 @@ zlib.3.pdf: zlib.3 groff -mandoc -f H -T ps zlib.3 | ps2pdf - zlib.3.pdf zconf.h.cmakein: zconf.h.in - -@ TEMPFILE=`mktemp __XXXXXX`; \ + -@ TEMPFILE=zconfh_$$; \ echo "/#define ZCONF_H/ a\\\\\n#cmakedefine Z_PREFIX\\\\\n#cmakedefine Z_HAVE_UNISTD_H\n" >> $$TEMPFILE &&\ sed -f $$TEMPFILE zconf.h.in > zconf.h.cmakein &&\ touch -r zconf.h.in zconf.h.cmakein &&\ diff --git a/compat/zlib/README b/compat/zlib/README index 6f1255f..5ca9d12 100644 --- a/compat/zlib/README +++ b/compat/zlib/README @@ -1,6 +1,6 @@ ZLIB DATA COMPRESSION LIBRARY -zlib 1.2.7 is a general purpose data compression library. All the code is +zlib 1.2.8 is a general purpose data compression library. All the code is thread safe. The data format used by the zlib library is described by RFCs (Request for Comments) 1950 to 1952 in the files http://tools.ietf.org/html/rfc1950 (zlib format), rfc1951 (deflate format) and @@ -31,7 +31,7 @@ Mark Nelson <markn@ieee.org> wrote an article about zlib for the Jan. 1997 issue of Dr. Dobb's Journal; a copy of the article is available at http://marknelson.us/1997/01/01/zlib-engine/ . -The changes made in version 1.2.7 are documented in the file ChangeLog. +The changes made in version 1.2.8 are documented in the file ChangeLog. Unsupported third party contributions are provided in directory contrib/ . @@ -84,7 +84,7 @@ Acknowledgments: Copyright notice: - (C) 1995-2012 Jean-loup Gailly and Mark Adler + (C) 1995-2013 Jean-loup Gailly and Mark Adler This software is provided 'as-is', without any express or implied warranty. In no event will the authors be held liable for any damages diff --git a/compat/zlib/as400/bndsrc b/compat/zlib/as400/bndsrc index 52cc661..98814fd 100644 --- a/compat/zlib/as400/bndsrc +++ b/compat/zlib/as400/bndsrc @@ -202,4 +202,14 @@ STRPGMEXP PGMLVL(*CURRENT) SIGNATURE('ZLIB') EXPORT SYMBOL("inflateResetKeep") +/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/ +/* Version 1.2.8 additional entry points. */ +/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/ + +/********************************************************************/ +/* *MODULE INFLATE ZLIB 01/02/01 00:15:09 */ +/********************************************************************/ + + EXPORT SYMBOL("inflateGetDictionary") + ENDPGMEXP diff --git a/compat/zlib/as400/compile.clp b/compat/zlib/as400/compile.clp index 8d0c58f..e3f47c6 100644 --- a/compat/zlib/as400/compile.clp +++ b/compat/zlib/as400/compile.clp @@ -105,6 +105,6 @@ &MODLIB/TREES &MODLIB/UNCOMPR + &MODLIB/ZUTIL) + SRCFILE(&SRCLIB/&CTLFILE) SRCMBR(BNDSRC) + - TEXT('ZLIB 1.2.7') TGTRLS(&TGTRLS) + TEXT('ZLIB 1.2.8') TGTRLS(&TGTRLS) ENDPGM diff --git a/compat/zlib/as400/readme.txt b/compat/zlib/as400/readme.txt index 23cd1b8..7b5d93b 100644 --- a/compat/zlib/as400/readme.txt +++ b/compat/zlib/as400/readme.txt @@ -1,4 +1,4 @@ - ZLIB version 1.2.7 for AS400 installation instructions + ZLIB version 1.2.8 for AS400 installation instructions I) From an AS400 *SAVF file: diff --git a/compat/zlib/as400/zlib.inc b/compat/zlib/as400/zlib.inc index 747c598..7341a6d 100644 --- a/compat/zlib/as400/zlib.inc +++ b/compat/zlib/as400/zlib.inc @@ -1,7 +1,7 @@ * ZLIB.INC - Interface to the general purpose compression library * * ILE RPG400 version by Patrick Monnerat, DATASPHERE. - * Version 1.2.7 + * Version 1.2.8 * * * WARNING: @@ -22,12 +22,12 @@ * * Versioning information. * - D ZLIB_VERSION C '1.2.7' - D ZLIB_VERNUM C X'1270' + D ZLIB_VERSION C '1.2.8' + D ZLIB_VERNUM C X'1280' D ZLIB_VER_MAJOR C 1 D ZLIB_VER_MINOR C 2 D ZLIB_VER_REVISION... - D C 7 + D C 8 D ZLIB_VER_SUBREVISION... D C 0 * @@ -359,6 +359,12 @@ D dictionary 65535 const options(*varsize) Dictionary bytes D dictLength 10U 0 value Dictionary length * + D inflateGetDictionary... + D PR 10I 0 extproc('inflateGetDictionary') Get dictionary + D strm like(z_stream) Expansion stream + D dictionary 65535 options(*varsize) Dictionary bytes + D dictLength 10U 0 Dictionary length + * D inflateSync PR 10I 0 extproc('inflateSync') Sync. expansion D strm like(z_stream) Expansion stream * diff --git a/compat/zlib/compress.c b/compat/zlib/compress.c index ea4dfbe..6e97626 100644 --- a/compat/zlib/compress.c +++ b/compat/zlib/compress.c @@ -29,7 +29,7 @@ int ZEXPORT compress2 (dest, destLen, source, sourceLen, level) z_stream stream; int err; - stream.next_in = (Bytef*)source; + stream.next_in = (z_const Bytef *)source; stream.avail_in = (uInt)sourceLen; #ifdef MAXSEG_64K /* Check for source > 64K on 16-bit machine: */ diff --git a/compat/zlib/configure b/compat/zlib/configure index 36c7d8e..b77a8a8 100755 --- a/compat/zlib/configure +++ b/compat/zlib/configure @@ -70,6 +70,7 @@ shared=1 solo=0 cover=0 zprefix=0 +zconst=0 build64=0 gcc=0 old_cc="$CC" @@ -77,13 +78,26 @@ old_cflags="$CFLAGS" OBJC='$(OBJZ) $(OBJG)' PIC_OBJC='$(PIC_OBJZ) $(PIC_OBJG)' +# leave this script, optionally in a bad way +leave() +{ + if test "$*" != "0"; then + echo "** $0 aborting." | tee -a configure.log + fi + rm -f $test.[co] $test $test$shared_ext $test.gcno ./--version + echo -------------------- >> configure.log + echo >> configure.log + echo >> configure.log + exit $1 +} + # process command line options while test $# -ge 1 do case "$1" in -h* | --help) echo 'usage:' | tee -a configure.log - echo ' configure [--zprefix] [--prefix=PREFIX] [--eprefix=EXPREFIX]' | tee -a configure.log + echo ' configure [--const] [--zprefix] [--prefix=PREFIX] [--eprefix=EXPREFIX]' | tee -a configure.log echo ' [--static] [--64] [--libdir=LIBDIR] [--sharedlibdir=LIBDIR]' | tee -a configure.log echo ' [--includedir=INCLUDEDIR] [--archs="-arch i386 -arch x86_64"]' | tee -a configure.log exit 0 ;; @@ -106,13 +120,18 @@ case "$1" in -a*=* | --archs=*) ARCHS=`echo $1 | sed 's/.*=//'`; shift ;; --sysconfdir=*) echo "ignored option: --sysconfdir" | tee -a configure.log; shift ;; --localstatedir=*) echo "ignored option: --localstatedir" | tee -a configure.log; shift ;; - *) echo "unknown option: $1"; echo "$0 --help for help" | tee -a configure.log; exit 1 ;; + -c* | --const) zconst=1; shift ;; + *) + echo "unknown option: $1" | tee -a configure.log + echo "$0 --help for help" | tee -a configure.log + leave 1;; esac done -# define functions for testing compiler and library characteristics and logging the results +# temporary file name test=ztest$$ +# put arguments in log, also put test file in log if used in arguments show() { case "$*" in @@ -124,43 +143,6 @@ show() echo $* >> configure.log } -cat > $test.c <<EOF -#error error -EOF -if ($CC -c $CFLAGS $test.c) 2>/dev/null; then - try() - { - show $* - test "`( $* ) 2>&1 | tee -a configure.log`" = "" - } - echo - using any output from compiler to indicate an error >> configure.log -else - try() - { - show $* - ( $* ) >> configure.log 2>&1 - ret=$? - if test $ret -ne 0; then - echo "(exit code "$ret")" >> configure.log - fi - return $ret - } -fi - -tryboth() -{ - show $* - got=`( $* ) 2>&1` - ret=$? - printf %s "$got" >> configure.log - if test $ret -ne 0; then - return $ret - fi - test "$got" = "" -} - -echo >> configure.log - # check for gcc vs. cc and set compile and link flags based on the system identified by uname cat > $test.c <<EOF extern int getchar(); @@ -179,8 +161,8 @@ case `$cc -v 2>&1` in *gcc*) gcc=1 ;; esac -show $cc -c $cflags $test.c -if test "$gcc" -eq 1 && ($cc -c $cflags $test.c) >> configure.log 2>&1; then +show $cc -c $test.c +if test "$gcc" -eq 1 && ($cc -c $test.c) >> configure.log 2>&1; then echo ... using gcc >> configure.log CC="$cc" CFLAGS="${CFLAGS--O3} ${ARCHS}" @@ -191,7 +173,11 @@ if test "$gcc" -eq 1 && ($cc -c $cflags $test.c) >> configure.log 2>&1; then SFLAGS="${SFLAGS} -m64" fi if test "${ZLIBGCCWARN}" = "YES"; then - CFLAGS="${CFLAGS} -Wall -Wextra -pedantic" + if test "$zconst" -eq 1; then + CFLAGS="${CFLAGS} -Wall -Wextra -Wcast-qual -pedantic -DZLIB_CONST" + else + CFLAGS="${CFLAGS} -Wall -Wextra -pedantic" + fi fi if test -z "$uname"; then uname=`(uname -s || echo unknown) 2>/dev/null` @@ -208,7 +194,7 @@ if test "$gcc" -eq 1 && ($cc -c $cflags $test.c) >> configure.log 2>&1; then # temporary bypass rm -f $test.[co] $test $test$shared_ext echo "Please use win32/Makefile.gcc instead." | tee -a configure.log - exit 1 + leave 1 LDSHARED=${LDSHARED-"$cc -shared"} LDSHAREDLIBC="" EXE='.exe' ;; @@ -231,7 +217,11 @@ if test "$gcc" -eq 1 && ($cc -c $cflags $test.c) >> configure.log 2>&1; then SHAREDLIBV=libz.$VER$shared_ext SHAREDLIBM=libz.$VER1$shared_ext LDSHARED=${LDSHARED-"$cc -dynamiclib -install_name $libdir/$SHAREDLIBM -compatibility_version $VER1 -current_version $VER3"} - AR="/usr/bin/libtool" + if libtool -V 2>&1 | grep Apple > /dev/null; then + AR="libtool" + else + AR="/usr/bin/libtool" + fi ARFLAGS="-o" ;; *) LDSHARED=${LDSHARED-"$cc -shared"} ;; esac @@ -334,7 +324,61 @@ SHAREDLIBM=${SHAREDLIBM-"libz$shared_ext.$VER1"} echo >> configure.log +# define functions for testing compiler and library characteristics and logging the results + +cat > $test.c <<EOF +#error error +EOF +if ($CC -c $CFLAGS $test.c) 2>/dev/null; then + try() + { + show $* + test "`( $* ) 2>&1 | tee -a configure.log`" = "" + } + echo - using any output from compiler to indicate an error >> configure.log +else +try() +{ + show $* + ( $* ) >> configure.log 2>&1 + ret=$? + if test $ret -ne 0; then + echo "(exit code "$ret")" >> configure.log + fi + return $ret +} +fi + +tryboth() +{ + show $* + got=`( $* ) 2>&1` + ret=$? + printf %s "$got" >> configure.log + if test $ret -ne 0; then + return $ret + fi + test "$got" = "" +} + +cat > $test.c << EOF +int foo() { return 0; } +EOF +echo "Checking for obsessive-compulsive compiler options..." >> configure.log +if try $CC -c $CFLAGS $test.c; then + : +else + echo "Compiler error reporting is too harsh for $0 (perhaps remove -Werror)." | tee -a configure.log + leave 1 +fi + +echo >> configure.log + # see if shared library build supported +cat > $test.c <<EOF +extern int getchar(); +int hello() {return getchar();} +EOF if test $shared -eq 1; then echo Checking for shared library support... | tee -a configure.log # we must test in two steps (cc then ld), required at least on SunOS 4.x @@ -362,8 +406,6 @@ else TEST="all teststatic testshared" fi -echo >> configure.log - # check for underscores in external names for use by assembler code CPP=${CPP-"$CC -E"} case $CFLAGS in @@ -698,35 +740,6 @@ EOF fi fi -echo >> configure.log - -# find a four-byte unsiged integer type for crc calculations -cat > $test.c <<EOF -#include <stdio.h> -#define is32(n,t) for(n=1,k=0;n;n<<=1,k++);if(k==32){puts(t);return 0;} -int main() { - int k; - unsigned i; - unsigned long l; - unsigned short s; - is32(i, "unsigned") - is32(l, "unsigned long") - is32(s, "unsigned short") - return 1; -} -EOF -Z_U4="" -if try $CC $CFLAGS $test.c -o $test && Z_U4=`./$test` && test -n "$Z_U4"; then - sed < zconf.h "/#define Z_U4/s/\/\* \.\/configure may/#define Z_U4 $Z_U4 \/* .\/configure put the/" > zconf.temp.h - mv zconf.temp.h zconf.h - echo "Looking for a four-byte integer type... Found." | tee -a configure.log -else - echo "Looking for a four-byte integer type... Not found." | tee -a configure.log -fi - -# clean up files produced by running the compiler and linker -rm -f $test.[co] $test $test$shared_ext $test.gcno - # show the results in the log echo >> configure.log echo ALL = $ALL >> configure.log @@ -758,9 +771,6 @@ echo mandir = $mandir >> configure.log echo prefix = $prefix >> configure.log echo sharedlibdir = $sharedlibdir >> configure.log echo uname = $uname >> configure.log -echo -------------------- >> configure.log -echo >> configure.log -echo >> configure.log # udpate Makefile with the configure results sed < Makefile.in " @@ -816,3 +826,6 @@ sed < zlib.pc.in " " | sed -e " s/\@VERSION\@/$VER/g; " > zlib.pc + +# done +leave 0 diff --git a/compat/zlib/contrib/README.contrib b/compat/zlib/contrib/README.contrib index dd2285d..c66349b 100644 --- a/compat/zlib/contrib/README.contrib +++ b/compat/zlib/contrib/README.contrib @@ -75,3 +75,4 @@ untgz/ by Pedro A. Aranda Gutierrez <paag@tid.es> vstudio/ by Gilles Vollant <info@winimage.com> Building a minizip-enhanced zlib with Microsoft Visual Studio + Includes vc11 from kreuzerkrieg and vc12 from davispuh diff --git a/compat/zlib/contrib/blast/blast.c b/compat/zlib/contrib/blast/blast.c index 4ce697a..69ef0fe 100644 --- a/compat/zlib/contrib/blast/blast.c +++ b/compat/zlib/contrib/blast/blast.c @@ -1,7 +1,7 @@ /* blast.c - * Copyright (C) 2003 Mark Adler + * Copyright (C) 2003, 2012 Mark Adler * For conditions of distribution and use, see copyright notice in blast.h - * version 1.1, 16 Feb 2003 + * version 1.2, 24 Oct 2012 * * blast.c decompresses data compressed by the PKWare Compression Library. * This function provides functionality similar to the explode() function of @@ -22,6 +22,8 @@ * * 1.0 12 Feb 2003 - First version * 1.1 16 Feb 2003 - Fixed distance check for > 4 GB uncompressed data + * 1.2 24 Oct 2012 - Add note about using binary mode in stdio + * - Fix comparisons of differently signed integers */ #include <setjmp.h> /* for setjmp(), longjmp(), and jmp_buf */ @@ -279,7 +281,7 @@ local int decomp(struct state *s) int dict; /* log2(dictionary size) - 6 */ int symbol; /* decoded symbol, extra bits for distance */ int len; /* length for copy */ - int dist; /* distance for copy */ + unsigned dist; /* distance for copy */ int copy; /* copy counter */ unsigned char *from, *to; /* copy pointers */ static int virgin = 1; /* build tables once */ diff --git a/compat/zlib/contrib/blast/blast.h b/compat/zlib/contrib/blast/blast.h index ce9e541..658cfd3 100644 --- a/compat/zlib/contrib/blast/blast.h +++ b/compat/zlib/contrib/blast/blast.h @@ -1,6 +1,6 @@ /* blast.h -- interface for blast.c - Copyright (C) 2003 Mark Adler - version 1.1, 16 Feb 2003 + Copyright (C) 2003, 2012 Mark Adler + version 1.2, 24 Oct 2012 This software is provided 'as-is', without any express or implied warranty. In no event will the author be held liable for any damages @@ -28,6 +28,10 @@ * that library. (Note: PKWare overused the "implode" verb, and the format * used by their library implode() function is completely different and * incompatible with the implode compression method supported by PKZIP.) + * + * The binary mode for stdio functions should be used to assure that the + * compressed data is not corrupted when read or written. For example: + * fopen(..., "rb") and fopen(..., "wb"). */ diff --git a/compat/zlib/contrib/delphi/ZLib.pas b/compat/zlib/contrib/delphi/ZLib.pas index f24bb3e..a579974 100644 --- a/compat/zlib/contrib/delphi/ZLib.pas +++ b/compat/zlib/contrib/delphi/ZLib.pas @@ -152,7 +152,7 @@ procedure DecompressToUserBuf(const InBuf: Pointer; InBytes: Integer; const OutBuf: Pointer; BufSize: Integer); const - zlib_version = '1.2.7'; + zlib_version = '1.2.8'; type EZlibError = class(Exception); diff --git a/compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs b/compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs index 1090288..b273d54 100644 --- a/compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs +++ b/compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs @@ -1,5 +1,5 @@ //
-// © Copyright Henrik Ravn 2004
+// © Copyright Henrik Ravn 2004
//
// Use, modification and distribution are subject to the Boost Software License, Version 1.0.
// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
@@ -156,7 +156,7 @@ namespace DotZLibTests public void Info_Version()
{
Info info = new Info();
- Assert.AreEqual("1.2.7", Info.Version);
+ Assert.AreEqual("1.2.8", Info.Version);
Assert.AreEqual(32, info.SizeOfUInt);
Assert.AreEqual(32, info.SizeOfULong);
Assert.AreEqual(32, info.SizeOfPointer);
diff --git a/compat/zlib/contrib/infback9/infback9.c b/compat/zlib/contrib/infback9/infback9.c index 7bbe90c..05fb3e3 100644 --- a/compat/zlib/contrib/infback9/infback9.c +++ b/compat/zlib/contrib/infback9/infback9.c @@ -222,14 +222,13 @@ out_func out; void FAR *out_desc; { struct inflate_state FAR *state; - unsigned char FAR *next; /* next input */ + z_const unsigned char FAR *next; /* next input */ unsigned char FAR *put; /* next output */ unsigned have; /* available input */ unsigned long left; /* available output */ inflate_mode mode; /* current inflate mode */ int lastblock; /* true if processing last block */ int wrap; /* true if the window has wrapped */ - unsigned long write; /* window write index */ unsigned char FAR *window; /* allocated sliding window, if needed */ unsigned long hold; /* bit buffer */ unsigned bits; /* bits in bit buffer */ @@ -259,7 +258,6 @@ void FAR *out_desc; strm->msg = Z_NULL; mode = TYPE; lastblock = 0; - write = 0; wrap = 0; window = state->window; next = strm->next_in; diff --git a/compat/zlib/contrib/infback9/inftree9.c b/compat/zlib/contrib/infback9/inftree9.c index 5a0b328..4a73ad2 100644 --- a/compat/zlib/contrib/infback9/inftree9.c +++ b/compat/zlib/contrib/infback9/inftree9.c @@ -1,5 +1,5 @@ /* inftree9.c -- generate Huffman trees for efficient decoding - * Copyright (C) 1995-2012 Mark Adler + * Copyright (C) 1995-2013 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ @@ -9,7 +9,7 @@ #define MAXBITS 15 const char inflate9_copyright[] = - " inflate9 1.2.7 Copyright 1995-2012 Mark Adler "; + " inflate9 1.2.8 Copyright 1995-2013 Mark Adler "; /* If you use the zlib library in a product, an acknowledgment is welcome in the documentation of your product. If for some reason you cannot @@ -64,7 +64,7 @@ unsigned short FAR *work; static const unsigned short lext[31] = { /* Length codes 257..285 extra */ 128, 128, 128, 128, 128, 128, 128, 128, 129, 129, 129, 129, 130, 130, 130, 130, 131, 131, 131, 131, 132, 132, 132, 132, - 133, 133, 133, 133, 144, 78, 68}; + 133, 133, 133, 133, 144, 72, 78}; static const unsigned short dbase[32] = { /* Distance codes 0..31 base */ 1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193, 257, 385, 513, 769, 1025, 1537, 2049, 3073, diff --git a/compat/zlib/contrib/minizip/configure.ac b/compat/zlib/contrib/minizip/configure.ac index 6a9af21..827a4e0 100644 --- a/compat/zlib/contrib/minizip/configure.ac +++ b/compat/zlib/contrib/minizip/configure.ac @@ -1,7 +1,7 @@ # -*- Autoconf -*- # Process this file with autoconf to produce a configure script. -AC_INIT([minizip], [1.2.7], [bugzilla.redhat.com]) +AC_INIT([minizip], [1.2.8], [bugzilla.redhat.com]) AC_CONFIG_SRCDIR([minizip.c]) AM_INIT_AUTOMAKE([foreign]) LT_INIT diff --git a/compat/zlib/contrib/minizip/crypt.h b/compat/zlib/contrib/minizip/crypt.h index a01d08d..1e9e820 100644 --- a/compat/zlib/contrib/minizip/crypt.h +++ b/compat/zlib/contrib/minizip/crypt.h @@ -32,7 +32,7 @@ /*********************************************************************** * Return the next byte in the pseudo-random sequence */ -static int decrypt_byte(unsigned long* pkeys, const unsigned long* pcrc_32_tab) +static int decrypt_byte(unsigned long* pkeys, const z_crc_t* pcrc_32_tab) { unsigned temp; /* POTENTIAL BUG: temp*(temp^1) may overflow in an * unpredictable manner on 16-bit systems; not a problem @@ -45,7 +45,7 @@ static int decrypt_byte(unsigned long* pkeys, const unsigned long* pcrc_32_tab) /*********************************************************************** * Update the encryption keys with the next byte of plain text */ -static int update_keys(unsigned long* pkeys,const unsigned long* pcrc_32_tab,int c) +static int update_keys(unsigned long* pkeys,const z_crc_t* pcrc_32_tab,int c) { (*(pkeys+0)) = CRC32((*(pkeys+0)), c); (*(pkeys+1)) += (*(pkeys+0)) & 0xff; @@ -62,7 +62,7 @@ static int update_keys(unsigned long* pkeys,const unsigned long* pcrc_32_tab,int * Initialize the encryption keys and the random header according to * the given password. */ -static void init_keys(const char* passwd,unsigned long* pkeys,const unsigned long* pcrc_32_tab) +static void init_keys(const char* passwd,unsigned long* pkeys,const z_crc_t* pcrc_32_tab) { *(pkeys+0) = 305419896L; *(pkeys+1) = 591751049L; @@ -91,7 +91,7 @@ static int crypthead(const char* passwd, /* password string */ unsigned char* buf, /* where to write header */ int bufSize, unsigned long* pkeys, - const unsigned long* pcrc_32_tab, + const z_crc_t* pcrc_32_tab, unsigned long crcForCrypting) { int n; /* index in random header */ diff --git a/compat/zlib/contrib/minizip/iowin32.c b/compat/zlib/contrib/minizip/iowin32.c index 6a2a883..a46d96c 100644 --- a/compat/zlib/contrib/minizip/iowin32.c +++ b/compat/zlib/contrib/minizip/iowin32.c @@ -25,6 +25,13 @@ #define INVALID_SET_FILE_POINTER ((DWORD)-1) #endif + +#if defined(WINAPI_FAMILY_PARTITION) && (!(defined(IOWIN32_USING_WINRT_API))) +#if WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP) +#define IOWIN32_USING_WINRT_API 1 +#endif +#endif + voidpf ZCALLBACK win32_open_file_func OF((voidpf opaque, const char* filename, int mode)); uLong ZCALLBACK win32_read_file_func OF((voidpf opaque, voidpf stream, void* buf, uLong size)); uLong ZCALLBACK win32_write_file_func OF((voidpf opaque, voidpf stream, const void* buf, uLong size)); @@ -93,8 +100,22 @@ voidpf ZCALLBACK win32_open64_file_func (voidpf opaque,const void* filename,int win32_translate_open_mode(mode,&dwDesiredAccess,&dwCreationDisposition,&dwShareMode,&dwFlagsAndAttributes); +#ifdef IOWIN32_USING_WINRT_API +#ifdef UNICODE + if ((filename!=NULL) && (dwDesiredAccess != 0)) + hFile = CreateFile2((LPCTSTR)filename, dwDesiredAccess, dwShareMode, dwCreationDisposition, NULL); +#else + if ((filename!=NULL) && (dwDesiredAccess != 0)) + { + WCHAR filenameW[FILENAME_MAX + 0x200 + 1]; + MultiByteToWideChar(CP_ACP,0,(const char*)filename,-1,filenameW,FILENAME_MAX + 0x200); + hFile = CreateFile2(filenameW, dwDesiredAccess, dwShareMode, dwCreationDisposition, NULL); + } +#endif +#else if ((filename!=NULL) && (dwDesiredAccess != 0)) hFile = CreateFile((LPCTSTR)filename, dwDesiredAccess, dwShareMode, NULL, dwCreationDisposition, dwFlagsAndAttributes, NULL); +#endif return win32_build_iowin(hFile); } @@ -108,8 +129,17 @@ voidpf ZCALLBACK win32_open64_file_funcA (voidpf opaque,const void* filename,int win32_translate_open_mode(mode,&dwDesiredAccess,&dwCreationDisposition,&dwShareMode,&dwFlagsAndAttributes); +#ifdef IOWIN32_USING_WINRT_API + if ((filename!=NULL) && (dwDesiredAccess != 0)) + { + WCHAR filenameW[FILENAME_MAX + 0x200 + 1]; + MultiByteToWideChar(CP_ACP,0,(const char*)filename,-1,filenameW,FILENAME_MAX + 0x200); + hFile = CreateFile2(filenameW, dwDesiredAccess, dwShareMode, dwCreationDisposition, NULL); + } +#else if ((filename!=NULL) && (dwDesiredAccess != 0)) hFile = CreateFileA((LPCSTR)filename, dwDesiredAccess, dwShareMode, NULL, dwCreationDisposition, dwFlagsAndAttributes, NULL); +#endif return win32_build_iowin(hFile); } @@ -123,8 +153,13 @@ voidpf ZCALLBACK win32_open64_file_funcW (voidpf opaque,const void* filename,int win32_translate_open_mode(mode,&dwDesiredAccess,&dwCreationDisposition,&dwShareMode,&dwFlagsAndAttributes); +#ifdef IOWIN32_USING_WINRT_API + if ((filename!=NULL) && (dwDesiredAccess != 0)) + hFile = CreateFile2((LPCWSTR)filename, dwDesiredAccess, dwShareMode, dwCreationDisposition,NULL); +#else if ((filename!=NULL) && (dwDesiredAccess != 0)) hFile = CreateFileW((LPCWSTR)filename, dwDesiredAccess, dwShareMode, NULL, dwCreationDisposition, dwFlagsAndAttributes, NULL); +#endif return win32_build_iowin(hFile); } @@ -138,8 +173,22 @@ voidpf ZCALLBACK win32_open_file_func (voidpf opaque,const char* filename,int mo win32_translate_open_mode(mode,&dwDesiredAccess,&dwCreationDisposition,&dwShareMode,&dwFlagsAndAttributes); +#ifdef IOWIN32_USING_WINRT_API +#ifdef UNICODE + if ((filename!=NULL) && (dwDesiredAccess != 0)) + hFile = CreateFile2((LPCTSTR)filename, dwDesiredAccess, dwShareMode, dwCreationDisposition, NULL); +#else + if ((filename!=NULL) && (dwDesiredAccess != 0)) + { + WCHAR filenameW[FILENAME_MAX + 0x200 + 1]; + MultiByteToWideChar(CP_ACP,0,(const char*)filename,-1,filenameW,FILENAME_MAX + 0x200); + hFile = CreateFile2(filenameW, dwDesiredAccess, dwShareMode, dwCreationDisposition, NULL); + } +#endif +#else if ((filename!=NULL) && (dwDesiredAccess != 0)) hFile = CreateFile((LPCTSTR)filename, dwDesiredAccess, dwShareMode, NULL, dwCreationDisposition, dwFlagsAndAttributes, NULL); +#endif return win32_build_iowin(hFile); } @@ -188,6 +237,26 @@ uLong ZCALLBACK win32_write_file_func (voidpf opaque,voidpf stream,const void* b return ret; } +static BOOL MySetFilePointerEx(HANDLE hFile, LARGE_INTEGER pos, LARGE_INTEGER *newPos, DWORD dwMoveMethod) +{ +#ifdef IOWIN32_USING_WINRT_API + return SetFilePointerEx(hFile, pos, newPos, dwMoveMethod); +#else + LONG lHigh = pos.HighPart; + DWORD dwNewPos = SetFilePointer(hFile, pos.LowPart, &lHigh, FILE_CURRENT); + BOOL fOk = TRUE; + if (dwNewPos == 0xFFFFFFFF) + if (GetLastError() != NO_ERROR) + fOk = FALSE; + if ((newPos != NULL) && (fOk)) + { + newPos->LowPart = dwNewPos; + newPos->HighPart = lHigh; + } + return fOk; +#endif +} + long ZCALLBACK win32_tell_file_func (voidpf opaque,voidpf stream) { long ret=-1; @@ -196,15 +265,17 @@ long ZCALLBACK win32_tell_file_func (voidpf opaque,voidpf stream) hFile = ((WIN32FILE_IOWIN*)stream) -> hf; if (hFile != NULL) { - DWORD dwSet = SetFilePointer(hFile, 0, NULL, FILE_CURRENT); - if (dwSet == INVALID_SET_FILE_POINTER) + LARGE_INTEGER pos; + pos.QuadPart = 0; + + if (!MySetFilePointerEx(hFile, pos, &pos, FILE_CURRENT)) { DWORD dwErr = GetLastError(); ((WIN32FILE_IOWIN*)stream) -> error=(int)dwErr; ret = -1; } else - ret=(long)dwSet; + ret=(long)pos.LowPart; } return ret; } @@ -218,17 +289,17 @@ ZPOS64_T ZCALLBACK win32_tell64_file_func (voidpf opaque, voidpf stream) if (hFile) { - LARGE_INTEGER li; - li.QuadPart = 0; - li.u.LowPart = SetFilePointer(hFile, li.u.LowPart, &li.u.HighPart, FILE_CURRENT); - if ( (li.LowPart == 0xFFFFFFFF) && (GetLastError() != NO_ERROR)) + LARGE_INTEGER pos; + pos.QuadPart = 0; + + if (!MySetFilePointerEx(hFile, pos, &pos, FILE_CURRENT)) { DWORD dwErr = GetLastError(); ((WIN32FILE_IOWIN*)stream) -> error=(int)dwErr; ret = (ZPOS64_T)-1; } else - ret=li.QuadPart; + ret=pos.QuadPart; } return ret; } @@ -258,8 +329,9 @@ long ZCALLBACK win32_seek_file_func (voidpf opaque,voidpf stream,uLong offset,in if (hFile != NULL) { - DWORD dwSet = SetFilePointer(hFile, offset, NULL, dwMoveMethod); - if (dwSet == INVALID_SET_FILE_POINTER) + LARGE_INTEGER pos; + pos.QuadPart = offset; + if (!MySetFilePointerEx(hFile, pos, NULL, dwMoveMethod)) { DWORD dwErr = GetLastError(); ((WIN32FILE_IOWIN*)stream) -> error=(int)dwErr; @@ -296,9 +368,9 @@ long ZCALLBACK win32_seek64_file_func (voidpf opaque, voidpf stream,ZPOS64_T off if (hFile) { - LARGE_INTEGER* li = (LARGE_INTEGER*)&offset; - DWORD dwSet = SetFilePointer(hFile, li->u.LowPart, &li->u.HighPart, dwMoveMethod); - if (dwSet == INVALID_SET_FILE_POINTER) + LARGE_INTEGER pos; + pos.QuadPart = offset; + if (!MySetFilePointerEx(hFile, pos, NULL, FILE_CURRENT)) { DWORD dwErr = GetLastError(); ((WIN32FILE_IOWIN*)stream) -> error=(int)dwErr; diff --git a/compat/zlib/contrib/minizip/miniunzip.1 b/compat/zlib/contrib/minizip/miniunzip.1 new file mode 100644 index 0000000..111ac69 --- /dev/null +++ b/compat/zlib/contrib/minizip/miniunzip.1 @@ -0,0 +1,63 @@ +.\" Hey, EMACS: -*- nroff -*- +.TH miniunzip 1 "Nov 7, 2001" +.\" Please adjust this date whenever revising the manpage. +.\" +.\" Some roff macros, for reference: +.\" .nh disable hyphenation +.\" .hy enable hyphenation +.\" .ad l left justify +.\" .ad b justify to both left and right margins +.\" .nf disable filling +.\" .fi enable filling +.\" .br insert line break +.\" .sp <n> insert n+1 empty lines +.\" for manpage-specific macros, see man(7) +.SH NAME +miniunzip - uncompress and examine ZIP archives +.SH SYNOPSIS +.B miniunzip +.RI [ -exvlo ] +zipfile [ files_to_extract ] [-d tempdir] +.SH DESCRIPTION +.B minizip +is a simple tool which allows the extraction of compressed file +archives in the ZIP format used by the MS-DOS utility PKZIP. It was +written as a demonstration of the +.IR zlib (3) +library and therefore lack many of the features of the +.IR unzip (1) +program. +.SH OPTIONS +A number of options are supported. With the exception of +.BI \-d\ tempdir +these must be supplied before any +other arguments and are: +.TP +.BI \-l\ ,\ \-\-v +List the files in the archive without extracting them. +.TP +.B \-o +Overwrite files without prompting for confirmation. +.TP +.B \-x +Extract files (default). +.PP +The +.I zipfile +argument is the name of the archive to process. The next argument can be used +to specify a single file to extract from the archive. + +Lastly, the following option can be specified at the end of the command-line: +.TP +.BI \-d\ tempdir +Extract the archive in the directory +.I tempdir +rather than the current directory. +.SH SEE ALSO +.BR minizip (1), +.BR zlib (3), +.BR unzip (1). +.SH AUTHOR +This program was written by Gilles Vollant. This manual page was +written by Mark Brown <broonie@sirena.org.uk>. The -d tempdir option +was added by Dirk Eddelbuettel <edd@debian.org>. diff --git a/compat/zlib/contrib/minizip/minizip.1 b/compat/zlib/contrib/minizip/minizip.1 new file mode 100644 index 0000000..1154484 --- /dev/null +++ b/compat/zlib/contrib/minizip/minizip.1 @@ -0,0 +1,46 @@ +.\" Hey, EMACS: -*- nroff -*- +.TH minizip 1 "May 2, 2001" +.\" Please adjust this date whenever revising the manpage. +.\" +.\" Some roff macros, for reference: +.\" .nh disable hyphenation +.\" .hy enable hyphenation +.\" .ad l left justify +.\" .ad b justify to both left and right margins +.\" .nf disable filling +.\" .fi enable filling +.\" .br insert line break +.\" .sp <n> insert n+1 empty lines +.\" for manpage-specific macros, see man(7) +.SH NAME +minizip - create ZIP archives +.SH SYNOPSIS +.B minizip +.RI [ -o ] +zipfile [ " files" ... ] +.SH DESCRIPTION +.B minizip +is a simple tool which allows the creation of compressed file archives +in the ZIP format used by the MS-DOS utility PKZIP. It was written as +a demonstration of the +.IR zlib (3) +library and therefore lack many of the features of the +.IR zip (1) +program. +.SH OPTIONS +The first argument supplied is the name of the ZIP archive to create or +.RI -o +in which case it is ignored and the second argument treated as the +name of the ZIP file. If the ZIP file already exists it will be +overwritten. +.PP +Subsequent arguments specify a list of files to place in the ZIP +archive. If none are specified then an empty archive will be created. +.SH SEE ALSO +.BR miniunzip (1), +.BR zlib (3), +.BR zip (1). +.SH AUTHOR +This program was written by Gilles Vollant. This manual page was +written by Mark Brown <broonie@sirena.org.uk>. + diff --git a/compat/zlib/contrib/minizip/unzip.c b/compat/zlib/contrib/minizip/unzip.c index affad4b..9093504 100644 --- a/compat/zlib/contrib/minizip/unzip.c +++ b/compat/zlib/contrib/minizip/unzip.c @@ -188,7 +188,7 @@ typedef struct # ifndef NOUNCRYPT unsigned long keys[3]; /* keys defining the pseudo-random sequence */ - const unsigned long* pcrc_32_tab; + const z_crc_t* pcrc_32_tab; # endif } unz64_s; @@ -801,9 +801,9 @@ extern unzFile ZEXPORT unzOpen64 (const void *path) } /* - Close a ZipFile opened with unzipOpen. - If there is files inside the .Zip opened with unzipOpenCurrentFile (see later), - these files MUST be closed with unzipCloseCurrentFile before call unzipClose. + Close a ZipFile opened with unzOpen. + If there is files inside the .Zip opened with unzOpenCurrentFile (see later), + these files MUST be closed with unzCloseCurrentFile before call unzClose. return UNZ_OK if there is no problem. */ extern int ZEXPORT unzClose (unzFile file) { @@ -1223,7 +1223,7 @@ extern int ZEXPORT unzGoToNextFile (unzFile file) /* Try locate the file szFileName in the zipfile. - For the iCaseSensitivity signification, see unzipStringFileNameCompare + For the iCaseSensitivity signification, see unzStringFileNameCompare return value : UNZ_OK if the file is found. It becomes the current file. @@ -1998,7 +1998,7 @@ extern int ZEXPORT unzGetLocalExtrafield (unzFile file, voidp buf, unsigned len) } /* - Close the file in zip opened with unzipOpenCurrentFile + Close the file in zip opened with unzOpenCurrentFile Return UNZ_CRCERROR if all the file was read but the CRC is not good */ extern int ZEXPORT unzCloseCurrentFile (unzFile file) diff --git a/compat/zlib/contrib/minizip/unzip.h b/compat/zlib/contrib/minizip/unzip.h index 3183968..2104e39 100644 --- a/compat/zlib/contrib/minizip/unzip.h +++ b/compat/zlib/contrib/minizip/unzip.h @@ -197,9 +197,9 @@ extern unzFile ZEXPORT unzOpen2_64 OF((const void *path, extern int ZEXPORT unzClose OF((unzFile file)); /* - Close a ZipFile opened with unzipOpen. + Close a ZipFile opened with unzOpen. If there is files inside the .Zip opened with unzOpenCurrentFile (see later), - these files MUST be closed with unzipCloseCurrentFile before call unzipClose. + these files MUST be closed with unzCloseCurrentFile before call unzClose. return UNZ_OK if there is no problem. */ extern int ZEXPORT unzGetGlobalInfo OF((unzFile file, diff --git a/compat/zlib/contrib/minizip/zip.c b/compat/zlib/contrib/minizip/zip.c index 147934c..ea54853 100644 --- a/compat/zlib/contrib/minizip/zip.c +++ b/compat/zlib/contrib/minizip/zip.c @@ -157,7 +157,7 @@ typedef struct ZPOS64_T totalUncompressedData; #ifndef NOCRYPT unsigned long keys[3]; /* keys defining the pseudo-random sequence */ - const unsigned long* pcrc_32_tab; + const z_crc_t* pcrc_32_tab; int crypt_header_size; #endif } curfile64_info; diff --git a/compat/zlib/contrib/pascal/zlibpas.pas b/compat/zlib/contrib/pascal/zlibpas.pas index 7abd862..e6a0782 100644 --- a/compat/zlib/contrib/pascal/zlibpas.pas +++ b/compat/zlib/contrib/pascal/zlibpas.pas @@ -10,8 +10,8 @@ unit zlibpas; interface const - ZLIB_VERSION = '1.2.7'; - ZLIB_VERNUM = $1270; + ZLIB_VERSION = '1.2.8'; + ZLIB_VERNUM = $1280; type alloc_func = function(opaque: Pointer; items, size: Integer): Pointer; diff --git a/compat/zlib/contrib/puff/puff.c b/compat/zlib/contrib/puff/puff.c index df8470c..ba58483 100644 --- a/compat/zlib/contrib/puff/puff.c +++ b/compat/zlib/contrib/puff/puff.c @@ -1,8 +1,8 @@ /* * puff.c - * Copyright (C) 2002-2010 Mark Adler + * Copyright (C) 2002-2013 Mark Adler * For conditions of distribution and use, see copyright notice in puff.h - * version 2.2, 25 Apr 2010 + * version 2.3, 21 Jan 2013 * * puff.c is a simple inflate written to be an unambiguous way to specify the * deflate format. It is not written for speed but rather simplicity. As a @@ -76,6 +76,7 @@ * - Move NIL to puff.h * - Allow incomplete code only if single code length is 1 * - Add full code coverage test to Makefile + * 2.3 21 Jan 2013 - Check for invalid code length codes in dynamic blocks */ #include <setjmp.h> /* for setjmp(), longjmp(), and jmp_buf */ @@ -704,6 +705,8 @@ local int dynamic(struct state *s) int len; /* last length to repeat */ symbol = decode(s, &lencode); + if (symbol < 0) + return symbol; /* invalid symbol */ if (symbol < 16) /* length in 0..15 */ lengths[index++] = symbol; else { /* repeat instruction */ diff --git a/compat/zlib/contrib/puff/puff.h b/compat/zlib/contrib/puff/puff.h index 6a0080a..e23a245 100644 --- a/compat/zlib/contrib/puff/puff.h +++ b/compat/zlib/contrib/puff/puff.h @@ -1,6 +1,6 @@ /* puff.h - Copyright (C) 2002-2010 Mark Adler, all rights reserved - version 2.2, 25 Apr 2010 + Copyright (C) 2002-2013 Mark Adler, all rights reserved + version 2.3, 21 Jan 2013 This software is provided 'as-is', without any express or implied warranty. In no event will the author be held liable for any damages diff --git a/compat/zlib/contrib/puff/pufftest.c b/compat/zlib/contrib/puff/pufftest.c index 76e35f6..7764814 100644 --- a/compat/zlib/contrib/puff/pufftest.c +++ b/compat/zlib/contrib/puff/pufftest.c @@ -1,8 +1,8 @@ /* * pufftest.c - * Copyright (C) 2002-2010 Mark Adler + * Copyright (C) 2002-2013 Mark Adler * For conditions of distribution and use, see copyright notice in puff.h - * version 2.2, 25 Apr 2010 + * version 2.3, 21 Jan 2013 */ /* Example of how to use puff(). diff --git a/compat/zlib/contrib/testzlib/testzlib.c b/compat/zlib/contrib/testzlib/testzlib.c index 135888e..5f659de 100644 --- a/compat/zlib/contrib/testzlib/testzlib.c +++ b/compat/zlib/contrib/testzlib/testzlib.c @@ -116,10 +116,10 @@ DWORD GetMsecSincePerfCounter(LARGE_INTEGER beginTime64,BOOL fComputeTimeQueryPe return dwRet;
}
-int ReadFileMemory(const char* filename,long* plFileSize,void** pFilePtr)
+int ReadFileMemory(const char* filename,long* plFileSize,unsigned char** pFilePtr)
{
FILE* stream;
- void* ptr;
+ unsigned char* ptr;
int retVal=1;
stream=fopen(filename, "rb");
if (stream==NULL)
diff --git a/compat/zlib/contrib/vstudio/readme.txt b/compat/zlib/contrib/vstudio/readme.txt index 59c8b8b..bfdcd9d 100644 --- a/compat/zlib/contrib/vstudio/readme.txt +++ b/compat/zlib/contrib/vstudio/readme.txt @@ -1,4 +1,4 @@ -Building instructions for the DLL versions of Zlib 1.2.7
+Building instructions for the DLL versions of Zlib 1.2.8
========================================================
This directory contains projects that build zlib and minizip using
@@ -28,6 +28,11 @@ Build instructions for Visual Studio 2010 (32 bits or 64 bits) - Uncompress current zlib, including all contrib/* files
- Open contrib\vstudio\vc10\zlibvc.sln with Microsoft Visual C++ 2010
+Build instructions for Visual Studio 2012 (32 bits or 64 bits)
+--------------------------------------------------------------
+- Uncompress current zlib, including all contrib/* files
+- Open contrib\vstudio\vc11\zlibvc.sln with Microsoft Visual C++ 2012
+
Important
---------
diff --git a/compat/zlib/contrib/vstudio/vc10/miniunz.vcxproj.user b/compat/zlib/contrib/vstudio/vc10/miniunz.vcxproj.user deleted file mode 100644 index 695b5c7..0000000 --- a/compat/zlib/contrib/vstudio/vc10/miniunz.vcxproj.user +++ /dev/null @@ -1,3 +0,0 @@ -<?xml version="1.0" encoding="utf-8"?>
-<Project ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
-</Project>
\ No newline at end of file diff --git a/compat/zlib/contrib/vstudio/vc10/minizip.vcxproj.user b/compat/zlib/contrib/vstudio/vc10/minizip.vcxproj.user deleted file mode 100644 index 695b5c7..0000000 --- a/compat/zlib/contrib/vstudio/vc10/minizip.vcxproj.user +++ /dev/null @@ -1,3 +0,0 @@ -<?xml version="1.0" encoding="utf-8"?>
-<Project ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
-</Project>
\ No newline at end of file diff --git a/compat/zlib/contrib/vstudio/vc10/testzlib.vcxproj.user b/compat/zlib/contrib/vstudio/vc10/testzlib.vcxproj.user deleted file mode 100644 index 695b5c7..0000000 --- a/compat/zlib/contrib/vstudio/vc10/testzlib.vcxproj.user +++ /dev/null @@ -1,3 +0,0 @@ -<?xml version="1.0" encoding="utf-8"?>
-<Project ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
-</Project>
\ No newline at end of file diff --git a/compat/zlib/contrib/vstudio/vc10/testzlibdll.vcxproj.user b/compat/zlib/contrib/vstudio/vc10/testzlibdll.vcxproj.user deleted file mode 100644 index 695b5c7..0000000 --- a/compat/zlib/contrib/vstudio/vc10/testzlibdll.vcxproj.user +++ /dev/null @@ -1,3 +0,0 @@ -<?xml version="1.0" encoding="utf-8"?>
-<Project ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
-</Project>
\ No newline at end of file diff --git a/compat/zlib/contrib/vstudio/vc10/zlib.rc b/compat/zlib/contrib/vstudio/vc10/zlib.rc index 8eca4db..73f6476 100644 --- a/compat/zlib/contrib/vstudio/vc10/zlib.rc +++ b/compat/zlib/contrib/vstudio/vc10/zlib.rc @@ -2,8 +2,8 @@ #define IDR_VERSION1 1
IDR_VERSION1 VERSIONINFO MOVEABLE IMPURE LOADONCALL DISCARDABLE
- FILEVERSION 1.2.7,0
- PRODUCTVERSION 1.2.7,0
+ FILEVERSION 1,2,8,0
+ PRODUCTVERSION 1,2,8,0
FILEFLAGSMASK VS_FFI_FILEFLAGSMASK
FILEFLAGS 0
FILEOS VOS_DOS_WINDOWS32
@@ -17,12 +17,12 @@ BEGIN BEGIN
VALUE "FileDescription", "zlib data compression and ZIP file I/O library\0"
- VALUE "FileVersion", "1.2.7\0"
+ VALUE "FileVersion", "1.2.8\0"
VALUE "InternalName", "zlib\0"
- VALUE "OriginalFilename", "zlib.dll\0"
+ VALUE "OriginalFilename", "zlibwapi.dll\0"
VALUE "ProductName", "ZLib.DLL\0"
VALUE "Comments","DLL support by Alessandro Iacopetti & Gilles Vollant\0"
- VALUE "LegalCopyright", "(C) 1995-2012 Jean-loup Gailly & Mark Adler\0"
+ VALUE "LegalCopyright", "(C) 1995-2013 Jean-loup Gailly & Mark Adler\0"
END
END
BLOCK "VarFileInfo"
diff --git a/compat/zlib/contrib/vstudio/vc10/zlibstat.vcxproj b/compat/zlib/contrib/vstudio/vc10/zlibstat.vcxproj index 2682fca..b9f2bbe 100644 --- a/compat/zlib/contrib/vstudio/vc10/zlibstat.vcxproj +++ b/compat/zlib/contrib/vstudio/vc10/zlibstat.vcxproj @@ -182,6 +182,10 @@ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
<SuppressStartupBanner>true</SuppressStartupBanner>
</Lib>
+ <PreBuildEvent>
+ <Command>cd ..\..\masmx86
+bld_ml32.bat</Command>
+ </PreBuildEvent>
</ItemDefinitionGroup>
<ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
<ClCompile>
@@ -210,6 +214,10 @@ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
<SuppressStartupBanner>true</SuppressStartupBanner>
</Lib>
+ <PreBuildEvent>
+ <Command>cd ..\..\masmx86
+bld_ml32.bat</Command>
+ </PreBuildEvent>
</ItemDefinitionGroup>
<ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">
<ClCompile>
@@ -266,6 +274,10 @@ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
<SuppressStartupBanner>true</SuppressStartupBanner>
</Lib>
+ <PreBuildEvent>
+ <Command>cd ..\..\masmx64
+bld_ml64.bat</Command>
+ </PreBuildEvent>
</ItemDefinitionGroup>
<ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
<Midl>
@@ -326,6 +338,10 @@ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
<SuppressStartupBanner>true</SuppressStartupBanner>
</Lib>
+ <PreBuildEvent>
+ <Command>cd ..\..\masmx64
+bld_ml64.bat</Command>
+ </PreBuildEvent>
</ItemDefinitionGroup>
<ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
<Midl>
diff --git a/compat/zlib/contrib/vstudio/vc10/zlibstat.vcxproj.user b/compat/zlib/contrib/vstudio/vc10/zlibstat.vcxproj.user deleted file mode 100644 index 695b5c7..0000000 --- a/compat/zlib/contrib/vstudio/vc10/zlibstat.vcxproj.user +++ /dev/null @@ -1,3 +0,0 @@ -<?xml version="1.0" encoding="utf-8"?>
-<Project ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
-</Project>
\ No newline at end of file diff --git a/compat/zlib/contrib/vstudio/vc10/zlibvc.def b/compat/zlib/contrib/vstudio/vc10/zlibvc.def index 18ddf50..6367046 100644 --- a/compat/zlib/contrib/vstudio/vc10/zlibvc.def +++ b/compat/zlib/contrib/vstudio/vc10/zlibvc.def @@ -1,7 +1,7 @@ LIBRARY
; zlib data compression and ZIP file I/O library
-VERSION 1.2.7
+VERSION 1.2.8
EXPORTS
adler32 @1
@@ -134,6 +134,10 @@ EXPORTS gzgetc_ @161
inflateResetKeep @163
deflateResetKeep @164
- -; zlib1 v1.2.7 added: - gzopen_w @165 +
+; zlib1 v1.2.7 added:
+ gzopen_w @165
+
+; zlib1 v1.2.8 added:
+ inflateGetDictionary @166
+ gzvprintf @167
diff --git a/compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj b/compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj index 9218fdc..6ff9ddb 100644 --- a/compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj +++ b/compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj @@ -180,10 +180,10 @@ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
<CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
<CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
- <TargetName Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">zlibwapi</TargetName>
+ <TargetName Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">zlibwapid</TargetName>
<TargetName Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">zlibwapi</TargetName>
<TargetName Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">zlibwapi</TargetName>
- <TargetName Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">zlibwapi</TargetName>
+ <TargetName Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">zlibwapid</TargetName>
<TargetName Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">zlibwapi</TargetName>
<TargetName Condition="'$(Configuration)|$(Platform)'=='Release|x64'">zlibwapi</TargetName>
</PropertyGroup>
@@ -220,18 +220,14 @@ <Link>
<AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
<AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
- <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
<SuppressStartupBanner>true</SuppressStartupBanner>
<ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
<GenerateDebugInformation>true</GenerateDebugInformation>
- <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
<GenerateMapFile>true</GenerateMapFile>
- <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
<SubSystem>Windows</SubSystem>
<RandomizedBaseAddress>false</RandomizedBaseAddress>
<DataExecutionPrevention>
</DataExecutionPrevention>
- <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
</Link>
<PreBuildEvent>
<Command>cd ..\..\masmx86
@@ -272,18 +268,14 @@ bld_ml32.bat</Command> </ResourceCompile>
<Link>
<AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
- <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
<SuppressStartupBanner>true</SuppressStartupBanner>
<IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
<ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
- <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
<GenerateMapFile>true</GenerateMapFile>
- <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
<SubSystem>Windows</SubSystem>
<RandomizedBaseAddress>false</RandomizedBaseAddress>
<DataExecutionPrevention>
</DataExecutionPrevention>
- <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
</Link>
</ItemDefinitionGroup>
<ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
@@ -321,18 +313,14 @@ bld_ml32.bat</Command> <Link>
<AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
<AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
- <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
<SuppressStartupBanner>true</SuppressStartupBanner>
<IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
<ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
- <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
<GenerateMapFile>true</GenerateMapFile>
- <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
<SubSystem>Windows</SubSystem>
<RandomizedBaseAddress>false</RandomizedBaseAddress>
<DataExecutionPrevention>
</DataExecutionPrevention>
- <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
</Link>
<PreBuildEvent>
<Command>cd ..\..\masmx86
@@ -371,19 +359,15 @@ bld_ml32.bat</Command> </ResourceCompile>
<Link>
<AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
- <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
<SuppressStartupBanner>true</SuppressStartupBanner>
<ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
<GenerateDebugInformation>true</GenerateDebugInformation>
- <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
<GenerateMapFile>true</GenerateMapFile>
- <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
<SubSystem>Windows</SubSystem>
- <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
<TargetMachine>MachineX64</TargetMachine>
</Link>
<PreBuildEvent>
- <Command>cd ..\..\contrib\masmx64
+ <Command>cd ..\..\masmx64
bld_ml64.bat</Command>
</PreBuildEvent>
</ItemDefinitionGroup>
@@ -463,15 +447,11 @@ bld_ml64.bat</Command> <Culture>0x040c</Culture>
</ResourceCompile>
<Link>
- <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
<SuppressStartupBanner>true</SuppressStartupBanner>
<IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
<ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
- <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
<GenerateMapFile>true</GenerateMapFile>
- <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
<SubSystem>Windows</SubSystem>
- <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
<TargetMachine>MachineX64</TargetMachine>
</Link>
</ItemDefinitionGroup>
@@ -554,15 +534,11 @@ bld_ml64.bat</Command> </ResourceCompile>
<Link>
<AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
- <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
<SuppressStartupBanner>true</SuppressStartupBanner>
<IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
<ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
- <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
<GenerateMapFile>true</GenerateMapFile>
- <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
<SubSystem>Windows</SubSystem>
- <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
<TargetMachine>MachineX64</TargetMachine>
</Link>
<PreBuildEvent>
diff --git a/compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj.user b/compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj.user deleted file mode 100644 index 695b5c7..0000000 --- a/compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj.user +++ /dev/null @@ -1,3 +0,0 @@ -<?xml version="1.0" encoding="utf-8"?>
-<Project ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
-</Project>
\ No newline at end of file diff --git a/compat/zlib/contrib/vstudio/vc11/miniunz.vcxproj b/compat/zlib/contrib/vstudio/vc11/miniunz.vcxproj new file mode 100644 index 0000000..8f9f20b --- /dev/null +++ b/compat/zlib/contrib/vstudio/vc11/miniunz.vcxproj @@ -0,0 +1,314 @@ +<?xml version="1.0" encoding="utf-8"?>
+<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup Label="ProjectConfigurations">
+ <ProjectConfiguration Include="Debug|Itanium">
+ <Configuration>Debug</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|Win32">
+ <Configuration>Debug</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|x64">
+ <Configuration>Debug</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Itanium">
+ <Configuration>Release</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Win32">
+ <Configuration>Release</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|x64">
+ <Configuration>Release</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ </ItemGroup>
+ <PropertyGroup Label="Globals">
+ <ProjectGuid>{C52F9E7B-498A-42BE-8DB4-85A15694382A}</ProjectGuid>
+ <Keyword>Win32Proj</Keyword>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>Unicode</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
+ <ImportGroup Label="ExtensionSettings">
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <PropertyGroup Label="UserMacros" />
+ <PropertyGroup>
+ <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniUnzip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniUnzip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniUnzip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniUnzip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\MiniUnzip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\MiniUnzip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\MiniUnzip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\MiniUnzip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\MiniUnzip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\MiniUnzip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\MiniUnzip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\MiniUnzip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ </PropertyGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)miniunz.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)miniunz.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)miniunz.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)miniunz.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)miniunz.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)miniunz.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)miniunz.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)miniunz.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)miniunz.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\minizip\miniunz.c" />
+ </ItemGroup>
+ <ItemGroup>
+ <ProjectReference Include="zlibvc.vcxproj">
+ <Project>{8fd826f8-3739-44e6-8cc8-997122e53b8d}</Project>
+ </ProjectReference>
+ </ItemGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
+ <ImportGroup Label="ExtensionTargets">
+ </ImportGroup>
+</Project>
\ No newline at end of file diff --git a/compat/zlib/contrib/vstudio/vc11/minizip.vcxproj b/compat/zlib/contrib/vstudio/vc11/minizip.vcxproj new file mode 100644 index 0000000..c93d9e6 --- /dev/null +++ b/compat/zlib/contrib/vstudio/vc11/minizip.vcxproj @@ -0,0 +1,311 @@ +<?xml version="1.0" encoding="utf-8"?>
+<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup Label="ProjectConfigurations">
+ <ProjectConfiguration Include="Debug|Itanium">
+ <Configuration>Debug</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|Win32">
+ <Configuration>Debug</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|x64">
+ <Configuration>Debug</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Itanium">
+ <Configuration>Release</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Win32">
+ <Configuration>Release</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|x64">
+ <Configuration>Release</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ </ItemGroup>
+ <PropertyGroup Label="Globals">
+ <ProjectGuid>{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}</ProjectGuid>
+ <Keyword>Win32Proj</Keyword>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>Unicode</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
+ <ImportGroup Label="ExtensionSettings">
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <PropertyGroup Label="UserMacros" />
+ <PropertyGroup>
+ <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniZip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniZip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniZip$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniZip$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\$(Configuration)\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\$(Configuration)\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\$(Configuration)\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\$(Configuration)\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ </PropertyGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)minizip.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)minizip.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)minizip.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)minizip.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)minizip.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)minizip.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)minizip.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)minizip.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)minizip.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\minizip\minizip.c" />
+ </ItemGroup>
+ <ItemGroup>
+ <ProjectReference Include="zlibvc.vcxproj">
+ <Project>{8fd826f8-3739-44e6-8cc8-997122e53b8d}</Project>
+ </ProjectReference>
+ </ItemGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
+ <ImportGroup Label="ExtensionTargets">
+ </ImportGroup>
+</Project>
\ No newline at end of file diff --git a/compat/zlib/contrib/vstudio/vc11/testzlib.vcxproj b/compat/zlib/contrib/vstudio/vc11/testzlib.vcxproj new file mode 100644 index 0000000..6d55954 --- /dev/null +++ b/compat/zlib/contrib/vstudio/vc11/testzlib.vcxproj @@ -0,0 +1,426 @@ +<?xml version="1.0" encoding="utf-8"?>
+<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup Label="ProjectConfigurations">
+ <ProjectConfiguration Include="Debug|Itanium">
+ <Configuration>Debug</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|Win32">
+ <Configuration>Debug</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|x64">
+ <Configuration>Debug</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|Itanium">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|Win32">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|x64">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Itanium">
+ <Configuration>Release</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Win32">
+ <Configuration>Release</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|x64">
+ <Configuration>Release</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ </ItemGroup>
+ <PropertyGroup Label="Globals">
+ <ProjectGuid>{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}</ProjectGuid>
+ <RootNamespace>testzlib</RootNamespace>
+ <Keyword>Win32Proj</Keyword>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>Unicode</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
+ <ImportGroup Label="ExtensionSettings">
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <PropertyGroup Label="UserMacros" />
+ <PropertyGroup>
+ <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlib$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\TestZlib$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlib$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlib$(Configuration)\Tmp\</IntDir>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlib$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\TestZlib$(Configuration)\Tmp\</IntDir>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\TestZlib$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlib$(Configuration)\Tmp\</IntDir>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlib$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlib$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ </PropertyGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerOutput>AssemblyAndSourceCode</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
+ <ClCompile>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerOutput>AssemblyAndSourceCode</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">
+ <ClCompile>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>%(AdditionalDependencies)</AdditionalDependencies>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
+ <ClCompile>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <OutputFile>$(OutDir)testzlib.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\..\adler32.c" />
+ <ClCompile Include="..\..\..\compress.c" />
+ <ClCompile Include="..\..\..\crc32.c" />
+ <ClCompile Include="..\..\..\deflate.c" />
+ <ClCompile Include="..\..\..\infback.c" />
+ <ClCompile Include="..\..\masmx64\inffas8664.c">
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">true</ExcludedFromBuild>
+ </ClCompile>
+ <ClCompile Include="..\..\..\inffast.c" />
+ <ClCompile Include="..\..\..\inflate.c" />
+ <ClCompile Include="..\..\..\inftrees.c" />
+ <ClCompile Include="..\..\testzlib\testzlib.c" />
+ <ClCompile Include="..\..\..\trees.c" />
+ <ClCompile Include="..\..\..\uncompr.c" />
+ <ClCompile Include="..\..\..\zutil.c" />
+ </ItemGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
+ <ImportGroup Label="ExtensionTargets">
+ </ImportGroup>
+</Project>
\ No newline at end of file diff --git a/compat/zlib/contrib/vstudio/vc11/testzlibdll.vcxproj b/compat/zlib/contrib/vstudio/vc11/testzlibdll.vcxproj new file mode 100644 index 0000000..9f20c78 --- /dev/null +++ b/compat/zlib/contrib/vstudio/vc11/testzlibdll.vcxproj @@ -0,0 +1,314 @@ +<?xml version="1.0" encoding="utf-8"?>
+<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup Label="ProjectConfigurations">
+ <ProjectConfiguration Include="Debug|Itanium">
+ <Configuration>Debug</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|Win32">
+ <Configuration>Debug</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|x64">
+ <Configuration>Debug</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Itanium">
+ <Configuration>Release</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Win32">
+ <Configuration>Release</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|x64">
+ <Configuration>Release</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ </ItemGroup>
+ <PropertyGroup Label="Globals">
+ <ProjectGuid>{C52F9E7B-498A-42BE-8DB4-85A15694366A}</ProjectGuid>
+ <Keyword>Win32Proj</Keyword>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>Unicode</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
+ <ConfigurationType>Application</ConfigurationType>
+ <CharacterSet>MultiByte</CharacterSet>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
+ <ImportGroup Label="ExtensionSettings">
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <PropertyGroup Label="UserMacros" />
+ <PropertyGroup>
+ <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ </PropertyGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <TargetMachine>MachineX86</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MinimalRebuild>true</MinimalRebuild>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
+ <SubSystem>Console</SubSystem>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>MaxSpeed</Optimization>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <OmitFramePointers>true</OmitFramePointers>
+ <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <BasicRuntimeChecks>Default</BasicRuntimeChecks>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeader>
+ </PrecompiledHeader>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <WarningLevel>Level3</WarningLevel>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <Link>
+ <AdditionalDependencies>ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <SubSystem>Console</SubSystem>
+ <OptimizeReferences>true</OptimizeReferences>
+ <EnableCOMDATFolding>true</EnableCOMDATFolding>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\testzlib\testzlib.c" />
+ </ItemGroup>
+ <ItemGroup>
+ <ProjectReference Include="zlibvc.vcxproj">
+ <Project>{8fd826f8-3739-44e6-8cc8-997122e53b8d}</Project>
+ </ProjectReference>
+ </ItemGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
+ <ImportGroup Label="ExtensionTargets">
+ </ImportGroup>
+</Project>
\ No newline at end of file diff --git a/compat/zlib/contrib/vstudio/vc11/zlib.rc b/compat/zlib/contrib/vstudio/vc11/zlib.rc new file mode 100644 index 0000000..73f6476 --- /dev/null +++ b/compat/zlib/contrib/vstudio/vc11/zlib.rc @@ -0,0 +1,32 @@ +#include <windows.h>
+
+#define IDR_VERSION1 1
+IDR_VERSION1 VERSIONINFO MOVEABLE IMPURE LOADONCALL DISCARDABLE
+ FILEVERSION 1,2,8,0
+ PRODUCTVERSION 1,2,8,0
+ FILEFLAGSMASK VS_FFI_FILEFLAGSMASK
+ FILEFLAGS 0
+ FILEOS VOS_DOS_WINDOWS32
+ FILETYPE VFT_DLL
+ FILESUBTYPE 0 // not used
+BEGIN
+ BLOCK "StringFileInfo"
+ BEGIN
+ BLOCK "040904E4"
+ //language ID = U.S. English, char set = Windows, Multilingual
+
+ BEGIN
+ VALUE "FileDescription", "zlib data compression and ZIP file I/O library\0"
+ VALUE "FileVersion", "1.2.8\0"
+ VALUE "InternalName", "zlib\0"
+ VALUE "OriginalFilename", "zlibwapi.dll\0"
+ VALUE "ProductName", "ZLib.DLL\0"
+ VALUE "Comments","DLL support by Alessandro Iacopetti & Gilles Vollant\0"
+ VALUE "LegalCopyright", "(C) 1995-2013 Jean-loup Gailly & Mark Adler\0"
+ END
+ END
+ BLOCK "VarFileInfo"
+ BEGIN
+ VALUE "Translation", 0x0409, 1252
+ END
+END
diff --git a/compat/zlib/contrib/vstudio/vc11/zlibstat.vcxproj b/compat/zlib/contrib/vstudio/vc11/zlibstat.vcxproj new file mode 100644 index 0000000..806b76a --- /dev/null +++ b/compat/zlib/contrib/vstudio/vc11/zlibstat.vcxproj @@ -0,0 +1,464 @@ +<?xml version="1.0" encoding="utf-8"?>
+<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup Label="ProjectConfigurations">
+ <ProjectConfiguration Include="Debug|Itanium">
+ <Configuration>Debug</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|Win32">
+ <Configuration>Debug</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|x64">
+ <Configuration>Debug</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|Itanium">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|Win32">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|x64">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Itanium">
+ <Configuration>Release</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Win32">
+ <Configuration>Release</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|x64">
+ <Configuration>Release</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ </ItemGroup>
+ <PropertyGroup Label="Globals">
+ <ProjectGuid>{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}</ProjectGuid>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <PlatformToolset>v110</PlatformToolset>
+ <CharacterSet>Unicode</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
+ <ConfigurationType>StaticLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
+ <ImportGroup Label="ExtensionSettings">
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <PropertyGroup Label="UserMacros" />
+ <PropertyGroup>
+ <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibStat$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibStat$(Configuration)\Tmp\</IntDir>
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ </PropertyGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <DebugInformationFormat>OldStyle</DebugInformationFormat>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ASMV;ASMINF;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <DebugInformationFormat>OldStyle</DebugInformationFormat>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <DebugInformationFormat>OldStyle</DebugInformationFormat>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ASMV;ASMINF;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">
+ <Midl>
+ <TargetEnvironment>X64</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">
+ <Midl>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Lib>
+ <AdditionalOptions>/MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
+ <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </Lib>
+ </ItemDefinitionGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\..\adler32.c" />
+ <ClCompile Include="..\..\..\compress.c" />
+ <ClCompile Include="..\..\..\crc32.c" />
+ <ClCompile Include="..\..\..\deflate.c" />
+ <ClCompile Include="..\..\..\gzclose.c" />
+ <ClCompile Include="..\..\..\gzlib.c" />
+ <ClCompile Include="..\..\..\gzread.c" />
+ <ClCompile Include="..\..\..\gzwrite.c" />
+ <ClCompile Include="..\..\..\infback.c" />
+ <ClCompile Include="..\..\masmx64\inffas8664.c">
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">true</ExcludedFromBuild>
+ </ClCompile>
+ <ClCompile Include="..\..\..\inffast.c" />
+ <ClCompile Include="..\..\..\inflate.c" />
+ <ClCompile Include="..\..\..\inftrees.c" />
+ <ClCompile Include="..\..\minizip\ioapi.c" />
+ <ClCompile Include="..\..\..\trees.c" />
+ <ClCompile Include="..\..\..\uncompr.c" />
+ <ClCompile Include="..\..\minizip\unzip.c" />
+ <ClCompile Include="..\..\minizip\zip.c" />
+ <ClCompile Include="..\..\..\zutil.c" />
+ </ItemGroup>
+ <ItemGroup>
+ <ResourceCompile Include="zlib.rc" />
+ </ItemGroup>
+ <ItemGroup>
+ <None Include="zlibvc.def" />
+ </ItemGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
+ <ImportGroup Label="ExtensionTargets">
+ </ImportGroup>
+</Project>
\ No newline at end of file diff --git a/compat/zlib/contrib/vstudio/vc11/zlibvc.def b/compat/zlib/contrib/vstudio/vc11/zlibvc.def new file mode 100644 index 0000000..6367046 --- /dev/null +++ b/compat/zlib/contrib/vstudio/vc11/zlibvc.def @@ -0,0 +1,143 @@ +LIBRARY
+; zlib data compression and ZIP file I/O library
+
+VERSION 1.2.8
+
+EXPORTS
+ adler32 @1
+ compress @2
+ crc32 @3
+ deflate @4
+ deflateCopy @5
+ deflateEnd @6
+ deflateInit2_ @7
+ deflateInit_ @8
+ deflateParams @9
+ deflateReset @10
+ deflateSetDictionary @11
+ gzclose @12
+ gzdopen @13
+ gzerror @14
+ gzflush @15
+ gzopen @16
+ gzread @17
+ gzwrite @18
+ inflate @19
+ inflateEnd @20
+ inflateInit2_ @21
+ inflateInit_ @22
+ inflateReset @23
+ inflateSetDictionary @24
+ inflateSync @25
+ uncompress @26
+ zlibVersion @27
+ gzprintf @28
+ gzputc @29
+ gzgetc @30
+ gzseek @31
+ gzrewind @32
+ gztell @33
+ gzeof @34
+ gzsetparams @35
+ zError @36
+ inflateSyncPoint @37
+ get_crc_table @38
+ compress2 @39
+ gzputs @40
+ gzgets @41
+ inflateCopy @42
+ inflateBackInit_ @43
+ inflateBack @44
+ inflateBackEnd @45
+ compressBound @46
+ deflateBound @47
+ gzclearerr @48
+ gzungetc @49
+ zlibCompileFlags @50
+ deflatePrime @51
+ deflatePending @52
+
+ unzOpen @61
+ unzClose @62
+ unzGetGlobalInfo @63
+ unzGetCurrentFileInfo @64
+ unzGoToFirstFile @65
+ unzGoToNextFile @66
+ unzOpenCurrentFile @67
+ unzReadCurrentFile @68
+ unzOpenCurrentFile3 @69
+ unztell @70
+ unzeof @71
+ unzCloseCurrentFile @72
+ unzGetGlobalComment @73
+ unzStringFileNameCompare @74
+ unzLocateFile @75
+ unzGetLocalExtrafield @76
+ unzOpen2 @77
+ unzOpenCurrentFile2 @78
+ unzOpenCurrentFilePassword @79
+
+ zipOpen @80
+ zipOpenNewFileInZip @81
+ zipWriteInFileInZip @82
+ zipCloseFileInZip @83
+ zipClose @84
+ zipOpenNewFileInZip2 @86
+ zipCloseFileInZipRaw @87
+ zipOpen2 @88
+ zipOpenNewFileInZip3 @89
+
+ unzGetFilePos @100
+ unzGoToFilePos @101
+
+ fill_win32_filefunc @110
+
+; zlibwapi v1.2.4 added:
+ fill_win32_filefunc64 @111
+ fill_win32_filefunc64A @112
+ fill_win32_filefunc64W @113
+
+ unzOpen64 @120
+ unzOpen2_64 @121
+ unzGetGlobalInfo64 @122
+ unzGetCurrentFileInfo64 @124
+ unzGetCurrentFileZStreamPos64 @125
+ unztell64 @126
+ unzGetFilePos64 @127
+ unzGoToFilePos64 @128
+
+ zipOpen64 @130
+ zipOpen2_64 @131
+ zipOpenNewFileInZip64 @132
+ zipOpenNewFileInZip2_64 @133
+ zipOpenNewFileInZip3_64 @134
+ zipOpenNewFileInZip4_64 @135
+ zipCloseFileInZipRaw64 @136
+
+; zlib1 v1.2.4 added:
+ adler32_combine @140
+ crc32_combine @142
+ deflateSetHeader @144
+ deflateTune @145
+ gzbuffer @146
+ gzclose_r @147
+ gzclose_w @148
+ gzdirect @149
+ gzoffset @150
+ inflateGetHeader @156
+ inflateMark @157
+ inflatePrime @158
+ inflateReset2 @159
+ inflateUndermine @160
+
+; zlib1 v1.2.6 added:
+ gzgetc_ @161
+ inflateResetKeep @163
+ deflateResetKeep @164
+
+; zlib1 v1.2.7 added:
+ gzopen_w @165
+
+; zlib1 v1.2.8 added:
+ inflateGetDictionary @166
+ gzvprintf @167
diff --git a/compat/zlib/contrib/vstudio/vc11/zlibvc.sln b/compat/zlib/contrib/vstudio/vc11/zlibvc.sln new file mode 100644 index 0000000..9fcbafd --- /dev/null +++ b/compat/zlib/contrib/vstudio/vc11/zlibvc.sln @@ -0,0 +1,117 @@ +
+Microsoft Visual Studio Solution File, Format Version 12.00
+# Visual Studio 2012
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcxproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibstat", "zlibstat.vcxproj", "{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlib", "testzlib.vcxproj", "{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlibdll", "testzlibdll.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694366A}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "minizip", "minizip.vcxproj", "{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}"
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "miniunz", "miniunz.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694382A}"
+EndProject
+Global
+ GlobalSection(SolutionConfigurationPlatforms) = preSolution
+ Debug|Itanium = Debug|Itanium
+ Debug|Win32 = Debug|Win32
+ Debug|x64 = Debug|x64
+ Release|Itanium = Release|Itanium
+ Release|Win32 = Release|Win32
+ Release|x64 = Release|x64
+ ReleaseWithoutAsm|Itanium = ReleaseWithoutAsm|Itanium
+ ReleaseWithoutAsm|Win32 = ReleaseWithoutAsm|Win32
+ ReleaseWithoutAsm|x64 = ReleaseWithoutAsm|x64
+ EndGlobalSection
+ GlobalSection(ProjectConfigurationPlatforms) = postSolution
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.ActiveCfg = Debug|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.Build.0 = Debug|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.ActiveCfg = Debug|x64
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.Build.0 = Debug|x64
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Itanium.ActiveCfg = Release|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.ActiveCfg = Release|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.Build.0 = Release|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.ActiveCfg = Release|x64
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.Build.0 = Release|x64
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
+ {8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.ActiveCfg = Debug|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.Build.0 = Debug|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.ActiveCfg = Debug|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.Build.0 = Debug|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Itanium.ActiveCfg = Release|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.ActiveCfg = Release|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.Build.0 = Release|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.ActiveCfg = Release|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.Build.0 = Release|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
+ {745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
+ {AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.ActiveCfg = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.Build.0 = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.ActiveCfg = Debug|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.Build.0 = Debug|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Itanium.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.Build.0 = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.ActiveCfg = Release|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.Build.0 = Release|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
+ {48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Itanium.ActiveCfg = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.ActiveCfg = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.Build.0 = Debug|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.ActiveCfg = Debug|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.Build.0 = Debug|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Itanium.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.Build.0 = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.ActiveCfg = Release|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.Build.0 = Release|x64
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
+ {C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
+ EndGlobalSection
+ GlobalSection(SolutionProperties) = preSolution
+ HideSolutionNode = FALSE
+ EndGlobalSection
+EndGlobal
diff --git a/compat/zlib/contrib/vstudio/vc11/zlibvc.vcxproj b/compat/zlib/contrib/vstudio/vc11/zlibvc.vcxproj new file mode 100644 index 0000000..c65b95f --- /dev/null +++ b/compat/zlib/contrib/vstudio/vc11/zlibvc.vcxproj @@ -0,0 +1,688 @@ +<?xml version="1.0" encoding="utf-8"?>
+<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <ItemGroup Label="ProjectConfigurations">
+ <ProjectConfiguration Include="Debug|Itanium">
+ <Configuration>Debug</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|Win32">
+ <Configuration>Debug</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Debug|x64">
+ <Configuration>Debug</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|Itanium">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|Win32">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="ReleaseWithoutAsm|x64">
+ <Configuration>ReleaseWithoutAsm</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Itanium">
+ <Configuration>Release</Configuration>
+ <Platform>Itanium</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|Win32">
+ <Configuration>Release</Configuration>
+ <Platform>Win32</Platform>
+ </ProjectConfiguration>
+ <ProjectConfiguration Include="Release|x64">
+ <Configuration>Release</Configuration>
+ <Platform>x64</Platform>
+ </ProjectConfiguration>
+ </ItemGroup>
+ <PropertyGroup Label="Globals">
+ <ProjectGuid>{8FD826F8-3739-44E6-8CC8-997122E53B8D}</ProjectGuid>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <PlatformToolset>v110</PlatformToolset>
+ <CharacterSet>Unicode</CharacterSet>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <WholeProgramOptimization>true</WholeProgramOptimization>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
+ <ConfigurationType>DynamicLibrary</ConfigurationType>
+ <UseOfMfc>false</UseOfMfc>
+ <PlatformToolset>v110</PlatformToolset>
+ </PropertyGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
+ <ImportGroup Label="ExtensionSettings">
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
+ <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
+ </ImportGroup>
+ <PropertyGroup Label="UserMacros" />
+ <PropertyGroup>
+ <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
+ <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibDll$(Configuration)\</OutDir>
+ <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibDll$(Configuration)\Tmp\</IntDir>
+ <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
+ <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
+ <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
+ <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
+ <TargetName Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">zlibwapi</TargetName>
+ <TargetName Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">zlibwapi</TargetName>
+ <TargetName Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">zlibwapi</TargetName>
+ <TargetName Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">zlibwapi</TargetName>
+ <TargetName Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">zlibwapi</TargetName>
+ <TargetName Condition="'$(Configuration)|$(Platform)'=='Release|x64'">zlibwapi</TargetName>
+ </PropertyGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
+ <Midl>
+ <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>Win32</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
+ <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
+ <SubSystem>Windows</SubSystem>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
+ </Link>
+ <PreBuildEvent>
+ <Command>cd ..\..\masmx86
+bld_ml32.bat</Command>
+ </PreBuildEvent>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">
+ <Midl>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>Win32</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerOutput>All</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
+ <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
+ <SubSystem>Windows</SubSystem>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
+ <Midl>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>Win32</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerOutput>All</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
+ <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
+ <SubSystem>Windows</SubSystem>
+ <RandomizedBaseAddress>false</RandomizedBaseAddress>
+ <DataExecutionPrevention>
+ </DataExecutionPrevention>
+ <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
+ </Link>
+ <PreBuildEvent>
+ <Command>cd ..\..\masmx86
+bld_ml32.bat</Command>
+ </PreBuildEvent>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
+ <Midl>
+ <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>X64</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
+ <SubSystem>Windows</SubSystem>
+ <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ <PreBuildEvent>
+ <Command>cd ..\..\contrib\masmx64
+bld_ml64.bat</Command>
+ </PreBuildEvent>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
+ <Midl>
+ <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <Optimization>Disabled</Optimization>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <GenerateDebugInformation>true</GenerateDebugInformation>
+ <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
+ <SubSystem>Windows</SubSystem>
+ <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">
+ <Midl>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>X64</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerOutput>All</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
+ <SubSystem>Windows</SubSystem>
+ <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">
+ <Midl>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerOutput>All</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
+ <SubSystem>Windows</SubSystem>
+ <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
+ <Midl>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>X64</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerOutput>All</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
+ <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
+ <SubSystem>Windows</SubSystem>
+ <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
+ <TargetMachine>MachineX64</TargetMachine>
+ </Link>
+ <PreBuildEvent>
+ <Command>cd ..\..\masmx64
+bld_ml64.bat</Command>
+ </PreBuildEvent>
+ </ItemDefinitionGroup>
+ <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
+ <Midl>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <MkTypLibCompatible>true</MkTypLibCompatible>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <TargetEnvironment>Itanium</TargetEnvironment>
+ <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
+ </Midl>
+ <ClCompile>
+ <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
+ <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <StringPooling>true</StringPooling>
+ <ExceptionHandling>
+ </ExceptionHandling>
+ <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
+ <BufferSecurityCheck>false</BufferSecurityCheck>
+ <FunctionLevelLinking>true</FunctionLevelLinking>
+ <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
+ <AssemblerOutput>All</AssemblerOutput>
+ <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
+ <ObjectFileName>$(IntDir)</ObjectFileName>
+ <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
+ <BrowseInformation>
+ </BrowseInformation>
+ <WarningLevel>Level3</WarningLevel>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ </ClCompile>
+ <ResourceCompile>
+ <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <Culture>0x040c</Culture>
+ </ResourceCompile>
+ <Link>
+ <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
+ <SuppressStartupBanner>true</SuppressStartupBanner>
+ <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
+ <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
+ <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
+ <GenerateMapFile>true</GenerateMapFile>
+ <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
+ <SubSystem>Windows</SubSystem>
+ <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
+ <TargetMachine>MachineIA64</TargetMachine>
+ </Link>
+ </ItemDefinitionGroup>
+ <ItemGroup>
+ <ClCompile Include="..\..\..\adler32.c" />
+ <ClCompile Include="..\..\..\compress.c" />
+ <ClCompile Include="..\..\..\crc32.c" />
+ <ClCompile Include="..\..\..\deflate.c" />
+ <ClCompile Include="..\..\..\gzclose.c" />
+ <ClCompile Include="..\..\..\gzlib.c" />
+ <ClCompile Include="..\..\..\gzread.c" />
+ <ClCompile Include="..\..\..\gzwrite.c" />
+ <ClCompile Include="..\..\..\infback.c" />
+ <ClCompile Include="..\..\masmx64\inffas8664.c">
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">true</ExcludedFromBuild>
+ <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">true</ExcludedFromBuild>
+ </ClCompile>
+ <ClCompile Include="..\..\..\inffast.c" />
+ <ClCompile Include="..\..\..\inflate.c" />
+ <ClCompile Include="..\..\..\inftrees.c" />
+ <ClCompile Include="..\..\minizip\ioapi.c" />
+ <ClCompile Include="..\..\minizip\iowin32.c" />
+ <ClCompile Include="..\..\..\trees.c" />
+ <ClCompile Include="..\..\..\uncompr.c" />
+ <ClCompile Include="..\..\minizip\unzip.c">
+ <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|x64'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|x64'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ </ClCompile>
+ <ClCompile Include="..\..\minizip\zip.c">
+ <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|x64'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
+ <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|x64'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
+ </ClCompile>
+ <ClCompile Include="..\..\..\zutil.c" />
+ </ItemGroup>
+ <ItemGroup>
+ <ResourceCompile Include="zlib.rc" />
+ </ItemGroup>
+ <ItemGroup>
+ <None Include="zlibvc.def" />
+ </ItemGroup>
+ <ItemGroup>
+ <ClInclude Include="..\..\..\deflate.h" />
+ <ClInclude Include="..\..\..\infblock.h" />
+ <ClInclude Include="..\..\..\infcodes.h" />
+ <ClInclude Include="..\..\..\inffast.h" />
+ <ClInclude Include="..\..\..\inftrees.h" />
+ <ClInclude Include="..\..\..\infutil.h" />
+ <ClInclude Include="..\..\..\zconf.h" />
+ <ClInclude Include="..\..\..\zlib.h" />
+ <ClInclude Include="..\..\..\zutil.h" />
+ </ItemGroup>
+ <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
+ <ImportGroup Label="ExtensionTargets">
+ </ImportGroup>
+</Project>
\ No newline at end of file diff --git a/compat/zlib/contrib/vstudio/vc9/zlib.rc b/compat/zlib/contrib/vstudio/vc9/zlib.rc index 8eca4db..73f6476 100644 --- a/compat/zlib/contrib/vstudio/vc9/zlib.rc +++ b/compat/zlib/contrib/vstudio/vc9/zlib.rc @@ -2,8 +2,8 @@ #define IDR_VERSION1 1
IDR_VERSION1 VERSIONINFO MOVEABLE IMPURE LOADONCALL DISCARDABLE
- FILEVERSION 1.2.7,0
- PRODUCTVERSION 1.2.7,0
+ FILEVERSION 1,2,8,0
+ PRODUCTVERSION 1,2,8,0
FILEFLAGSMASK VS_FFI_FILEFLAGSMASK
FILEFLAGS 0
FILEOS VOS_DOS_WINDOWS32
@@ -17,12 +17,12 @@ BEGIN BEGIN
VALUE "FileDescription", "zlib data compression and ZIP file I/O library\0"
- VALUE "FileVersion", "1.2.7\0"
+ VALUE "FileVersion", "1.2.8\0"
VALUE "InternalName", "zlib\0"
- VALUE "OriginalFilename", "zlib.dll\0"
+ VALUE "OriginalFilename", "zlibwapi.dll\0"
VALUE "ProductName", "ZLib.DLL\0"
VALUE "Comments","DLL support by Alessandro Iacopetti & Gilles Vollant\0"
- VALUE "LegalCopyright", "(C) 1995-2012 Jean-loup Gailly & Mark Adler\0"
+ VALUE "LegalCopyright", "(C) 1995-2013 Jean-loup Gailly & Mark Adler\0"
END
END
BLOCK "VarFileInfo"
diff --git a/compat/zlib/contrib/vstudio/vc9/zlibvc.def b/compat/zlib/contrib/vstudio/vc9/zlibvc.def index 2df8bb3..6367046 100644 --- a/compat/zlib/contrib/vstudio/vc9/zlibvc.def +++ b/compat/zlib/contrib/vstudio/vc9/zlibvc.def @@ -1,7 +1,7 @@ LIBRARY
; zlib data compression and ZIP file I/O library
-VERSION 1.2.7
+VERSION 1.2.8
EXPORTS
adler32 @1
@@ -133,7 +133,11 @@ EXPORTS ; zlib1 v1.2.6 added:
gzgetc_ @161
inflateResetKeep @163
- deflateResetKeep @164 - -; zlib1 v1.2.7 added: - gzopen_w @165 + deflateResetKeep @164
+
+; zlib1 v1.2.7 added:
+ gzopen_w @165
+
+; zlib1 v1.2.8 added:
+ inflateGetDictionary @166
+ gzvprintf @167
diff --git a/compat/zlib/deflate.c b/compat/zlib/deflate.c index 9e4c2cb..6969577 100644 --- a/compat/zlib/deflate.c +++ b/compat/zlib/deflate.c @@ -1,5 +1,5 @@ /* deflate.c -- compress data using the deflation algorithm - * Copyright (C) 1995-2012 Jean-loup Gailly and Mark Adler + * Copyright (C) 1995-2013 Jean-loup Gailly and Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ @@ -52,7 +52,7 @@ #include "deflate.h" const char deflate_copyright[] = - " deflate 1.2.7 Copyright 1995-2012 Jean-loup Gailly and Mark Adler "; + " deflate 1.2.8 Copyright 1995-2013 Jean-loup Gailly and Mark Adler "; /* If you use the zlib library in a product, an acknowledgment is welcome in the documentation of your product. If for some reason you cannot @@ -305,7 +305,7 @@ int ZEXPORT deflateInit2_(strm, level, method, windowBits, memLevel, strategy, if (s->window == Z_NULL || s->prev == Z_NULL || s->head == Z_NULL || s->pending_buf == Z_NULL) { s->status = FINISH_STATE; - strm->msg = (char*)ERR_MSG(Z_MEM_ERROR); + strm->msg = ERR_MSG(Z_MEM_ERROR); deflateEnd (strm); return Z_MEM_ERROR; } @@ -329,7 +329,7 @@ int ZEXPORT deflateSetDictionary (strm, dictionary, dictLength) uInt str, n; int wrap; unsigned avail; - unsigned char *next; + z_const unsigned char *next; if (strm == Z_NULL || strm->state == Z_NULL || dictionary == Z_NULL) return Z_STREAM_ERROR; @@ -359,7 +359,7 @@ int ZEXPORT deflateSetDictionary (strm, dictionary, dictLength) avail = strm->avail_in; next = strm->next_in; strm->avail_in = dictLength; - strm->next_in = (Bytef *)dictionary; + strm->next_in = (z_const Bytef *)dictionary; fill_window(s); while (s->lookahead >= MIN_MATCH) { str = s->strstart; @@ -513,6 +513,8 @@ int ZEXPORT deflateParams(strm, level, strategy) strm->total_in != 0) { /* Flush the last buffer: */ err = deflate(strm, Z_BLOCK); + if (err == Z_BUF_ERROR && s->pending == 0) + err = Z_OK; } if (s->level != level) { s->level = level; diff --git a/compat/zlib/deflate.h b/compat/zlib/deflate.h index fbac44d..ce0299e 100644 --- a/compat/zlib/deflate.h +++ b/compat/zlib/deflate.h @@ -104,7 +104,7 @@ typedef struct internal_state { int wrap; /* bit 0 true for zlib, bit 1 true for gzip */ gz_headerp gzhead; /* gzip header information to write */ uInt gzindex; /* where in extra, name, or comment */ - Byte method; /* STORED (for zip only) or DEFLATED */ + Byte method; /* can only be DEFLATED */ int last_flush; /* value of flush param for previous deflate call */ /* used by deflate.c: */ diff --git a/compat/zlib/examples/enough.c b/compat/zlib/examples/enough.c index c40410b..b991144 100644 --- a/compat/zlib/examples/enough.c +++ b/compat/zlib/examples/enough.c @@ -1,7 +1,7 @@ /* enough.c -- determine the maximum size of inflate's Huffman code tables over * all possible valid and complete Huffman codes, subject to a length limit. - * Copyright (C) 2007, 2008 Mark Adler - * Version 1.3 17 February 2008 Mark Adler + * Copyright (C) 2007, 2008, 2012 Mark Adler + * Version 1.4 18 August 2012 Mark Adler */ /* Version history: @@ -14,6 +14,9 @@ 1.3 17 Feb 2008 Add argument for initial root table size Fix bug for initial root table size == max - 1 Use a macro to compute the history index + 1.4 18 Aug 2012 Avoid shifts more than bits in type (caused endless loop!) + Clean up comparisons of different types + Clean up code indentation */ /* @@ -236,8 +239,8 @@ local big_t count(int syms, int len, int left) for (use = least; use <= most; use++) { got = count(syms - use, len + 1, (left - use) << 1); sum += got; - if (got == -1 || sum < got) /* overflow */ - return -1; + if (got == (big_t)0 - 1 || sum < got) /* overflow */ + return (big_t)0 - 1; } /* verify that all recursive calls are productive */ @@ -458,6 +461,7 @@ int main(int argc, char **argv) int n; /* number of symbols to code for this run */ big_t got; /* return value of count() */ big_t sum; /* accumulated number of codes over n */ + code_t word; /* for counting bits in code_t */ /* set up globals for cleanup() */ code = NULL; @@ -466,19 +470,19 @@ int main(int argc, char **argv) /* get arguments -- default to the deflate literal/length code */ syms = 286; - root = 9; + root = 9; max = 15; if (argc > 1) { syms = atoi(argv[1]); if (argc > 2) { root = atoi(argv[2]); - if (argc > 3) - max = atoi(argv[3]); - } + if (argc > 3) + max = atoi(argv[3]); + } } if (argc > 4 || syms < 2 || root < 1 || max < 1) { fputs("invalid arguments, need: [sym >= 2 [root >= 1 [max >= 1]]]\n", - stderr); + stderr); return 1; } @@ -487,18 +491,17 @@ int main(int argc, char **argv) max = syms - 1; /* determine the number of bits in a code_t */ - n = 0; - while (((code_t)1 << n) != 0) - n++; + for (n = 0, word = 1; word; n++, word <<= 1) + ; /* make sure that the calculation of most will not overflow */ - if (max > n || syms - 2 >= (((code_t)0 - 1) >> (max - 1))) { + if (max > n || (code_t)(syms - 2) >= (((code_t)0 - 1) >> (max - 1))) { fputs("abort: code length too long for internal types\n", stderr); return 1; } /* reject impossible code requests */ - if (syms - 1 > ((code_t)1 << max) - 1) { + if ((code_t)(syms - 1) > ((code_t)1 << max) - 1) { fprintf(stderr, "%d symbols cannot be coded in %d bits\n", syms, max); return 1; @@ -532,7 +535,7 @@ int main(int argc, char **argv) for (n = 2; n <= syms; n++) { got = count(n, 1, 2); sum += got; - if (got == -1 || sum < got) { /* overflow */ + if (got == (big_t)0 - 1 || sum < got) { /* overflow */ fputs("abort: can't count that high!\n", stderr); cleanup(); return 1; @@ -556,9 +559,9 @@ int main(int argc, char **argv) } /* find and show maximum inflate table usage */ - if (root > max) /* reduce root to max length */ - root = max; - if (syms < ((code_t)1 << (root + 1))) + if (root > max) /* reduce root to max length */ + root = max; + if ((code_t)syms < ((code_t)1 << (root + 1))) enough(syms); else puts("cannot handle minimum code lengths > root"); diff --git a/compat/zlib/examples/gun.c b/compat/zlib/examples/gun.c index 72b0882..89e484f 100644 --- a/compat/zlib/examples/gun.c +++ b/compat/zlib/examples/gun.c @@ -1,7 +1,7 @@ /* gun.c -- simple gunzip to give an example of the use of inflateBack() - * Copyright (C) 2003, 2005, 2008, 2010 Mark Adler + * Copyright (C) 2003, 2005, 2008, 2010, 2012 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h - Version 1.6 17 January 2010 Mark Adler */ + Version 1.7 12 August 2012 Mark Adler */ /* Version history: 1.0 16 Feb 2003 First version for testing of inflateBack() @@ -18,6 +18,7 @@ 1.4 8 Dec 2006 LZW decompression speed improvements 1.5 9 Feb 2008 Avoid warning in latest version of gcc 1.6 17 Jan 2010 Avoid signed/unsigned comparison warnings + 1.7 12 Aug 2012 Update for z_const usage in zlib 1.2.8 */ /* @@ -85,7 +86,7 @@ struct ind { /* Load input buffer, assumed to be empty, and return bytes loaded and a pointer to them. read() is called until the buffer is full, or until it returns end-of-file or error. Return 0 on error. */ -local unsigned in(void *in_desc, unsigned char **buf) +local unsigned in(void *in_desc, z_const unsigned char **buf) { int ret; unsigned len; @@ -196,7 +197,7 @@ unsigned char match[65280 + 2]; /* buffer for reversed match or gzip file, read error, or write error (a write error indicated by strm->next_in not equal to Z_NULL), or Z_DATA_ERROR for invalid input. */ -local int lunpipe(unsigned have, unsigned char *next, struct ind *indp, +local int lunpipe(unsigned have, z_const unsigned char *next, struct ind *indp, int outfile, z_stream *strm) { int last; /* last byte read by NEXT(), or -1 if EOF */ @@ -383,7 +384,7 @@ local int gunpipe(z_stream *strm, int infile, int outfile) { int ret, first, last; unsigned have, flags, len; - unsigned char *next = NULL; + z_const unsigned char *next = NULL; struct ind ind, *indp; struct outd outd; diff --git a/compat/zlib/examples/gzappend.c b/compat/zlib/examples/gzappend.c index e9e878e..662dec3 100644 --- a/compat/zlib/examples/gzappend.c +++ b/compat/zlib/examples/gzappend.c @@ -1,7 +1,7 @@ /* gzappend -- command to append to a gzip file - Copyright (C) 2003 Mark Adler, all rights reserved - version 1.1, 4 Nov 2003 + Copyright (C) 2003, 2012 Mark Adler, all rights reserved + version 1.2, 11 Oct 2012 This software is provided 'as-is', without any express or implied warranty. In no event will the author be held liable for any damages @@ -39,6 +39,8 @@ * - Keep gzip file clean on appended file read errors * - Use in-place rotate instead of auxiliary buffer * (Why you ask? Because it was fun to write!) + * 1.2 11 Oct 2012 - Fix for proper z_const usage + * - Check for input buffer malloc failure */ /* @@ -170,7 +172,7 @@ typedef struct { int size; /* 1 << size is bytes in buf */ unsigned left; /* bytes available at next */ unsigned char *buf; /* buffer */ - unsigned char *next; /* next byte in buffer */ + z_const unsigned char *next; /* next byte in buffer */ char *name; /* file name for error messages */ } file; @@ -399,14 +401,14 @@ local void gztack(char *name, int gd, z_stream *strm, int last) } /* allocate buffers */ - in = fd == -1 ? NULL : malloc(CHUNK); + in = malloc(CHUNK); out = malloc(CHUNK); - if (out == NULL) bye("out of memory", ""); + if (in == NULL || out == NULL) bye("out of memory", ""); /* compress input file and append to gzip file */ do { /* get more input */ - len = fd == -1 ? 0 : read(fd, in, CHUNK); + len = read(fd, in, CHUNK); if (len == -1) { fprintf(stderr, "gzappend warning: error reading %s, skipping rest ...\n", @@ -453,7 +455,7 @@ local void gztack(char *name, int gd, z_stream *strm, int last) /* clean up and return */ free(out); - if (in != NULL) free(in); + free(in); if (fd > 0) close(fd); } @@ -467,11 +469,13 @@ int main(int argc, char **argv) z_stream strm; /* ignore command name */ - argv++; + argc--; argv++; /* provide usage if no arguments */ if (*argv == NULL) { - printf("gzappend 1.1 (4 Nov 2003) Copyright (C) 2003 Mark Adler\n"); + printf( + "gzappend 1.2 (11 Oct 2012) Copyright (C) 2003, 2012 Mark Adler\n" + ); printf( "usage: gzappend [-level] file.gz [ addthis [ andthis ... ]]\n"); return 0; diff --git a/compat/zlib/examples/gzjoin.c b/compat/zlib/examples/gzjoin.c index 129347c..89e8098 100644 --- a/compat/zlib/examples/gzjoin.c +++ b/compat/zlib/examples/gzjoin.c @@ -1,7 +1,7 @@ /* gzjoin -- command to join gzip files into one gzip file - Copyright (C) 2004 Mark Adler, all rights reserved - version 1.0, 11 Dec 2004 + Copyright (C) 2004, 2005, 2012 Mark Adler, all rights reserved + version 1.2, 14 Aug 2012 This software is provided 'as-is', without any express or implied warranty. In no event will the author be held liable for any damages @@ -27,6 +27,7 @@ * * 1.0 11 Dec 2004 - First version * 1.1 12 Jun 2005 - Changed ssize_t to long for portability + * 1.2 14 Aug 2012 - Clean up for z_const usage */ /* @@ -308,7 +309,7 @@ local void gzcopy(char *name, int clr, unsigned long *crc, unsigned long *tot, /* inflate and copy compressed data, clear last-block bit if requested */ len = 0; zpull(&strm, in); - start = strm.next_in; + start = in->next; last = start[0] & 1; if (last && clr) start[0] &= ~1; @@ -351,7 +352,7 @@ local void gzcopy(char *name, int clr, unsigned long *crc, unsigned long *tot, pos = 0x100 >> pos; last = strm.next_in[-1] & pos; if (last && clr) - strm.next_in[-1] &= ~pos; + in->buf[strm.next_in - in->buf - 1] &= ~pos; } else { /* next last-block bit is in next unused byte */ @@ -364,14 +365,14 @@ local void gzcopy(char *name, int clr, unsigned long *crc, unsigned long *tot, } last = strm.next_in[0] & 1; if (last && clr) - strm.next_in[0] &= ~1; + in->buf[strm.next_in - in->buf] &= ~1; } } } /* update buffer with unused input */ in->left = strm.avail_in; - in->next = strm.next_in; + in->next = in->buf + (strm.next_in - in->buf); /* copy used input, write empty blocks to get to byte boundary */ pos = strm.data_type & 7; diff --git a/compat/zlib/examples/gzlog.c b/compat/zlib/examples/gzlog.c index d70aaca..922f878 100644 --- a/compat/zlib/examples/gzlog.c +++ b/compat/zlib/examples/gzlog.c @@ -1,8 +1,8 @@ /* * gzlog.c - * Copyright (C) 2004, 2008 Mark Adler, all rights reserved + * Copyright (C) 2004, 2008, 2012 Mark Adler, all rights reserved * For conditions of distribution and use, see copyright notice in gzlog.h - * version 2.0, 25 Apr 2008 + * version 2.2, 14 Aug 2012 */ /* @@ -750,7 +750,8 @@ local int log_recover(struct log *log, int op) strcpy(log->end, ".add"); if (stat(log->path, &st) == 0 && st.st_size) { len = (size_t)(st.st_size); - if (len != st.st_size || (data = malloc(st.st_size)) == NULL) { + if ((off_t)len != st.st_size || + (data = malloc(st.st_size)) == NULL) { log_log(log, op, "allocation failure"); return -2; } @@ -758,7 +759,7 @@ local int log_recover(struct log *log, int op) log_log(log, op, ".add file read failure"); return -1; } - ret = read(fd, data, len) != len; + ret = (size_t)read(fd, data, len) != len; close(fd); if (ret) { log_log(log, op, ".add file read failure"); @@ -913,7 +914,7 @@ int gzlog_compress(gzlog *logd) struct log *log = logd; /* check arguments */ - if (log == NULL || strcmp(log->id, LOGID) || len < 0) + if (log == NULL || strcmp(log->id, LOGID)) return -3; /* see if we lost the lock -- if so get it again and reload the extra @@ -952,7 +953,7 @@ int gzlog_compress(gzlog *logd) fd = open(log->path, O_WRONLY | O_CREAT | O_TRUNC, 0644); if (fd < 0) break; - ret = write(fd, data, len) != len; + ret = (size_t)write(fd, data, len) != len; if (ret | close(fd)) break; log_touch(log); @@ -963,7 +964,7 @@ int gzlog_compress(gzlog *logd) if (fd < 0) break; next = DICT > len ? len : DICT; - ret = write(fd, (char *)data + len - next, next) != next; + ret = (size_t)write(fd, (char *)data + len - next, next) != next; if (ret | close(fd)) break; log_touch(log); @@ -997,9 +998,9 @@ int gzlog_write(gzlog *logd, void *data, size_t len) struct log *log = logd; /* check arguments */ - if (log == NULL || strcmp(log->id, LOGID) || len < 0) + if (log == NULL || strcmp(log->id, LOGID)) return -3; - if (data == NULL || len == 0) + if (data == NULL || len <= 0) return 0; /* see if we lost the lock -- if so get it again and reload the extra @@ -1013,7 +1014,7 @@ int gzlog_write(gzlog *logd, void *data, size_t len) fd = open(log->path, O_WRONLY | O_CREAT | O_TRUNC, 0644); if (fd < 0) return -1; - ret = write(fd, data, len) != len; + ret = (size_t)write(fd, data, len) != len; if (ret | close(fd)) return -1; log_touch(log); diff --git a/compat/zlib/examples/gzlog.h b/compat/zlib/examples/gzlog.h index c461426..86f0cec 100644 --- a/compat/zlib/examples/gzlog.h +++ b/compat/zlib/examples/gzlog.h @@ -1,6 +1,6 @@ /* gzlog.h - Copyright (C) 2004, 2008 Mark Adler, all rights reserved - version 2.0, 25 Apr 2008 + Copyright (C) 2004, 2008, 2012 Mark Adler, all rights reserved + version 2.2, 14 Aug 2012 This software is provided 'as-is', without any express or implied warranty. In no event will the author be held liable for any damages @@ -27,6 +27,8 @@ Interface changed slightly in that now path is a prefix Compression now occurs as needed during gzlog_write() gzlog_write() now always leaves the log file as valid gzip + 2.1 8 Jul 2012 Fix argument checks in gzlog_compress() and gzlog_write() + 2.2 14 Aug 2012 Clean up signed comparisons */ /* diff --git a/compat/zlib/examples/zran.c b/compat/zlib/examples/zran.c index 617a130..278f9ad 100644 --- a/compat/zlib/examples/zran.c +++ b/compat/zlib/examples/zran.c @@ -1,7 +1,12 @@ /* zran.c -- example of zlib/gzip stream indexing and random access - * Copyright (C) 2005 Mark Adler + * Copyright (C) 2005, 2012 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h - Version 1.0 29 May 2005 Mark Adler */ + Version 1.1 29 Sep 2012 Mark Adler */ + +/* Version History: + 1.0 29 May 2005 First version + 1.1 29 Sep 2012 Fix memory reallocation error + */ /* Illustrate the use of Z_BLOCK, inflatePrime(), and inflateSetDictionary() for random access of a compressed file. A file containing a zlib or gzip @@ -221,7 +226,7 @@ local int build_index(FILE *in, off_t span, struct access **built) /* clean up and return index (release unused entries in list) */ (void)inflateEnd(&strm); - index = realloc(index, sizeof(struct point) * index->have); + index->list = realloc(index->list, sizeof(struct point) * index->have); index->size = index->have; *built = index; return index->size; diff --git a/compat/zlib/gzguts.h b/compat/zlib/gzguts.h index ee3f281..d87659d 100644 --- a/compat/zlib/gzguts.h +++ b/compat/zlib/gzguts.h @@ -1,5 +1,5 @@ /* gzguts.h -- zlib internal header definitions for gz* operations - * Copyright (C) 2004, 2005, 2010, 2011, 2012 Mark Adler + * Copyright (C) 2004, 2005, 2010, 2011, 2012, 2013 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ @@ -35,6 +35,13 @@ # include <io.h> #endif +#ifdef WINAPI_FAMILY +# define open _open +# define read _read +# define write _write +# define close _close +#endif + #ifdef NO_DEFLATE /* for compatibility with old definition */ # define NO_GZCOMPRESS #endif @@ -60,7 +67,7 @@ #ifndef HAVE_VSNPRINTF # ifdef MSDOS /* vsnprintf may exist on some MS-DOS compilers (DJGPP?), - but for now we just assume it doesn't. */ + but for now we just assume it doesn't. */ # define NO_vsnprintf # endif # ifdef __TURBOC__ @@ -88,6 +95,14 @@ # endif #endif +/* unlike snprintf (which is required in C99, yet still not supported by + Microsoft more than a decade later!), _snprintf does not guarantee null + termination of the result -- however this is only used in gzlib.c where + the result is assured to fit in the space provided */ +#ifdef _MSC_VER +# define snprintf _snprintf +#endif + #ifndef local # define local static #endif @@ -127,7 +142,8 @@ # define DEF_MEM_LEVEL MAX_MEM_LEVEL #endif -/* default i/o buffer size -- double this for output when reading */ +/* default i/o buffer size -- double this for output when reading (this and + twice this must be able to fit in an unsigned type) */ #define GZBUFSIZE 8192 /* gzip modes, also provide a little integrity check on the passed structure */ diff --git a/compat/zlib/gzlib.c b/compat/zlib/gzlib.c index ca55c6e..fae202e 100644 --- a/compat/zlib/gzlib.c +++ b/compat/zlib/gzlib.c @@ -1,5 +1,5 @@ /* gzlib.c -- zlib functions common to reading and writing gzip files - * Copyright (C) 2004, 2010, 2011, 2012 Mark Adler + * Copyright (C) 2004, 2010, 2011, 2012, 2013 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ @@ -108,7 +108,7 @@ local gzFile gz_open(path, fd, mode) return NULL; /* allocate gzFile structure to return */ - state = malloc(sizeof(gz_state)); + state = (gz_statep)malloc(sizeof(gz_state)); if (state == NULL) return NULL; state->size = 0; /* no buffers allocated yet */ @@ -162,8 +162,10 @@ local gzFile gz_open(path, fd, mode) break; case 'F': state->strategy = Z_FIXED; + break; case 'T': state->direct = 1; + break; default: /* could consider as an error, but just ignore */ ; } @@ -194,8 +196,8 @@ local gzFile gz_open(path, fd, mode) } else #endif - len = strlen(path); - state->path = malloc(len + 1); + len = strlen((const char *)path); + state->path = (char *)malloc(len + 1); if (state->path == NULL) { free(state); return NULL; @@ -208,7 +210,11 @@ local gzFile gz_open(path, fd, mode) *(state->path) = 0; else #endif +#if !defined(NO_snprintf) && !defined(NO_vsnprintf) + snprintf(state->path, len + 1, "%s", (const char *)path); +#else strcpy(state->path, path); +#endif /* compute the flags for open() */ oflag = @@ -236,7 +242,7 @@ local gzFile gz_open(path, fd, mode) #ifdef _WIN32 fd == -2 ? _wopen(path, oflag, 0666) : #endif - open(path, oflag, 0666)); + open((const char *)path, oflag, 0666)); if (state->fd == -1) { free(state->path); free(state); @@ -282,9 +288,13 @@ gzFile ZEXPORT gzdopen(fd, mode) char *path; /* identifier for error messages */ gzFile gz; - if (fd == -1 || (path = malloc(7 + 3 * sizeof(int))) == NULL) + if (fd == -1 || (path = (char *)malloc(7 + 3 * sizeof(int))) == NULL) return NULL; +#if !defined(NO_snprintf) && !defined(NO_vsnprintf) + snprintf(path, 7 + 3 * sizeof(int), "<fd:%d>", fd); /* for debugging */ +#else sprintf(path, "<fd:%d>", fd); /* for debugging */ +#endif gz = gz_open(path, fd, mode); free(path); return gz; @@ -531,7 +541,8 @@ const char * ZEXPORT gzerror(file, errnum) /* return error information */ if (errnum != NULL) *errnum = state->err; - return state->msg == NULL ? "" : state->msg; + return state->err == Z_MEM_ERROR ? "out of memory" : + (state->msg == NULL ? "" : state->msg); } /* -- see zlib.h -- */ @@ -582,21 +593,24 @@ void ZLIB_INTERNAL gz_error(state, err, msg) if (msg == NULL) return; - /* for an out of memory error, save as static string */ - if (err == Z_MEM_ERROR) { - state->msg = (char *)msg; + /* for an out of memory error, return literal string when requested */ + if (err == Z_MEM_ERROR) return; - } /* construct error message with path */ - if ((state->msg = malloc(strlen(state->path) + strlen(msg) + 3)) == NULL) { + if ((state->msg = (char *)malloc(strlen(state->path) + strlen(msg) + 3)) == + NULL) { state->err = Z_MEM_ERROR; - state->msg = (char *)"out of memory"; return; } +#if !defined(NO_snprintf) && !defined(NO_vsnprintf) + snprintf(state->msg, strlen(state->path) + strlen(msg) + 3, + "%s%s%s", state->path, ": ", msg); +#else strcpy(state->msg, state->path); strcat(state->msg, ": "); strcat(state->msg, msg); +#endif return; } diff --git a/compat/zlib/gzread.c b/compat/zlib/gzread.c index 3493d34..bf4538e 100644 --- a/compat/zlib/gzread.c +++ b/compat/zlib/gzread.c @@ -1,5 +1,5 @@ /* gzread.c -- zlib functions for reading gzip files - * Copyright (C) 2004, 2005, 2010, 2011, 2012 Mark Adler + * Copyright (C) 2004, 2005, 2010, 2011, 2012, 2013 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ @@ -58,7 +58,8 @@ local int gz_avail(state) return -1; if (state->eof == 0) { if (strm->avail_in) { /* copy what's there to the start */ - unsigned char *p = state->in, *q = strm->next_in; + unsigned char *p = state->in; + unsigned const char *q = strm->next_in; unsigned n = strm->avail_in; do { *p++ = *q++; @@ -90,8 +91,8 @@ local int gz_look(state) /* allocate read buffers and inflate memory */ if (state->size == 0) { /* allocate buffers */ - state->in = malloc(state->want); - state->out = malloc(state->want << 1); + state->in = (unsigned char *)malloc(state->want); + state->out = (unsigned char *)malloc(state->want << 1); if (state->in == NULL || state->out == NULL) { if (state->out != NULL) free(state->out); @@ -352,14 +353,14 @@ int ZEXPORT gzread(file, buf, len) /* large len -- read directly into user buffer */ else if (state->how == COPY) { /* read directly */ - if (gz_load(state, buf, len, &n) == -1) + if (gz_load(state, (unsigned char *)buf, len, &n) == -1) return -1; } /* large len -- decompress directly into user buffer */ else { /* state->how == GZIP */ strm->avail_out = len; - strm->next_out = buf; + strm->next_out = (unsigned char *)buf; if (gz_decomp(state) == -1) return -1; n = state->x.have; @@ -378,7 +379,11 @@ int ZEXPORT gzread(file, buf, len) } /* -- see zlib.h -- */ -#undef gzgetc +#ifdef Z_PREFIX_SET +# undef z_gzgetc +#else +# undef gzgetc +#endif int ZEXPORT gzgetc(file) gzFile file; { @@ -518,7 +523,7 @@ char * ZEXPORT gzgets(file, buf, len) /* look for end-of-line in current output buffer */ n = state->x.have > left ? left : state->x.have; - eol = memchr(state->x.next, '\n', n); + eol = (unsigned char *)memchr(state->x.next, '\n', n); if (eol != NULL) n = (unsigned)(eol - state->x.next) + 1; diff --git a/compat/zlib/gzwrite.c b/compat/zlib/gzwrite.c index 27cb342..aa767fb 100644 --- a/compat/zlib/gzwrite.c +++ b/compat/zlib/gzwrite.c @@ -1,5 +1,5 @@ /* gzwrite.c -- zlib functions for writing gzip files - * Copyright (C) 2004, 2005, 2010, 2011, 2012 Mark Adler + * Copyright (C) 2004, 2005, 2010, 2011, 2012, 2013 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ @@ -19,7 +19,7 @@ local int gz_init(state) z_streamp strm = &(state->strm); /* allocate input buffer */ - state->in = malloc(state->want); + state->in = (unsigned char *)malloc(state->want); if (state->in == NULL) { gz_error(state, Z_MEM_ERROR, "out of memory"); return -1; @@ -28,7 +28,7 @@ local int gz_init(state) /* only need output buffer and deflate state if compressing */ if (!state->direct) { /* allocate output buffer */ - state->out = malloc(state->want); + state->out = (unsigned char *)malloc(state->want); if (state->out == NULL) { free(state->in); gz_error(state, Z_MEM_ERROR, "out of memory"); @@ -168,7 +168,6 @@ int ZEXPORT gzwrite(file, buf, len) unsigned len; { unsigned put = len; - unsigned n; gz_statep state; z_streamp strm; @@ -208,16 +207,19 @@ int ZEXPORT gzwrite(file, buf, len) if (len < state->size) { /* copy to input buffer, compress when full */ do { + unsigned have, copy; + if (strm->avail_in == 0) strm->next_in = state->in; - n = state->size - strm->avail_in; - if (n > len) - n = len; - memcpy(strm->next_in + strm->avail_in, buf, n); - strm->avail_in += n; - state->x.pos += n; - buf = (char *)buf + n; - len -= n; + have = (unsigned)((strm->next_in + strm->avail_in) - state->in); + copy = state->size - have; + if (copy > len) + copy = len; + memcpy(state->in + have, buf, copy); + strm->avail_in += copy; + state->x.pos += copy; + buf = (const char *)buf + copy; + len -= copy; if (len && gz_comp(state, Z_NO_FLUSH) == -1) return 0; } while (len); @@ -229,7 +231,7 @@ int ZEXPORT gzwrite(file, buf, len) /* directly compress user buffer to file */ strm->avail_in = len; - strm->next_in = (voidp)buf; + strm->next_in = (z_const Bytef *)buf; state->x.pos += len; if (gz_comp(state, Z_NO_FLUSH) == -1) return 0; @@ -244,6 +246,7 @@ int ZEXPORT gzputc(file, c) gzFile file; int c; { + unsigned have; unsigned char buf[1]; gz_statep state; z_streamp strm; @@ -267,12 +270,16 @@ int ZEXPORT gzputc(file, c) /* try writing to input buffer for speed (state->size == 0 if buffer not initialized) */ - if (strm->avail_in < state->size) { + if (state->size) { if (strm->avail_in == 0) strm->next_in = state->in; - strm->next_in[strm->avail_in++] = c; - state->x.pos++; - return c & 0xff; + have = (unsigned)((strm->next_in + strm->avail_in) - state->in); + if (have < state->size) { + state->in[have] = c; + strm->avail_in++; + state->x.pos++; + return c & 0xff; + } } /* no room in buffer or not initialized, use gz_write() */ @@ -300,12 +307,11 @@ int ZEXPORT gzputs(file, str) #include <stdarg.h> /* -- see zlib.h -- */ -int ZEXPORTVA gzprintf (gzFile file, const char *format, ...) +int ZEXPORTVA gzvprintf(gzFile file, const char *format, va_list va) { int size, len; gz_statep state; z_streamp strm; - va_list va; /* get internal structure */ if (file == NULL) @@ -335,25 +341,20 @@ int ZEXPORTVA gzprintf (gzFile file, const char *format, ...) /* do the printf() into the input buffer, put length in len */ size = (int)(state->size); state->in[size - 1] = 0; - va_start(va, format); #ifdef NO_vsnprintf # ifdef HAS_vsprintf_void (void)vsprintf((char *)(state->in), format, va); - va_end(va); for (len = 0; len < size; len++) if (state->in[len] == 0) break; # else len = vsprintf((char *)(state->in), format, va); - va_end(va); # endif #else # ifdef HAS_vsnprintf_void (void)vsnprintf((char *)(state->in), size, format, va); - va_end(va); len = strlen((char *)(state->in)); # else len = vsnprintf((char *)(state->in), size, format, va); - va_end(va); # endif #endif @@ -368,6 +369,17 @@ int ZEXPORTVA gzprintf (gzFile file, const char *format, ...) return len; } +int ZEXPORTVA gzprintf(gzFile file, const char *format, ...) +{ + va_list va; + int ret; + + va_start(va, format); + ret = gzvprintf(file, format, va); + va_end(va); + return ret; +} + #else /* !STDC && !Z_HAVE_STDARG_H */ /* -- see zlib.h -- */ @@ -547,9 +559,9 @@ int ZEXPORT gzclose_w(file) } /* flush, free memory, and close file */ + if (gz_comp(state, Z_FINISH) == -1) + ret = state->err; if (state->size) { - if (gz_comp(state, Z_FINISH) == -1) - ret = state->err; if (!state->direct) { (void)deflateEnd(&(state->strm)); free(state->out); diff --git a/compat/zlib/infback.c b/compat/zlib/infback.c index 981aff1..f3833c2 100644 --- a/compat/zlib/infback.c +++ b/compat/zlib/infback.c @@ -255,7 +255,7 @@ out_func out; void FAR *out_desc; { struct inflate_state FAR *state; - unsigned char FAR *next; /* next input */ + z_const unsigned char FAR *next; /* next input */ unsigned char FAR *put; /* next output */ unsigned have, left; /* available input and output */ unsigned long hold; /* bit buffer */ diff --git a/compat/zlib/inffast.c b/compat/zlib/inffast.c index 2f1d60b..bda59ce 100644 --- a/compat/zlib/inffast.c +++ b/compat/zlib/inffast.c @@ -1,5 +1,5 @@ /* inffast.c -- fast decoding - * Copyright (C) 1995-2008, 2010 Mark Adler + * Copyright (C) 1995-2008, 2010, 2013 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ @@ -69,8 +69,8 @@ z_streamp strm; unsigned start; /* inflate()'s starting value for strm->avail_out */ { struct inflate_state FAR *state; - unsigned char FAR *in; /* local strm->next_in */ - unsigned char FAR *last; /* while in < last, enough input available */ + z_const unsigned char FAR *in; /* local strm->next_in */ + z_const unsigned char FAR *last; /* have enough input while in < last */ unsigned char FAR *out; /* local strm->next_out */ unsigned char FAR *beg; /* inflate()'s initial strm->next_out */ unsigned char FAR *end; /* while out < end, enough space available */ diff --git a/compat/zlib/inflate.c b/compat/zlib/inflate.c index 47418a1..870f89b 100644 --- a/compat/zlib/inflate.c +++ b/compat/zlib/inflate.c @@ -93,11 +93,12 @@ /* function prototypes */ local void fixedtables OF((struct inflate_state FAR *state)); -local int updatewindow OF((z_streamp strm, unsigned out)); +local int updatewindow OF((z_streamp strm, const unsigned char FAR *end, + unsigned copy)); #ifdef BUILDFIXED void makefixed OF((void)); #endif -local unsigned syncsearch OF((unsigned FAR *have, unsigned char FAR *buf, +local unsigned syncsearch OF((unsigned FAR *have, const unsigned char FAR *buf, unsigned len)); int ZEXPORT inflateResetKeep(strm) @@ -375,12 +376,13 @@ void makefixed() output will fall in the output data, making match copies simpler and faster. The advantage may be dependent on the size of the processor's data caches. */ -local int updatewindow(strm, out) +local int updatewindow(strm, end, copy) z_streamp strm; -unsigned out; +const Bytef *end; +unsigned copy; { struct inflate_state FAR *state; - unsigned copy, dist; + unsigned dist; state = (struct inflate_state FAR *)strm->state; @@ -400,19 +402,18 @@ unsigned out; } /* copy state->wsize or less output bytes into the circular window */ - copy = out - strm->avail_out; if (copy >= state->wsize) { - zmemcpy(state->window, strm->next_out - state->wsize, state->wsize); + zmemcpy(state->window, end - state->wsize, state->wsize); state->wnext = 0; state->whave = state->wsize; } else { dist = state->wsize - state->wnext; if (dist > copy) dist = copy; - zmemcpy(state->window + state->wnext, strm->next_out - copy, dist); + zmemcpy(state->window + state->wnext, end - copy, dist); copy -= dist; if (copy) { - zmemcpy(state->window, strm->next_out - copy, copy); + zmemcpy(state->window, end - copy, copy); state->wnext = copy; state->whave = state->wsize; } @@ -606,7 +607,7 @@ z_streamp strm; int flush; { struct inflate_state FAR *state; - unsigned char FAR *next; /* next input */ + z_const unsigned char FAR *next; /* next input */ unsigned char FAR *put; /* next output */ unsigned have, left; /* available input and output */ unsigned long hold; /* bit buffer */ @@ -920,7 +921,7 @@ int flush; while (state->have < 19) state->lens[order[state->have++]] = 0; state->next = state->codes; - state->lencode = (code const FAR *)(state->next); + state->lencode = (const code FAR *)(state->next); state->lenbits = 7; ret = inflate_table(CODES, state->lens, 19, &(state->next), &(state->lenbits), state->work); @@ -994,7 +995,7 @@ int flush; values here (9 and 6) without reading the comments in inftrees.h concerning the ENOUGH constants, which depend on those values */ state->next = state->codes; - state->lencode = (code const FAR *)(state->next); + state->lencode = (const code FAR *)(state->next); state->lenbits = 9; ret = inflate_table(LENS, state->lens, state->nlen, &(state->next), &(state->lenbits), state->work); @@ -1003,7 +1004,7 @@ int flush; state->mode = BAD; break; } - state->distcode = (code const FAR *)(state->next); + state->distcode = (const code FAR *)(state->next); state->distbits = 6; ret = inflate_table(DISTS, state->lens + state->nlen, state->ndist, &(state->next), &(state->distbits), state->work); @@ -1230,7 +1231,7 @@ int flush; RESTORE(); if (state->wsize || (out != strm->avail_out && state->mode < BAD && (state->mode < CHECK || flush != Z_FINISH))) - if (updatewindow(strm, out)) { + if (updatewindow(strm, strm->next_out, out - strm->avail_out)) { state->mode = MEM; return Z_MEM_ERROR; } @@ -1264,6 +1265,29 @@ z_streamp strm; return Z_OK; } +int ZEXPORT inflateGetDictionary(strm, dictionary, dictLength) +z_streamp strm; +Bytef *dictionary; +uInt *dictLength; +{ + struct inflate_state FAR *state; + + /* check state */ + if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; + state = (struct inflate_state FAR *)strm->state; + + /* copy dictionary */ + if (state->whave && dictionary != Z_NULL) { + zmemcpy(dictionary, state->window + state->wnext, + state->whave - state->wnext); + zmemcpy(dictionary + state->whave - state->wnext, + state->window, state->wnext); + } + if (dictLength != Z_NULL) + *dictLength = state->whave; + return Z_OK; +} + int ZEXPORT inflateSetDictionary(strm, dictionary, dictLength) z_streamp strm; const Bytef *dictionary; @@ -1271,8 +1295,6 @@ uInt dictLength; { struct inflate_state FAR *state; unsigned long dictid; - unsigned char *next; - unsigned avail; int ret; /* check state */ @@ -1291,13 +1313,7 @@ uInt dictLength; /* copy dictionary to window using updatewindow(), which will amend the existing dictionary if appropriate */ - next = strm->next_out; - avail = strm->avail_out; - strm->next_out = (Bytef *)dictionary + dictLength; - strm->avail_out = 0; - ret = updatewindow(strm, dictLength); - strm->avail_out = avail; - strm->next_out = next; + ret = updatewindow(strm, dictionary + dictLength, dictLength); if (ret) { state->mode = MEM; return Z_MEM_ERROR; @@ -1337,7 +1353,7 @@ gz_headerp head; */ local unsigned syncsearch(have, buf, len) unsigned FAR *have; -unsigned char FAR *buf; +const unsigned char FAR *buf; unsigned len; { unsigned got; diff --git a/compat/zlib/inftrees.c b/compat/zlib/inftrees.c index abcd7c4..44d89cf 100644 --- a/compat/zlib/inftrees.c +++ b/compat/zlib/inftrees.c @@ -1,5 +1,5 @@ /* inftrees.c -- generate Huffman trees for efficient decoding - * Copyright (C) 1995-2012 Mark Adler + * Copyright (C) 1995-2013 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ @@ -9,7 +9,7 @@ #define MAXBITS 15 const char inflate_copyright[] = - " inflate 1.2.7 Copyright 1995-2012 Mark Adler "; + " inflate 1.2.8 Copyright 1995-2013 Mark Adler "; /* If you use the zlib library in a product, an acknowledgment is welcome in the documentation of your product. If for some reason you cannot @@ -62,7 +62,7 @@ unsigned short FAR *work; 35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258, 0, 0}; static const unsigned short lext[31] = { /* Length codes 257..285 extra */ 16, 16, 16, 16, 16, 16, 16, 16, 17, 17, 17, 17, 18, 18, 18, 18, - 19, 19, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 16, 78, 68}; + 19, 19, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 16, 72, 78}; static const unsigned short dbase[32] = { /* Distance codes 0..29 base */ 1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193, 257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145, @@ -208,8 +208,8 @@ unsigned short FAR *work; mask = used - 1; /* mask for comparing low */ /* check available table space */ - if ((type == LENS && used >= ENOUGH_LENS) || - (type == DISTS && used >= ENOUGH_DISTS)) + if ((type == LENS && used > ENOUGH_LENS) || + (type == DISTS && used > ENOUGH_DISTS)) return 1; /* process all codes and make table entries */ @@ -277,8 +277,8 @@ unsigned short FAR *work; /* check for enough space */ used += 1U << curr; - if ((type == LENS && used >= ENOUGH_LENS) || - (type == DISTS && used >= ENOUGH_DISTS)) + if ((type == LENS && used > ENOUGH_LENS) || + (type == DISTS && used > ENOUGH_DISTS)) return 1; /* point entry in root table to sub-table */ diff --git a/compat/zlib/qnx/package.qpg b/compat/zlib/qnx/package.qpg index 26eed9b..aebf6e3 100644 --- a/compat/zlib/qnx/package.qpg +++ b/compat/zlib/qnx/package.qpg @@ -25,10 +25,10 @@ <QPG:Files> <QPG:Add file="../zconf.h" install="/opt/include/" user="root:sys" permission="644"/> <QPG:Add file="../zlib.h" install="/opt/include/" user="root:sys" permission="644"/> - <QPG:Add file="../libz.so.1.2.7" install="/opt/lib/" user="root:bin" permission="644"/> - <QPG:Add file="libz.so" install="/opt/lib/" component="dev" filetype="symlink" linkto="libz.so.1.2.7"/> - <QPG:Add file="libz.so.1" install="/opt/lib/" filetype="symlink" linkto="libz.so.1.2.7"/> - <QPG:Add file="../libz.so.1.2.7" install="/opt/lib/" component="slib"/> + <QPG:Add file="../libz.so.1.2.8" install="/opt/lib/" user="root:bin" permission="644"/> + <QPG:Add file="libz.so" install="/opt/lib/" component="dev" filetype="symlink" linkto="libz.so.1.2.8"/> + <QPG:Add file="libz.so.1" install="/opt/lib/" filetype="symlink" linkto="libz.so.1.2.8"/> + <QPG:Add file="../libz.so.1.2.8" install="/opt/lib/" component="slib"/> </QPG:Files> <QPG:PackageFilter> @@ -63,7 +63,7 @@ </QPM:ProductDescription> <QPM:ReleaseDescription> - <QPM:ReleaseVersion>1.2.7</QPM:ReleaseVersion> + <QPM:ReleaseVersion>1.2.8</QPM:ReleaseVersion> <QPM:ReleaseUrgency>Medium</QPM:ReleaseUrgency> <QPM:ReleaseStability>Stable</QPM:ReleaseStability> <QPM:ReleaseNoteMinor></QPM:ReleaseNoteMinor> diff --git a/compat/zlib/test/example.c b/compat/zlib/test/example.c index f515a48..138a699 100644 --- a/compat/zlib/test/example.c +++ b/compat/zlib/test/example.c @@ -26,7 +26,7 @@ } \ } -const char hello[] = "hello, hello!"; +z_const char hello[] = "hello, hello!"; /* "hello world" would be more standard, but the repeated "hello" * stresses the compression code better, sorry... */ @@ -212,7 +212,7 @@ void test_deflate(compr, comprLen) err = deflateInit(&c_stream, Z_DEFAULT_COMPRESSION); CHECK_ERR(err, "deflateInit"); - c_stream.next_in = (Bytef*)hello; + c_stream.next_in = (z_const unsigned char *)hello; c_stream.next_out = compr; while (c_stream.total_in != len && c_stream.total_out < comprLen) { @@ -387,7 +387,7 @@ void test_flush(compr, comprLen) err = deflateInit(&c_stream, Z_DEFAULT_COMPRESSION); CHECK_ERR(err, "deflateInit"); - c_stream.next_in = (Bytef*)hello; + c_stream.next_in = (z_const unsigned char *)hello; c_stream.next_out = compr; c_stream.avail_in = 3; c_stream.avail_out = (uInt)*comprLen; @@ -476,7 +476,7 @@ void test_dict_deflate(compr, comprLen) c_stream.next_out = compr; c_stream.avail_out = (uInt)comprLen; - c_stream.next_in = (Bytef*)hello; + c_stream.next_in = (z_const unsigned char *)hello; c_stream.avail_in = (uInt)strlen(hello)+1; err = deflate(&c_stream, Z_FINISH); diff --git a/compat/zlib/test/minigzip.c b/compat/zlib/test/minigzip.c index aa7ac7a..b3025a4 100644 --- a/compat/zlib/test/minigzip.c +++ b/compat/zlib/test/minigzip.c @@ -40,6 +40,10 @@ # define SET_BINARY_MODE(file) #endif +#ifdef _MSC_VER +# define snprintf _snprintf +#endif + #ifdef VMS # define unlink delete # define GZ_SUFFIX "-gz" @@ -463,8 +467,12 @@ void file_compress(file, mode) exit(1); } +#if !defined(NO_snprintf) && !defined(NO_vsnprintf) + snprintf(outfile, sizeof(outfile), "%s%s", file, GZ_SUFFIX); +#else strcpy(outfile, file); strcat(outfile, GZ_SUFFIX); +#endif in = fopen(file, "rb"); if (in == NULL) { @@ -499,7 +507,11 @@ void file_uncompress(file) exit(1); } +#if !defined(NO_snprintf) && !defined(NO_vsnprintf) + snprintf(buf, sizeof(buf), "%s", file); +#else strcpy(buf, file); +#endif if (len > SUFFIX_LEN && strcmp(file+len-SUFFIX_LEN, GZ_SUFFIX) == 0) { infile = file; @@ -508,7 +520,11 @@ void file_uncompress(file) } else { outfile = file; infile = buf; +#if !defined(NO_snprintf) && !defined(NO_vsnprintf) + snprintf(buf + len, sizeof(buf) - len, "%s", GZ_SUFFIX); +#else strcat(infile, GZ_SUFFIX); +#endif } in = gzopen(infile, "rb"); if (in == NULL) { @@ -546,7 +562,11 @@ int main(argc, argv) gzFile file; char *bname, outmode[20]; +#if !defined(NO_snprintf) && !defined(NO_vsnprintf) + snprintf(outmode, sizeof(outmode), "%s", "wb6 "); +#else strcpy(outmode, "wb6 "); +#endif prog = argv[0]; bname = strrchr(argv[0], '/'); diff --git a/compat/zlib/treebuild.xml b/compat/zlib/treebuild.xml index 1f4d15f..38d29d7 100644 --- a/compat/zlib/treebuild.xml +++ b/compat/zlib/treebuild.xml @@ -1,6 +1,6 @@ <?xml version="1.0" ?> -<package name="zlib" version="1.2.7"> - <library name="zlib" dlversion="1.2.7" dlname="z"> +<package name="zlib" version="1.2.8"> + <library name="zlib" dlversion="1.2.8" dlname="z"> <property name="description"> zip compression library </property> <property name="include-target-dir" value="$(@PACKAGE/install-includedir)" /> diff --git a/compat/zlib/trees.c b/compat/zlib/trees.c index 8c32b21..1fd7759 100644 --- a/compat/zlib/trees.c +++ b/compat/zlib/trees.c @@ -146,8 +146,8 @@ local void send_tree OF((deflate_state *s, ct_data *tree, int max_code)); local int build_bl_tree OF((deflate_state *s)); local void send_all_trees OF((deflate_state *s, int lcodes, int dcodes, int blcodes)); -local void compress_block OF((deflate_state *s, ct_data *ltree, - ct_data *dtree)); +local void compress_block OF((deflate_state *s, const ct_data *ltree, + const ct_data *dtree)); local int detect_data_type OF((deflate_state *s)); local unsigned bi_reverse OF((unsigned value, int length)); local void bi_windup OF((deflate_state *s)); @@ -972,7 +972,8 @@ void ZLIB_INTERNAL _tr_flush_block(s, buf, stored_len, last) } else if (s->strategy == Z_FIXED || static_lenb == opt_lenb) { #endif send_bits(s, (STATIC_TREES<<1)+last, 3); - compress_block(s, (ct_data *)static_ltree, (ct_data *)static_dtree); + compress_block(s, (const ct_data *)static_ltree, + (const ct_data *)static_dtree); #ifdef DEBUG s->compressed_len += 3 + s->static_len; #endif @@ -980,7 +981,8 @@ void ZLIB_INTERNAL _tr_flush_block(s, buf, stored_len, last) send_bits(s, (DYN_TREES<<1)+last, 3); send_all_trees(s, s->l_desc.max_code+1, s->d_desc.max_code+1, max_blindex+1); - compress_block(s, (ct_data *)s->dyn_ltree, (ct_data *)s->dyn_dtree); + compress_block(s, (const ct_data *)s->dyn_ltree, + (const ct_data *)s->dyn_dtree); #ifdef DEBUG s->compressed_len += 3 + s->opt_len; #endif @@ -1057,8 +1059,8 @@ int ZLIB_INTERNAL _tr_tally (s, dist, lc) */ local void compress_block(s, ltree, dtree) deflate_state *s; - ct_data *ltree; /* literal tree */ - ct_data *dtree; /* distance tree */ + const ct_data *ltree; /* literal tree */ + const ct_data *dtree; /* distance tree */ { unsigned dist; /* distance of matched string */ int lc; /* match length or unmatched char (if dist == 0) */ diff --git a/compat/zlib/uncompr.c b/compat/zlib/uncompr.c index ad98be3..242e949 100644 --- a/compat/zlib/uncompr.c +++ b/compat/zlib/uncompr.c @@ -30,7 +30,7 @@ int ZEXPORT uncompress (dest, destLen, source, sourceLen) z_stream stream; int err; - stream.next_in = (Bytef*)source; + stream.next_in = (z_const Bytef *)source; stream.avail_in = (uInt)sourceLen; /* Check for source > 64K on 16-bit machine: */ if ((uLong)stream.avail_in != sourceLen) return Z_BUF_ERROR; diff --git a/compat/zlib/win32/Makefile.msc b/compat/zlib/win32/Makefile.msc index 59bb0da..67b7731 100644 --- a/compat/zlib/win32/Makefile.msc +++ b/compat/zlib/win32/Makefile.msc @@ -9,6 +9,10 @@ # nmake -f win32/Makefile.msc AS=ml64 LOC="-DASMV -DASMINF -I." \ # OBJA="inffasx64.obj gvmat64.obj inffas8664.obj" (use ASM code, x64) +# The toplevel directory of the source tree. +# +TOP = . + # optional build flags LOC = @@ -43,8 +47,8 @@ $(STATICLIB): $(OBJS) $(OBJA) $(IMPLIB): $(SHAREDLIB) -$(SHAREDLIB): win32/zlib.def $(OBJS) $(OBJA) zlib1.res - $(LD) $(LDFLAGS) -def:win32/zlib.def -dll -implib:$(IMPLIB) \ +$(SHAREDLIB): $(TOP)/win32/zlib.def $(OBJS) $(OBJA) zlib1.res + $(LD) $(LDFLAGS) -def:$(TOP)/win32/zlib.def -dll -implib:$(IMPLIB) \ -out:$@ -base:0x5A4C0000 $(OBJS) $(OBJA) zlib1.res if exist $@.manifest \ mt -nologo -manifest $@.manifest -outputresource:$@;2 @@ -69,72 +73,71 @@ minigzip_d.exe: minigzip.obj $(IMPLIB) if exist $@.manifest \ mt -nologo -manifest $@.manifest -outputresource:$@;1 -.c.obj: +{$(TOP)}.c.obj: $(CC) -c $(WFLAGS) $(CFLAGS) $< -{test}.c.obj: - $(CC) -c -I. $(WFLAGS) $(CFLAGS) $< +{$(TOP)/test}.c.obj: + $(CC) -c -I$(TOP) $(WFLAGS) $(CFLAGS) $< -{contrib/masmx64}.c.obj: +{$(TOP)/contrib/masmx64}.c.obj: $(CC) -c $(WFLAGS) $(CFLAGS) $< -{contrib/masmx64}.asm.obj: +{$(TOP)/contrib/masmx64}.asm.obj: $(AS) -c $(ASFLAGS) $< -{contrib/masmx86}.asm.obj: +{$(TOP)/contrib/masmx86}.asm.obj: $(AS) -c $(ASFLAGS) $< -adler32.obj: adler32.c zlib.h zconf.h - -compress.obj: compress.c zlib.h zconf.h +adler32.obj: $(TOP)/adler32.c $(TOP)/zlib.h $(TOP)/zconf.h -crc32.obj: crc32.c zlib.h zconf.h crc32.h +compress.obj: $(TOP)/compress.c $(TOP)/zlib.h $(TOP)/zconf.h -deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h +crc32.obj: $(TOP)/crc32.c $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/crc32.h -gzclose.obj: gzclose.c zlib.h zconf.h gzguts.h +deflate.obj: $(TOP)/deflate.c $(TOP)/deflate.h $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h -gzlib.obj: gzlib.c zlib.h zconf.h gzguts.h +gzclose.obj: $(TOP)/gzclose.c $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/gzguts.h -gzread.obj: gzread.c zlib.h zconf.h gzguts.h +gzlib.obj: $(TOP)/gzlib.c $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/gzguts.h -gzwrite.obj: gzwrite.c zlib.h zconf.h gzguts.h +gzread.obj: $(TOP)/gzread.c $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/gzguts.h -infback.obj: infback.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ - inffast.h inffixed.h +gzwrite.obj: $(TOP)/gzwrite.c $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/gzguts.h -inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ - inffast.h +infback.obj: $(TOP)/infback.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/inftrees.h $(TOP)/inflate.h \ + $(TOP)/inffast.h $(TOP)/inffixed.h -inflate.obj: inflate.c zutil.h zlib.h zconf.h inftrees.h inflate.h \ - inffast.h inffixed.h +inffast.obj: $(TOP)/inffast.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/inftrees.h $(TOP)/inflate.h \ + $(TOP)/inffast.h -inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h +inflate.obj: $(TOP)/inflate.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/inftrees.h $(TOP)/inflate.h \ + $(TOP)/inffast.h $(TOP)/inffixed.h -trees.obj: trees.c zutil.h zlib.h zconf.h deflate.h trees.h +inftrees.obj: $(TOP)/inftrees.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/inftrees.h -uncompr.obj: uncompr.c zlib.h zconf.h +trees.obj: $(TOP)/trees.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/deflate.h $(TOP)/trees.h -zutil.obj: zutil.c zutil.h zlib.h zconf.h +uncompr.obj: $(TOP)/uncompr.c $(TOP)/zlib.h $(TOP)/zconf.h -gvmat64.obj: contrib\masmx64\gvmat64.asm +zutil.obj: $(TOP)/zutil.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h -inffasx64.obj: contrib\masmx64\inffasx64.asm +gvmat64.obj: $(TOP)/contrib\masmx64\gvmat64.asm -inffas8664.obj: contrib\masmx64\inffas8664.c zutil.h zlib.h zconf.h \ - inftrees.h inflate.h inffast.h +inffasx64.obj: $(TOP)/contrib\masmx64\inffasx64.asm -inffas32.obj: contrib\masmx86\inffas32.asm +inffas8664.obj: $(TOP)/contrib\masmx64\inffas8664.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h \ + $(TOP)/inftrees.h $(TOP)/inflate.h $(TOP)/inffast.h -match686.obj: contrib\masmx86\match686.asm +inffas32.obj: $(TOP)/contrib\masmx86\inffas32.asm -example.obj: test/example.c zlib.h zconf.h +match686.obj: $(TOP)/contrib\masmx86\match686.asm -minigzip.obj: test/minigzip.c zlib.h zconf.h +example.obj: $(TOP)/test/example.c $(TOP)/zlib.h $(TOP)/zconf.h -zlib1.res: win32/zlib1.rc - $(RC) $(RCFLAGS) /fo$@ win32/zlib1.rc +minigzip.obj: $(TOP)/test/minigzip.c $(TOP)/zlib.h $(TOP)/zconf.h +zlib1.res: $(TOP)/win32/zlib1.rc + $(RC) $(RCFLAGS) /fo$@ $(TOP)/win32/zlib1.rc # testing test: example.exe minigzip.exe diff --git a/compat/zlib/win32/README-WIN32.txt b/compat/zlib/win32/README-WIN32.txt index 46c5923..3d77d52 100644 --- a/compat/zlib/win32/README-WIN32.txt +++ b/compat/zlib/win32/README-WIN32.txt @@ -1,6 +1,6 @@ ZLIB DATA COMPRESSION LIBRARY -zlib 1.2.7 is a general purpose data compression library. All the code is +zlib 1.2.8 is a general purpose data compression library. All the code is thread safe. The data format used by the zlib library is described by RFCs (Request for Comments) 1950 to 1952 in the files http://www.ietf.org/rfc/rfc1950.txt (zlib format), rfc1951.txt (deflate format) @@ -22,7 +22,7 @@ before asking for help. Manifest: -The package zlib-1.2.7-win32-x86.zip will contain the following files: +The package zlib-1.2.8-win32-x86.zip will contain the following files: README-WIN32.txt This document ChangeLog Changes since previous zlib packages diff --git a/compat/zlib/win32/README.txt b/compat/zlib/win32/README.txt index fad9f14..34a13b3 100644 --- a/compat/zlib/win32/README.txt +++ b/compat/zlib/win32/README.txt @@ -6,7 +6,7 @@ What's here Source
======
- zlib version 1.2.5
+ zlib version 1.2.8
available at http://www.gzip.org/zlib/
@@ -22,17 +22,18 @@ Usage Build info
==========
- Contributed by Cosmin Truta.
+ Contributed by Jan Nijtmans.
Compiler:
- gcc-4.5.0-1-mingw32
+ i686-w64-mingw32-gcc (GCC) 4.5.3
Library:
- mingwrt-3.17, w32api-3.14
+ mingw64-i686-runtime/headers: 3.0b_svn5747-1
Build commands:
- gcc -c -DASMV contrib/asm686/match.S
- gcc -c -DASMINF -I. -O3 contrib/inflate86/inffas86.c
- make -f win32/Makefile.gcc LOC="-DASMV -DASMINF" OBJA="inffas86.o match.o"
-
+ i686-w64-mingw32-gcc -c -DASMV contrib/asm686/match.S
+ i686-w64-mingw32-gcc -c -DASMINF -I. -O3 contrib/inflate86/inffas86.c
+ make -f win32/Makefile.gcc PREFIX=i686-w64-mingw32- LOC="-mms-bitfields -DASMV -DASMINF" OBJA="inffas86.o match.o"
+ Finally, from VS commandline (VS2005 or higher):
+ lib -machine:X86 -name:zlib1.dll -def:zlib.def -out:zdll.lib
Copyright notice
================
diff --git a/compat/zlib/win32/zdll.lib b/compat/zlib/win32/zdll.lib Binary files differindex 669b186..8e6f719 100644 --- a/compat/zlib/win32/zdll.lib +++ b/compat/zlib/win32/zdll.lib diff --git a/compat/zlib/win32/zlib.def b/compat/zlib/win32/zlib.def index 0489615..face655 100644 --- a/compat/zlib/win32/zlib.def +++ b/compat/zlib/win32/zlib.def @@ -17,6 +17,7 @@ EXPORTS deflatePrime deflateSetHeader inflateSetDictionary + inflateGetDictionary inflateSync inflateCopy inflateReset @@ -39,6 +40,7 @@ EXPORTS gzread gzwrite gzprintf + gzvprintf gzputs gzgets gzputc diff --git a/compat/zlib/win32/zlib1.dll b/compat/zlib/win32/zlib1.dll Binary files differindex 9943b3e..9ea38d5 100644 --- a/compat/zlib/win32/zlib1.dll +++ b/compat/zlib/win32/zlib1.dll diff --git a/compat/zlib/win32/zlib1.rc b/compat/zlib/win32/zlib1.rc index 0d1d7ff..5c0feed 100644 --- a/compat/zlib/win32/zlib1.rc +++ b/compat/zlib/win32/zlib1.rc @@ -26,7 +26,7 @@ BEGIN VALUE "FileDescription", "zlib data compression library\0" VALUE "FileVersion", ZLIB_VERSION "\0" VALUE "InternalName", "zlib1.dll\0" - VALUE "LegalCopyright", "(C) 1995-2006 Jean-loup Gailly & Mark Adler\0" + VALUE "LegalCopyright", "(C) 1995-2013 Jean-loup Gailly & Mark Adler\0" VALUE "OriginalFilename", "zlib1.dll\0" VALUE "ProductName", "zlib\0" VALUE "ProductVersion", ZLIB_VERSION "\0" diff --git a/compat/zlib/win64/libz.dll.a b/compat/zlib/win64/libz.dll.a Binary files differnew file mode 100644 index 0000000..a3ae403 --- /dev/null +++ b/compat/zlib/win64/libz.dll.a diff --git a/compat/zlib/win64/zdll.lib b/compat/zlib/win64/zdll.lib Binary files differindex d7dfb09..ac9ffc9 100644 --- a/compat/zlib/win64/zdll.lib +++ b/compat/zlib/win64/zdll.lib diff --git a/compat/zlib/win64/zlib1.dll b/compat/zlib/win64/zlib1.dll Binary files differindex 631439b..bd1dbc6 100644 --- a/compat/zlib/win64/zlib1.dll +++ b/compat/zlib/win64/zlib1.dll diff --git a/compat/zlib/zconf.h b/compat/zlib/zconf.h index 8a46a58..9987a77 100644 --- a/compat/zlib/zconf.h +++ b/compat/zlib/zconf.h @@ -1,5 +1,5 @@ /* zconf.h -- configuration of the zlib compression library - * Copyright (C) 1995-2012 Jean-loup Gailly. + * Copyright (C) 1995-2013 Jean-loup Gailly. * For conditions of distribution and use, see copyright notice in zlib.h */ @@ -21,6 +21,7 @@ # define _dist_code z__dist_code # define _length_code z__length_code # define _tr_align z__tr_align +# define _tr_flush_bits z__tr_flush_bits # define _tr_flush_block z__tr_flush_block # define _tr_init z__tr_init # define _tr_stored_block z__tr_stored_block @@ -77,6 +78,7 @@ # define gzopen_w z_gzopen_w # endif # define gzprintf z_gzprintf +# define gzvprintf z_gzvprintf # define gzputc z_gzputc # define gzputs z_gzputs # define gzread z_gzread @@ -103,6 +105,7 @@ # define inflateReset z_inflateReset # define inflateReset2 z_inflateReset2 # define inflateSetDictionary z_inflateSetDictionary +# define inflateGetDictionary z_inflateGetDictionary # define inflateSync z_inflateSync # define inflateSyncPoint z_inflateSyncPoint # define inflateUndermine z_inflateUndermine @@ -388,20 +391,14 @@ typedef uLong FAR uLongf; typedef Byte *voidp; #endif -/* ./configure may #define Z_U4 here */ - #if !defined(Z_U4) && !defined(Z_SOLO) && defined(STDC) # include <limits.h> # if (UINT_MAX == 0xffffffffUL) # define Z_U4 unsigned -# else -# if (ULONG_MAX == 0xffffffffUL) -# define Z_U4 unsigned long -# else -# if (USHRT_MAX == 0xffffffffUL) -# define Z_U4 unsigned short -# endif -# endif +# elif (ULONG_MAX == 0xffffffffUL) +# define Z_U4 unsigned long +# elif (USHRT_MAX == 0xffffffffUL) +# define Z_U4 unsigned short # endif #endif @@ -425,8 +422,16 @@ typedef uLong FAR uLongf; # endif #endif +#if defined(STDC) || defined(Z_HAVE_STDARG_H) +# ifndef Z_SOLO +# include <stdarg.h> /* for va_list */ +# endif +#endif + #ifdef _WIN32 -# include <stddef.h> /* for wchar_t */ +# ifndef Z_SOLO +# include <stddef.h> /* for wchar_t */ +# endif #endif /* a little trick to accommodate both "#define _LARGEFILE64_SOURCE" and @@ -435,7 +440,7 @@ typedef uLong FAR uLongf; * both "#undef _LARGEFILE64_SOURCE" and "#define _LARGEFILE64_SOURCE 0" as * equivalently requesting no 64-bit operations */ -#if defined(LARGEFILE64_SOURCE) && -_LARGEFILE64_SOURCE - -1 == 1 +#if defined(_LARGEFILE64_SOURCE) && -_LARGEFILE64_SOURCE - -1 == 1 # undef _LARGEFILE64_SOURCE #endif @@ -443,7 +448,7 @@ typedef uLong FAR uLongf; # define Z_HAVE_UNISTD_H #endif #ifndef Z_SOLO -# if defined(Z_HAVE_UNISTD_H) || defined(LARGEFILE64_SOURCE) +# if defined(Z_HAVE_UNISTD_H) || defined(_LARGEFILE64_SOURCE) # include <unistd.h> /* for SEEK_*, off_t, and _LFS64_LARGEFILE */ # ifdef VMS # include <unixio.h> /* for off_t */ diff --git a/compat/zlib/zconf.h.cmakein b/compat/zlib/zconf.h.cmakein index b6ca59a..043019c 100644 --- a/compat/zlib/zconf.h.cmakein +++ b/compat/zlib/zconf.h.cmakein @@ -1,5 +1,5 @@ /* zconf.h -- configuration of the zlib compression library - * Copyright (C) 1995-2012 Jean-loup Gailly. + * Copyright (C) 1995-2013 Jean-loup Gailly. * For conditions of distribution and use, see copyright notice in zlib.h */ @@ -23,6 +23,7 @@ # define _dist_code z__dist_code # define _length_code z__length_code # define _tr_align z__tr_align +# define _tr_flush_bits z__tr_flush_bits # define _tr_flush_block z__tr_flush_block # define _tr_init z__tr_init # define _tr_stored_block z__tr_stored_block @@ -79,6 +80,7 @@ # define gzopen_w z_gzopen_w # endif # define gzprintf z_gzprintf +# define gzvprintf z_gzvprintf # define gzputc z_gzputc # define gzputs z_gzputs # define gzread z_gzread @@ -105,6 +107,7 @@ # define inflateReset z_inflateReset # define inflateReset2 z_inflateReset2 # define inflateSetDictionary z_inflateSetDictionary +# define inflateGetDictionary z_inflateGetDictionary # define inflateSync z_inflateSync # define inflateSyncPoint z_inflateSyncPoint # define inflateUndermine z_inflateUndermine @@ -390,20 +393,14 @@ typedef uLong FAR uLongf; typedef Byte *voidp; #endif -/* ./configure may #define Z_U4 here */ - #if !defined(Z_U4) && !defined(Z_SOLO) && defined(STDC) # include <limits.h> # if (UINT_MAX == 0xffffffffUL) # define Z_U4 unsigned -# else -# if (ULONG_MAX == 0xffffffffUL) -# define Z_U4 unsigned long -# else -# if (USHRT_MAX == 0xffffffffUL) -# define Z_U4 unsigned short -# endif -# endif +# elif (ULONG_MAX == 0xffffffffUL) +# define Z_U4 unsigned long +# elif (USHRT_MAX == 0xffffffffUL) +# define Z_U4 unsigned short # endif #endif @@ -427,8 +424,16 @@ typedef uLong FAR uLongf; # endif #endif +#if defined(STDC) || defined(Z_HAVE_STDARG_H) +# ifndef Z_SOLO +# include <stdarg.h> /* for va_list */ +# endif +#endif + #ifdef _WIN32 -# include <stddef.h> /* for wchar_t */ +# ifndef Z_SOLO +# include <stddef.h> /* for wchar_t */ +# endif #endif /* a little trick to accommodate both "#define _LARGEFILE64_SOURCE" and @@ -437,7 +442,7 @@ typedef uLong FAR uLongf; * both "#undef _LARGEFILE64_SOURCE" and "#define _LARGEFILE64_SOURCE 0" as * equivalently requesting no 64-bit operations */ -#if defined(LARGEFILE64_SOURCE) && -_LARGEFILE64_SOURCE - -1 == 1 +#if defined(_LARGEFILE64_SOURCE) && -_LARGEFILE64_SOURCE - -1 == 1 # undef _LARGEFILE64_SOURCE #endif @@ -445,7 +450,7 @@ typedef uLong FAR uLongf; # define Z_HAVE_UNISTD_H #endif #ifndef Z_SOLO -# if defined(Z_HAVE_UNISTD_H) || defined(LARGEFILE64_SOURCE) +# if defined(Z_HAVE_UNISTD_H) || defined(_LARGEFILE64_SOURCE) # include <unistd.h> /* for SEEK_*, off_t, and _LFS64_LARGEFILE */ # ifdef VMS # include <unixio.h> /* for off_t */ diff --git a/compat/zlib/zconf.h.in b/compat/zlib/zconf.h.in index 8a46a58..9987a77 100644 --- a/compat/zlib/zconf.h.in +++ b/compat/zlib/zconf.h.in @@ -1,5 +1,5 @@ /* zconf.h -- configuration of the zlib compression library - * Copyright (C) 1995-2012 Jean-loup Gailly. + * Copyright (C) 1995-2013 Jean-loup Gailly. * For conditions of distribution and use, see copyright notice in zlib.h */ @@ -21,6 +21,7 @@ # define _dist_code z__dist_code # define _length_code z__length_code # define _tr_align z__tr_align +# define _tr_flush_bits z__tr_flush_bits # define _tr_flush_block z__tr_flush_block # define _tr_init z__tr_init # define _tr_stored_block z__tr_stored_block @@ -77,6 +78,7 @@ # define gzopen_w z_gzopen_w # endif # define gzprintf z_gzprintf +# define gzvprintf z_gzvprintf # define gzputc z_gzputc # define gzputs z_gzputs # define gzread z_gzread @@ -103,6 +105,7 @@ # define inflateReset z_inflateReset # define inflateReset2 z_inflateReset2 # define inflateSetDictionary z_inflateSetDictionary +# define inflateGetDictionary z_inflateGetDictionary # define inflateSync z_inflateSync # define inflateSyncPoint z_inflateSyncPoint # define inflateUndermine z_inflateUndermine @@ -388,20 +391,14 @@ typedef uLong FAR uLongf; typedef Byte *voidp; #endif -/* ./configure may #define Z_U4 here */ - #if !defined(Z_U4) && !defined(Z_SOLO) && defined(STDC) # include <limits.h> # if (UINT_MAX == 0xffffffffUL) # define Z_U4 unsigned -# else -# if (ULONG_MAX == 0xffffffffUL) -# define Z_U4 unsigned long -# else -# if (USHRT_MAX == 0xffffffffUL) -# define Z_U4 unsigned short -# endif -# endif +# elif (ULONG_MAX == 0xffffffffUL) +# define Z_U4 unsigned long +# elif (USHRT_MAX == 0xffffffffUL) +# define Z_U4 unsigned short # endif #endif @@ -425,8 +422,16 @@ typedef uLong FAR uLongf; # endif #endif +#if defined(STDC) || defined(Z_HAVE_STDARG_H) +# ifndef Z_SOLO +# include <stdarg.h> /* for va_list */ +# endif +#endif + #ifdef _WIN32 -# include <stddef.h> /* for wchar_t */ +# ifndef Z_SOLO +# include <stddef.h> /* for wchar_t */ +# endif #endif /* a little trick to accommodate both "#define _LARGEFILE64_SOURCE" and @@ -435,7 +440,7 @@ typedef uLong FAR uLongf; * both "#undef _LARGEFILE64_SOURCE" and "#define _LARGEFILE64_SOURCE 0" as * equivalently requesting no 64-bit operations */ -#if defined(LARGEFILE64_SOURCE) && -_LARGEFILE64_SOURCE - -1 == 1 +#if defined(_LARGEFILE64_SOURCE) && -_LARGEFILE64_SOURCE - -1 == 1 # undef _LARGEFILE64_SOURCE #endif @@ -443,7 +448,7 @@ typedef uLong FAR uLongf; # define Z_HAVE_UNISTD_H #endif #ifndef Z_SOLO -# if defined(Z_HAVE_UNISTD_H) || defined(LARGEFILE64_SOURCE) +# if defined(Z_HAVE_UNISTD_H) || defined(_LARGEFILE64_SOURCE) # include <unistd.h> /* for SEEK_*, off_t, and _LFS64_LARGEFILE */ # ifdef VMS # include <unixio.h> /* for off_t */ diff --git a/compat/zlib/zlib.3 b/compat/zlib/zlib.3 index 79d3402..0160e62 100644 --- a/compat/zlib/zlib.3 +++ b/compat/zlib/zlib.3 @@ -1,4 +1,4 @@ -.TH ZLIB 3 "2 May 2012" +.TH ZLIB 3 "28 Apr 2013" .SH NAME zlib \- compression/decompression library .SH SYNOPSIS @@ -125,8 +125,8 @@ before asking for help. Send questions and/or comments to zlib@gzip.org, or (for the Windows DLL version) to Gilles Vollant (info@winimage.com). .SH AUTHORS -Version 1.2.7 -Copyright (C) 1995-2012 Jean-loup Gailly (jloup@gzip.org) +Version 1.2.8 +Copyright (C) 1995-2013 Jean-loup Gailly (jloup@gzip.org) and Mark Adler (madler@alumni.caltech.edu). .LP This software is provided "as-is," diff --git a/compat/zlib/zlib.3.pdf b/compat/zlib/zlib.3.pdf Binary files differindex 485306c..a346b5d 100644 --- a/compat/zlib/zlib.3.pdf +++ b/compat/zlib/zlib.3.pdf diff --git a/compat/zlib/zlib.h b/compat/zlib/zlib.h index 3edf3ac..3e0c767 100644 --- a/compat/zlib/zlib.h +++ b/compat/zlib/zlib.h @@ -1,7 +1,7 @@ /* zlib.h -- interface of the 'zlib' general purpose compression library - version 1.2.7, May 2nd, 2012 + version 1.2.8, April 28th, 2013 - Copyright (C) 1995-2012 Jean-loup Gailly and Mark Adler + Copyright (C) 1995-2013 Jean-loup Gailly and Mark Adler This software is provided 'as-is', without any express or implied warranty. In no event will the authors be held liable for any damages @@ -37,11 +37,11 @@ extern "C" { #endif -#define ZLIB_VERSION "1.2.7" -#define ZLIB_VERNUM 0x1270 +#define ZLIB_VERSION "1.2.8" +#define ZLIB_VERNUM 0x1280 #define ZLIB_VER_MAJOR 1 #define ZLIB_VER_MINOR 2 -#define ZLIB_VER_REVISION 7 +#define ZLIB_VER_REVISION 8 #define ZLIB_VER_SUBREVISION 0 /* @@ -839,6 +839,21 @@ ZEXTERN int ZEXPORT inflateSetDictionary OF((z_streamp strm, inflate(). */ +ZEXTERN int ZEXPORT inflateGetDictionary OF((z_streamp strm, + Bytef *dictionary, + uInt *dictLength)); +/* + Returns the sliding dictionary being maintained by inflate. dictLength is + set to the number of bytes in the dictionary, and that many bytes are copied + to dictionary. dictionary must have enough space, where 32768 bytes is + always enough. If inflateGetDictionary() is called with dictionary equal to + Z_NULL, then only the dictionary length is returned, and nothing is copied. + Similary, if dictLength is Z_NULL, then it is not set. + + inflateGetDictionary returns Z_OK on success, or Z_STREAM_ERROR if the + stream state is inconsistent. +*/ + ZEXTERN int ZEXPORT inflateSync OF((z_streamp strm)); /* Skips invalid compressed data until a possible full flush point (see above @@ -846,7 +861,7 @@ ZEXTERN int ZEXPORT inflateSync OF((z_streamp strm)); available input is skipped. No output is provided. inflateSync searches for a 00 00 FF FF pattern in the compressed data. - All full flush points have this pattern, but not all occurences of this + All full flush points have this pattern, but not all occurrences of this pattern are full flush points. inflateSync returns Z_OK if a possible full flush point has been found, @@ -1007,7 +1022,8 @@ ZEXTERN int ZEXPORT inflateBackInit OF((z_streamp strm, int windowBits, the version of the header file. */ -typedef unsigned (*in_func) OF((void FAR *, unsigned char FAR * FAR *)); +typedef unsigned (*in_func) OF((void FAR *, + z_const unsigned char FAR * FAR *)); typedef int (*out_func) OF((void FAR *, unsigned char FAR *, unsigned)); ZEXTERN int ZEXPORT inflateBack OF((z_streamp strm, @@ -1015,11 +1031,12 @@ ZEXTERN int ZEXPORT inflateBack OF((z_streamp strm, out_func out, void FAR *out_desc)); /* inflateBack() does a raw inflate with a single call using a call-back - interface for input and output. This is more efficient than inflate() for - file i/o applications in that it avoids copying between the output and the - sliding window by simply making the window itself the output buffer. This - function trusts the application to not change the output buffer passed by - the output function, at least until inflateBack() returns. + interface for input and output. This is potentially more efficient than + inflate() for file i/o applications, in that it avoids copying between the + output and the sliding window by simply making the window itself the output + buffer. inflate() can be faster on modern CPUs when used with large + buffers. inflateBack() trusts the application to not change the output + buffer passed by the output function, at least until inflateBack() returns. inflateBackInit() must be called first to allocate the internal state and to initialize the state with the user-provided window buffer. @@ -1736,6 +1753,13 @@ ZEXTERN int ZEXPORT deflateResetKeep OF((z_streamp)); ZEXTERN gzFile ZEXPORT gzopen_w OF((const wchar_t *path, const char *mode)); #endif +#if defined(STDC) || defined(Z_HAVE_STDARG_H) +# ifndef Z_SOLO +ZEXTERN int ZEXPORTVA gzvprintf Z_ARG((gzFile file, + const char *format, + va_list va)); +# endif +#endif #ifdef __cplusplus } diff --git a/compat/zlib/zlib.map b/compat/zlib/zlib.map index 771f420..55c6647 100644 --- a/compat/zlib/zlib.map +++ b/compat/zlib/zlib.map @@ -76,3 +76,8 @@ ZLIB_1.2.5.2 { gzgetc_; inflateResetKeep; } ZLIB_1.2.5.1; + +ZLIB_1.2.7.1 { + inflateGetDictionary; + gzvprintf; +} ZLIB_1.2.5.2; diff --git a/compat/zlib/zutil.c b/compat/zlib/zutil.c index 65e0d3b..23d2ebe 100644 --- a/compat/zlib/zutil.c +++ b/compat/zlib/zutil.c @@ -14,7 +14,7 @@ struct internal_state {int dummy;}; /* for buggy compilers */ #endif -const char * const z_errmsg[10] = { +z_const char * const z_errmsg[10] = { "need dictionary", /* Z_NEED_DICT 2 */ "stream end", /* Z_STREAM_END 1 */ "", /* Z_OK 0 */ diff --git a/compat/zlib/zutil.h b/compat/zlib/zutil.h index 4e3dcc6..24ab06b 100644 --- a/compat/zlib/zutil.h +++ b/compat/zlib/zutil.h @@ -1,5 +1,5 @@ /* zutil.h -- internal interface and configuration of the compression library - * Copyright (C) 1995-2012 Jean-loup Gailly. + * Copyright (C) 1995-2013 Jean-loup Gailly. * For conditions of distribution and use, see copyright notice in zlib.h */ @@ -44,13 +44,13 @@ typedef unsigned short ush; typedef ush FAR ushf; typedef unsigned long ulg; -extern const char * const z_errmsg[10]; /* indexed by 2-zlib_error */ +extern z_const char * const z_errmsg[10]; /* indexed by 2-zlib_error */ /* (size given to avoid silly warnings with Visual C++) */ #define ERR_MSG(err) z_errmsg[Z_NEED_DICT-(err)] #define ERR_RETURN(strm,err) \ - return (strm->msg = (char*)ERR_MSG(err), (err)) + return (strm->msg = ERR_MSG(err), (err)) /* To be used only when the state is known to be valid */ /* common constants */ @@ -168,7 +168,8 @@ extern const char * const z_errmsg[10]; /* indexed by 2-zlib_error */ #endif /* provide prototypes for these when building zlib without LFS */ -#if !defined(_WIN32) && (!defined(_LARGEFILE64_SOURCE) || _LFS64_LARGEFILE-0 == 0) +#if !defined(_WIN32) && \ + (!defined(_LARGEFILE64_SOURCE) || _LFS64_LARGEFILE-0 == 0) ZEXTERN uLong ZEXPORT adler32_combine64 OF((uLong, uLong, z_off_t)); ZEXTERN uLong ZEXPORT crc32_combine64 OF((uLong, uLong, z_off_t)); #endif diff --git a/doc/Access.3 b/doc/Access.3 index 1e82e07..668e1db 100644 --- a/doc/Access.3 +++ b/doc/Access.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Access 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_Access, Tcl_Stat \- check file permissions and other attributes diff --git a/doc/AddErrInfo.3 b/doc/AddErrInfo.3 index b9c6a63..d4bf7d5 100644 --- a/doc/AddErrInfo.3 +++ b/doc/AddErrInfo.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_AddErrorInfo 3 8.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_GetReturnOptions, Tcl_SetReturnOptions, Tcl_AddErrorInfo, Tcl_AppendObjToErrorInfo, Tcl_AddObjErrorInfo, Tcl_SetObjErrorCode, Tcl_SetErrorCode, Tcl_SetErrorCodeVA, Tcl_SetErrorLine, Tcl_GetErrorLine, Tcl_PosixError, Tcl_LogCommandInfo \- retrieve or record information about errors and other return options @@ -176,16 +176,16 @@ these return options. The \fB\-errorinfo\fR option holds a stack trace of the operations that were in progress when an error occurred, and is intended to be human-readable. -The \fB\-errorcode\fR option holds a list of items that +The \fB\-errorcode\fR option holds a Tcl list of items that are intended to be machine-readable. The first item in the \fB\-errorcode\fR value identifies the class of error that occurred -(e.g. POSIX means an error occurred in a POSIX system call) +(e.g., POSIX means an error occurred in a POSIX system call) and additional elements hold additional pieces of information that depend on the class. -See the \fBtclvars\fR manual entry for details on the various -formats for the \fB\-errorcode\fR option used by -Tcl's built-in commands. +See the manual entry on the \fBerrorCode\fR variable for details on the +various formats for the \fB\-errorcode\fR option used by Tcl's built-in +commands. .PP The \fB\-errorinfo\fR option value is gradually built up as an error unwinds through the nested operations. @@ -307,6 +307,6 @@ so they continue to hold a record of information about the most recent error seen in an interpreter. .SH "SEE ALSO" Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_Interp(3), Tcl_ResetResult(3), -Tcl_SetErrno(3), tclvars(n) +Tcl_SetErrno(3), errorCode(n), errorInfo(n) .SH KEYWORDS error, value, value result, stack, trace, variable diff --git a/doc/Alloc.3 b/doc/Alloc.3 index ca4f949..585704a 100644 --- a/doc/Alloc.3 +++ b/doc/Alloc.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Alloc 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc, ckalloc, ckfree, ckrealloc, attemptckalloc, attemptckrealloc \- allocate or free heap memory diff --git a/doc/AllowExc.3 b/doc/AllowExc.3 index ae595f1..2343e66 100644 --- a/doc/AllowExc.3 +++ b/doc/AllowExc.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_AllowExceptions 3 7.4 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_AllowExceptions \- allow all exceptions in next script evaluation diff --git a/doc/AppInit.3 b/doc/AppInit.3 index e4ae971..3e47c1f 100644 --- a/doc/AppInit.3 +++ b/doc/AppInit.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_AppInit 3 7.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_AppInit \- perform application-specific initialization diff --git a/doc/AssocData.3 b/doc/AssocData.3 index 59c26a4..f819acb 100644 --- a/doc/AssocData.3 +++ b/doc/AssocData.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_SetAssocData 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_GetAssocData, Tcl_SetAssocData, Tcl_DeleteAssocData \- manage associations of string keys and user specified data with Tcl interpreters diff --git a/doc/Async.3 b/doc/Async.3 index d02f76d..558b511 100644 --- a/doc/Async.3 +++ b/doc/Async.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_AsyncCreate 3 7.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_AsyncCreate, Tcl_AsyncMark, Tcl_AsyncInvoke, Tcl_AsyncDelete, Tcl_AsyncReady \- handle asynchronous events diff --git a/doc/BackgdErr.3 b/doc/BackgdErr.3 index 3116671..4ebcb60 100644 --- a/doc/BackgdErr.3 +++ b/doc/BackgdErr.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_BackgroundError 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_BackgroundException, Tcl_BackgroundError \- report Tcl exception that occurred in background processing diff --git a/doc/Backslash.3 b/doc/Backslash.3 index 8b399fc..f121c7c 100644 --- a/doc/Backslash.3 +++ b/doc/Backslash.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Backslash 3 "8.1" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_Backslash \- parse a backslash sequence diff --git a/doc/BoolObj.3 b/doc/BoolObj.3 index 6691140..5c8414d 100644 --- a/doc/BoolObj.3 +++ b/doc/BoolObj.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_BooleanObj 3 8.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_NewBooleanObj, Tcl_SetBooleanObj, Tcl_GetBooleanFromObj \- store/retrieve boolean value in a Tcl_Obj diff --git a/doc/ByteArrObj.3 b/doc/ByteArrObj.3 index 2921f68..a1f9330 100644 --- a/doc/ByteArrObj.3 +++ b/doc/ByteArrObj.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_ByteArrayObj 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_NewByteArrayObj, Tcl_SetByteArrayObj, Tcl_GetByteArrayFromObj, Tcl_SetByteArrayLength \- manipulate Tcl values as a arrays of bytes diff --git a/doc/CallDel.3 b/doc/CallDel.3 index dec4392..766621a 100644 --- a/doc/CallDel.3 +++ b/doc/CallDel.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CallWhenDeleted 3 7.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CallWhenDeleted, Tcl_DontCallWhenDeleted \- Arrange for callback when interpreter is deleted diff --git a/doc/Cancel.3 b/doc/Cancel.3 index 80db3a3..5d258b7 100644 --- a/doc/Cancel.3 +++ b/doc/Cancel.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Cancel 3 8.6 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CancelEval, Tcl_Canceled \- cancel Tcl scripts diff --git a/doc/ChnlStack.3 b/doc/ChnlStack.3 index 9ec38b4..b046cd2 100644 --- a/doc/ChnlStack.3 +++ b/doc/ChnlStack.3 @@ -3,8 +3,8 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -.so man.macros .TH Tcl_StackChannel 3 8.3 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/Class.3 b/doc/Class.3 index 28cea9b..7e421fe 100644 --- a/doc/Class.3 +++ b/doc/Class.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Class 3 0.1 TclOO "TclOO Library Functions" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -111,7 +111,7 @@ function. Note that the Tcl_Obj reference returned by \fBTcl_GetObjectName\fR is a shared reference. .PP Instances of classes are created using \fBTcl_NewObjectInstance\fR, which -takes creates an object from any class (and which is internally called by both +creates an object from any class (and which is internally called by both the \fBcreate\fR and \fBnew\fR methods of the \fBoo::class\fR class). It takes parameters that optionally give the name of the object and namespace to create, and which describe the arguments to pass to the class's constructor diff --git a/doc/CmdCmplt.3 b/doc/CmdCmplt.3 index eeae039..25b372e 100644 --- a/doc/CmdCmplt.3 +++ b/doc/CmdCmplt.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CommandComplete 3 "" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CommandComplete \- Check for unmatched braces in a Tcl command diff --git a/doc/Concat.3 b/doc/Concat.3 index c38bf82..58a0fb6 100644 --- a/doc/Concat.3 +++ b/doc/Concat.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Concat 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_Concat \- concatenate a collection of strings diff --git a/doc/CrtChannel.3 b/doc/CrtChannel.3 index 55a4024..1c5c665 100644 --- a/doc/CrtChannel.3 +++ b/doc/CrtChannel.3 @@ -4,8 +4,8 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -.so man.macros .TH Tcl_CreateChannel 3 8.4 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -250,8 +250,8 @@ the default value of 4096 is returned. .PP \fBTcl_SetChannelBufferSize\fR sets the size, in bytes, of buffers that will be allocated in subsequent operations on the channel to store input or -output. The \fIsize\fR argument should be between ten and one million, -allowing buffers of ten bytes to one million bytes. If \fIsize\fR is +output. The \fIsize\fR argument should be between one and one million, +allowing buffers of one byte to one million bytes. If \fIsize\fR is outside this range, \fBTcl_SetChannelBufferSize\fR sets the buffer size to 4096. .PP diff --git a/doc/CrtChnlHdlr.3 b/doc/CrtChnlHdlr.3 index 1451e30..0ecd3c9 100644 --- a/doc/CrtChnlHdlr.3 +++ b/doc/CrtChnlHdlr.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CreateChannelHandler 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/CrtCloseHdlr.3 b/doc/CrtCloseHdlr.3 index a114f9c..bac2431 100644 --- a/doc/CrtCloseHdlr.3 +++ b/doc/CrtCloseHdlr.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CreateCloseHandler 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/CrtCommand.3 b/doc/CrtCommand.3 index c921999..fca64ce 100644 --- a/doc/CrtCommand.3 +++ b/doc/CrtCommand.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CreateCommand 3 "" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CreateCommand \- implement new commands in C diff --git a/doc/CrtFileHdlr.3 b/doc/CrtFileHdlr.3 index cbc5e9f..c1bc1fa 100644 --- a/doc/CrtFileHdlr.3 +++ b/doc/CrtFileHdlr.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CreateFileHandler 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CreateFileHandler, Tcl_DeleteFileHandler \- associate procedure callbacks with files or devices (Unix only) diff --git a/doc/CrtInterp.3 b/doc/CrtInterp.3 index a248cf4..679795e 100644 --- a/doc/CrtInterp.3 +++ b/doc/CrtInterp.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CreateInterp 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CreateInterp, Tcl_DeleteInterp, Tcl_InterpActive, Tcl_InterpDeleted \- create and delete Tcl command interpreters @@ -41,8 +41,9 @@ may only be passed to Tcl routines called from the same thread as the original \fBTcl_CreateInterp\fR call. It is not safe for multiple threads to pass the same token to Tcl's routines. The new interpreter is initialized with the built-in Tcl commands -and with the variables documented in the \fBtclvars\fR manual page. To bind in -additional commands, call \fBTcl_CreateCommand\fR. +and with standard variables like \fBtcl_platform\fR and \fBenv\fR. To +bind in additional commands, call \fBTcl_CreateCommand\fR, and to +create additional variables, call \fBTcl_SetVar\fR. .PP \fBTcl_DeleteInterp\fR marks an interpreter as deleted; the interpreter will eventually be deleted when all calls to \fBTcl_Preserve\fR for it have @@ -144,6 +145,6 @@ should be used to determine when an interpreter is a candidate for deletion due to inactivity. .VE 8.6 .SH "SEE ALSO" -Tcl_Preserve(3), Tcl_Release(3), tclvars(n) +Tcl_Preserve(3), Tcl_Release(3) .SH KEYWORDS command, create, delete, interpreter diff --git a/doc/CrtMathFnc.3 b/doc/CrtMathFnc.3 index cdde20b..84cde65 100644 --- a/doc/CrtMathFnc.3 +++ b/doc/CrtMathFnc.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CreateMathFunc 3 8.4 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CreateMathFunc, Tcl_GetMathFuncInfo, Tcl_ListMathFuncs \- Define, query and enumerate math functions for expressions diff --git a/doc/CrtObjCmd.3 b/doc/CrtObjCmd.3 index faf8b74..e94c8cd 100644 --- a/doc/CrtObjCmd.3 +++ b/doc/CrtObjCmd.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CreateObjCommand 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj \- implement new commands in C diff --git a/doc/CrtSlave.3 b/doc/CrtSlave.3 index 000ae58..fdcef6f 100644 --- a/doc/CrtSlave.3 +++ b/doc/CrtSlave.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CreateSlave 3 7.6 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_IsSafe, Tcl_MakeSafe, Tcl_CreateSlave, Tcl_GetSlave, Tcl_GetMaster, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands diff --git a/doc/CrtTimerHdlr.3 b/doc/CrtTimerHdlr.3 index 2c9f90a..f3957c7 100644 --- a/doc/CrtTimerHdlr.3 +++ b/doc/CrtTimerHdlr.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CreateTimerHandler 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CreateTimerHandler, Tcl_DeleteTimerHandler \- call a procedure at a given time diff --git a/doc/CrtTrace.3 b/doc/CrtTrace.3 index 3689add..239941f 100644 --- a/doc/CrtTrace.3 +++ b/doc/CrtTrace.3 @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CreateTrace 3 "" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CreateTrace, Tcl_CreateObjTrace, Tcl_DeleteTrace \- arrange for command execution to be traced diff --git a/doc/DString.3 b/doc/DString.3 index a85b1cf..0e571d2 100644 --- a/doc/DString.3 +++ b/doc/DString.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_DString 3 7.4 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringTrunc, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings diff --git a/doc/DetachPids.3 b/doc/DetachPids.3 index 0535cd8..39a51d3 100644 --- a/doc/DetachPids.3 +++ b/doc/DetachPids.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_DetachPids 3 "" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_DetachPids, Tcl_ReapDetachedProcs, Tcl_WaitPid \- manage child processes in background diff --git a/doc/DictObj.3 b/doc/DictObj.3 index db8f39a..90ca9e3 100644 --- a/doc/DictObj.3 +++ b/doc/DictObj.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_DictObj 3 8.5 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/DoOneEvent.3 b/doc/DoOneEvent.3 index 9bdf926..6f08b34 100644 --- a/doc/DoOneEvent.3 +++ b/doc/DoOneEvent.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_DoOneEvent 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_DoOneEvent \- wait for events and invoke event handlers diff --git a/doc/DoWhenIdle.3 b/doc/DoWhenIdle.3 index 27a4b8c..3e28b4d 100644 --- a/doc/DoWhenIdle.3 +++ b/doc/DoWhenIdle.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_DoWhenIdle 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_DoWhenIdle, Tcl_CancelIdleCall \- invoke a procedure when there are no pending events diff --git a/doc/DoubleObj.3 b/doc/DoubleObj.3 index f811c89..4b422d4 100644 --- a/doc/DoubleObj.3 +++ b/doc/DoubleObj.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_DoubleObj 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_NewDoubleObj, Tcl_SetDoubleObj, Tcl_GetDoubleFromObj \- manipulate Tcl values as floating-point values diff --git a/doc/DumpActiveMemory.3 b/doc/DumpActiveMemory.3 index 1f6cb46..f4d78d1 100644 --- a/doc/DumpActiveMemory.3 +++ b/doc/DumpActiveMemory.3 @@ -3,8 +3,8 @@ '\" Copyright (c) 2000 by Scriptics Corporation. '\" All rights reserved. '\" -.so man.macros .TH "Tcl_DumpActiveMemory" 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_DumpActiveMemory, Tcl_InitMemory, Tcl_ValidateAllMemory \- Validated memory allocation interface diff --git a/doc/Encoding.3 b/doc/Encoding.3 index 7bcb285..1478c35 100644 --- a/doc/Encoding.3 +++ b/doc/Encoding.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_GetEncoding 3 "8.1" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_WinTCharToUtf, Tcl_WinUtfToTChar, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath, Tcl_GetDefaultEncodingDir, Tcl_SetDefaultEncodingDir \- procedures for creating and using encodings diff --git a/doc/Ensemble.3 b/doc/Ensemble.3 index cd69bbd..8457ddc 100644 --- a/doc/Ensemble.3 +++ b/doc/Ensemble.3 @@ -6,8 +6,8 @@ '\" '\" This documents the C API introduced in TIP#235 '\" -.so man.macros .TH Tcl_Ensemble 3 8.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CreateEnsemble, Tcl_FindEnsemble, Tcl_GetEnsembleFlags, Tcl_GetEnsembleMappingDict, Tcl_GetEnsembleNamespace, Tcl_GetEnsembleParameterList, Tcl_GetEnsembleUnknownHandler, Tcl_GetEnsembleSubcommandList, Tcl_IsEnsemble, Tcl_SetEnsembleFlags, Tcl_SetEnsembleMappingDict, Tcl_SetEnsembleParameterList, Tcl_SetEnsembleSubcommandList, Tcl_SetEnsembleUnknownHandler \- manipulate ensemble commands diff --git a/doc/Environment.3 b/doc/Environment.3 index 3753f43..85880b4 100644 --- a/doc/Environment.3 +++ b/doc/Environment.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_PutEnv 3 "7.5" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_PutEnv \- procedures to manipulate the environment @@ -33,6 +33,6 @@ Tcl-based applications using \fBputenv\fR should redefine it to \fBTcl_PutEnv\fR so that they will interface properly to the Tcl runtime. .SH "SEE ALSO" -tclvars(n) +env(n) .SH KEYWORDS environment, variable @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Eval 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_EvalObjEx, Tcl_EvalFile, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx, Tcl_GlobalEval, Tcl_GlobalEvalObj, Tcl_VarEval, Tcl_VarEvalVA \- execute Tcl scripts @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Exit 3 8.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_Exit, Tcl_Finalize, Tcl_CreateExitHandler, Tcl_DeleteExitHandler, Tcl_ExitThread, Tcl_FinalizeThread, Tcl_CreateThreadExitHandler, Tcl_DeleteThreadExitHandler, Tcl_SetExitProc \- end the application or thread (and invoke exit handlers) diff --git a/doc/ExprLong.3 b/doc/ExprLong.3 index 4fa972e..1615f88 100644 --- a/doc/ExprLong.3 +++ b/doc/ExprLong.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_ExprLong 3 7.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean, Tcl_ExprString \- evaluate an expression diff --git a/doc/ExprLongObj.3 b/doc/ExprLongObj.3 index 686c1cb..35edb5f 100644 --- a/doc/ExprLongObj.3 +++ b/doc/ExprLongObj.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_ExprLongObj 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_ExprLongObj, Tcl_ExprDoubleObj, Tcl_ExprBooleanObj, Tcl_ExprObj \- evaluate an expression diff --git a/doc/FileSystem.3 b/doc/FileSystem.3 index dd9eb77..6a8158c 100644 --- a/doc/FileSystem.3 +++ b/doc/FileSystem.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Filesystem 3 8.4 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_FSRegister, Tcl_FSUnregister, Tcl_FSData, Tcl_FSMountsChanged, Tcl_FSGetFileSystemForPath, Tcl_FSGetPathType, Tcl_FSCopyFile, Tcl_FSCopyDirectory, Tcl_FSCreateDirectory, Tcl_FSDeleteFile, Tcl_FSRemoveDirectory, Tcl_FSRenameFile, Tcl_FSListVolumes, Tcl_FSEvalFile, Tcl_FSEvalFileEx, Tcl_FSLoadFile, Tcl_FSUnloadFile, Tcl_FSMatchInDirectory, Tcl_FSLink, Tcl_FSLstat, Tcl_FSUtime, Tcl_FSFileAttrsGet, Tcl_FSFileAttrsSet, Tcl_FSFileAttrStrings, Tcl_FSStat, Tcl_FSAccess, Tcl_FSOpenFileChannel, Tcl_FSGetCwd, Tcl_FSChdir, Tcl_FSPathSeparator, Tcl_FSJoinPath, Tcl_FSSplitPath, Tcl_FSEqualPaths, Tcl_FSGetNormalizedPath, Tcl_FSJoinToPath, Tcl_FSConvertToPathType, Tcl_FSGetInternalRep, Tcl_FSGetTranslatedPath, Tcl_FSGetTranslatedStringPath, Tcl_FSNewNativePath, Tcl_FSGetNativePath, Tcl_FSFileSystemInfo, Tcl_GetAccessTimeFromStat, Tcl_GetBlockSizeFromStat, Tcl_GetBlocksFromStat, Tcl_GetChangeTimeFromStat, Tcl_GetDeviceTypeFromStat, Tcl_GetFSDeviceFromStat, Tcl_GetFSInodeFromStat, Tcl_GetGroupIdFromStat, Tcl_GetLinkCountFromStat, Tcl_GetModeFromStat, Tcl_GetModificationTimeFromStat, Tcl_GetSizeFromStat, Tcl_GetUserIdFromStat, Tcl_AllocStatBuf \- procedures to interact with any filesystem diff --git a/doc/FindExec.3 b/doc/FindExec.3 index e4b4ed0..b01315c 100644 --- a/doc/FindExec.3 +++ b/doc/FindExec.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_FindExecutable 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_FindExecutable, Tcl_GetNameOfExecutable \- identify or return the name of the binary file containing the application diff --git a/doc/GetCwd.3 b/doc/GetCwd.3 index 964e237..58abcde 100755 --- a/doc/GetCwd.3 +++ b/doc/GetCwd.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_GetCwd 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_GetCwd, Tcl_Chdir \- manipulate the current working directory diff --git a/doc/GetHostName.3 b/doc/GetHostName.3 index 28f3a4f..8aed0dc 100644 --- a/doc/GetHostName.3 +++ b/doc/GetHostName.3 @@ -2,8 +2,8 @@ '\" Copyright (c) 1998-2000 by Scriptics Corporation. '\" All rights reserved. '\" -.so man.macros .TH Tcl_GetHostName 3 8.3 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_GetHostName \- get the name of the local host diff --git a/doc/GetIndex.3 b/doc/GetIndex.3 index d32561a..fc6f40b 100644 --- a/doc/GetIndex.3 +++ b/doc/GetIndex.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_GetIndexFromObj 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_GetIndexFromObj, Tcl_GetIndexFromObjStruct \- lookup string in table of keywords diff --git a/doc/GetInt.3 b/doc/GetInt.3 index f77d337..4e9d636 100644 --- a/doc/GetInt.3 +++ b/doc/GetInt.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_GetInt 3 "" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_GetInt, Tcl_GetDouble, Tcl_GetBoolean \- convert from string to integer, double, or boolean diff --git a/doc/GetOpnFl.3 b/doc/GetOpnFl.3 index 38aa976..86d1b94 100644 --- a/doc/GetOpnFl.3 +++ b/doc/GetOpnFl.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_GetOpenFile 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_GetOpenFile \- Return a FILE* for a channel registered in the given interpreter (Unix only) diff --git a/doc/GetStdChan.3 b/doc/GetStdChan.3 index e76ad66..8af1e7e 100644 --- a/doc/GetStdChan.3 +++ b/doc/GetStdChan.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_GetStdChannel 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/GetTime.3 b/doc/GetTime.3 index f4da364..6b885ee 100644 --- a/doc/GetTime.3 +++ b/doc/GetTime.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_GetTime 3 8.4 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_GetTime, Tcl_SetTimeProc, Tcl_QueryTimeProc \- get date and time diff --git a/doc/GetVersion.3 b/doc/GetVersion.3 index 47034d0..89f63d5 100755 --- a/doc/GetVersion.3 +++ b/doc/GetVersion.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_GetVersion 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_GetVersion \- get the version of the library at runtime @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Hash 3 "" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_InitHashTable, Tcl_InitCustomHashTable, Tcl_InitObjHashTable, Tcl_DeleteHashTable, Tcl_CreateHashEntry, Tcl_DeleteHashEntry, Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_SetHashValue, Tcl_GetHashKey, Tcl_FirstHashEntry, Tcl_NextHashEntry, Tcl_HashStats \- procedures to manage hash tables @@ -2,8 +2,8 @@ '\" Copyright (c) 1998-2000 by Scriptics Corporation. '\" All rights reserved. '\" -.so man.macros .TH Tcl_Init 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_Init \- find and source initialization script diff --git a/doc/InitStubs.3 b/doc/InitStubs.3 index 5f56278..73c3437 100644 --- a/doc/InitStubs.3 +++ b/doc/InitStubs.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_InitStubs 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_InitStubs \- initialize the Tcl stubs mechanism @@ -63,9 +63,9 @@ Define the \fBUSE_TCL_STUBS\fR symbol. Typically, you would include the \fB\-DUSE_TCL_STUBS\fR flag when compiling the extension. .IP 3) 5 Link the extension with the Tcl stubs library instead of the standard -Tcl library. For example, to use the Tcl 8.1 ABI on Unix platforms, -the library name is \fIlibtclstub8.1.a\fR; on Windows platforms, the -library name is \fItclstub81.lib\fR. +Tcl library. For example, to use the Tcl 8.6 ABI on Unix platforms, +the library name is \fIlibtclstub8.6.a\fR; on Windows platforms, the +library name is \fItclstub86.lib\fR. .PP If the extension also requires the Tk API, it must also call \fBTk_InitStubs\fR to initialize the Tk stubs interface and link diff --git a/doc/IntObj.3 b/doc/IntObj.3 index 4b7b8a6..d42b44a 100644 --- a/doc/IntObj.3 +++ b/doc/IntObj.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_IntObj 3 8.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_GetIntFromObj, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers diff --git a/doc/Interp.3 b/doc/Interp.3 index d908057..b639add 100644 --- a/doc/Interp.3 +++ b/doc/Interp.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Interp 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_Interp \- client-visible fields of interpreter structures diff --git a/doc/Limit.3 b/doc/Limit.3 index 2941ee8..20a2e02 100644 --- a/doc/Limit.3 +++ b/doc/Limit.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_LimitCheck 3 8.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_LimitAddHandler, Tcl_LimitCheck, Tcl_LimitExceeded, Tcl_LimitGetCommands, Tcl_LimitGetGranularity, Tcl_LimitGetTime, Tcl_LimitReady, Tcl_LimitRemoveHandler, Tcl_LimitSetCommands, Tcl_LimitSetGranularity, Tcl_LimitSetTime, Tcl_LimitTypeEnabled, Tcl_LimitTypeExceeded, Tcl_LimitTypeReset, Tcl_LimitTypeSet \- manage and check resource limits on interpreters diff --git a/doc/LinkVar.3 b/doc/LinkVar.3 index dc71a45..c64720b 100644 --- a/doc/LinkVar.3 +++ b/doc/LinkVar.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_LinkVar 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_LinkVar, Tcl_UnlinkVar, Tcl_UpdateLinkedVar \- link Tcl variable to C variable diff --git a/doc/ListObj.3 b/doc/ListObj.3 index bc6917d..3af0e7e 100644 --- a/doc/ListObj.3 +++ b/doc/ListObj.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_ListObj 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_ListObjAppendList, Tcl_ListObjAppendElement, Tcl_NewListObj, Tcl_SetListObj, Tcl_ListObjGetElements, Tcl_ListObjLength, Tcl_ListObjIndex, Tcl_ListObjReplace \- manipulate Tcl values as lists @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Load 3 8.6 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_LoadFile, Tcl_FindSymbol \- platform-independent dynamic library loading diff --git a/doc/Method.3 b/doc/Method.3 index 43b3609..550b64a 100644 --- a/doc/Method.3 +++ b/doc/Method.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Method 3 0.1 TclOO "TclOO Library Functions" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -172,8 +172,9 @@ typedef struct { .PP The \fIversion\fR field allows for future expansion of the structure, and should always be declared equal to TCL_OO_METHOD_VERSION_CURRENT. The -\fIname\fR field provides a human-readable name for the type, and is reserved -for debugging. +\fIname\fR field provides a human-readable name for the type, and is the value +that is exposed via the \fBinfo class methodtype\fR and +\fBinfo object methodtype\fR Tcl commands. .PP The \fIcallProc\fR field gives a function that is called when the method is invoked; it must never be NULL. @@ -4,11 +4,11 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH NRE 3 8.6 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME -Tcl_NRCreateCommand, Tcl_NRCallObjProc, Tcl_NREvalObj, Tcl_NREvalObjv, Tcl_NRCmdSwap, Tcl_NRAddCallback \- Non-Recursive (stackless) evaluation of Tcl scripts. +Tcl_NRCreateCommand, Tcl_NRCallObjProc, Tcl_NREvalObj, Tcl_NREvalObjv, Tcl_NRCmdSwap, Tcl_NRExprObj, Tcl_NRAddCallback \- Non-Recursive (stackless) evaluation of Tcl scripts. .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -144,7 +144,7 @@ resolution is already known. The \fIcmd\fR parameter gives a \fBTcl_Command\fR token (returned from \fBTcl_CreateObjCommand\fR or \fBTcl_GetCommandFromObj\fR) identifying the command to be invoked in the trampoline; this command must match the word in \fIobjv[0]\fR. -The remaining arguments are as for \fBTcl_NREvalObj\fR. +The remaining arguments are as for \fBTcl_NREvalObjv\fR. .PP \fBTcl_NREvalObj\fR, \fBTcl_NREvalObjv\fR and \fBTcl_NRCmdSwap\fR all accept a \fIflags\fR parameter, which is an OR-ed-together set of @@ -207,7 +207,7 @@ is something like: .PP .CS int -\fITheCmdObjProc\fR( +\fITheCmdOldObjProc\fR( ClientData clientData, Tcl_Interp *interp, int objc, @@ -225,7 +225,7 @@ int return result; } \fBTcl_CreateObjCommand\fR(interp, "theCommand", - \fITheCmdObjProc\fR, clientData, TheCmdDeleteProc); + \fITheCmdOldObjProc\fR, clientData, TheCmdDeleteProc); .CE .PP To enable a command like this one for trampoline-based evaluation, @@ -255,8 +255,8 @@ int int objc, Tcl_Obj *const objv[]) { - return \fBTcl_NRCallObjProc\fR(interp, name, - \fITheCmdNRObjProc\fR, clientData, objc, objv); + return \fBTcl_NRCallObjProc\fR(interp, \fITheCmdNRObjProc\fR, + clientData, objc, objv); } .CE .PP @@ -317,7 +317,7 @@ and the second is for use when there is already a trampoline in place. .PP .CS \fBTcl_NRCreateCommand\fR(interp, "theCommand", - \fITheCmdObjProc\fR, \fITheCmdNRObjProc\fR, clientData, + \fITheCmdNewObjProc\fR, \fITheCmdNRObjProc\fR, clientData, TheCmdDeleteProc); .CE .SH "SEE ALSO" diff --git a/doc/Namespace.3 b/doc/Namespace.3 index 2b47128..be89597 100644 --- a/doc/Namespace.3 +++ b/doc/Namespace.3 @@ -7,8 +7,8 @@ '\" Note that some of these functions do not seem to belong, but they '\" were all introduced with the same TIP (#139) '\" -.so man.macros .TH Tcl_Namespace 3 8.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_AppendExportList, Tcl_CreateNamespace, Tcl_DeleteNamespace, Tcl_Export, Tcl_FindCommand, Tcl_FindNamespace, Tcl_ForgetImport, Tcl_GetCurrentNamespace, Tcl_GetGlobalNamespace, Tcl_GetNamespaceUnknownHandler, Tcl_Import, Tcl_SetNamespaceUnknownHandler \- manipulate namespaces diff --git a/doc/Notifier.3 b/doc/Notifier.3 index f65d580..f2976b1 100644 --- a/doc/Notifier.3 +++ b/doc/Notifier.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Notifier 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CreateEventSource, Tcl_DeleteEventSource, Tcl_SetMaxBlockTime, Tcl_QueueEvent, Tcl_ThreadQueueEvent, Tcl_ThreadAlert, Tcl_GetCurrentThread, Tcl_DeleteEvents, Tcl_InitNotifier, Tcl_FinalizeNotifier, Tcl_WaitForEvent, Tcl_AlertNotifier, Tcl_SetTimer, Tcl_ServiceAll, Tcl_ServiceEvent, Tcl_GetServiceMode, Tcl_SetServiceMode, Tcl_ServiceModeHook, Tcl_SetNotifier \- the event queue and notifier interfaces diff --git a/doc/OOInitStubs.3 b/doc/OOInitStubs.3 new file mode 100644 index 0000000..bc42453 --- /dev/null +++ b/doc/OOInitStubs.3 @@ -0,0 +1,54 @@ +'\" +'\" Copyright (c) 2012 Donal K. Fellows +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.TH Tcl_OOInitStubs 3 1.0 TclOO "TclOO Library Functions" +.so man.macros +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +Tcl_OOInitStubs \- initialize library access to TclOO functionality +.SH SYNOPSIS +.nf +\fB#include <tclOO.h>\fR +.sp +const char * +\fBTcl_OOInitStubs\fR(\fIinterp\fR) +.fi +.SH ARGUMENTS +.AS Tcl_Interp *interp in +.AP Tcl_Interp *interp in +The Tcl interpreter that the TclOO API is integrated with and whose C +interface is going to be used. +.BE +.SH DESCRIPTION +.PP +When an extension library is going to use the C interface exposed by TclOO, it +should use \fBTcl_OOInitStubs\fR to initialize its access to that interface +from within its \fI*\fB_Init\fR (or \fI*\fB_SafeInit\fR) function, passing in +the \fIinterp\fR that was passed into that routine as context. If the result +of calling \fBTcl_OOInitStubs\fR is NULL, the initialization failed and an +error message will have been left in the interpreter's result. Otherwise, the +initialization succeeded and the TclOO API may thereafter be used; the +version of the TclOO API is returned. +.PP +When using this function, either the C #define symbol \fBUSE_TCLOO_STUBS\fR +should be defined and your library code linked against the Tcl stub library, +or that #define symbol should \fInot\fR be defined and your library code +linked against the Tcl main library directly. +.SH "BACKWARD COMPATIBILITY NOTE" +.PP +If you are linking against the Tcl 8.5 forward compatibility package for +TclOO, \fIonly\fR the stub-enabled configuration is supported and you should +also link against the TclOO independent stub library; that library is an +integrated part of the main Tcl stub library in Tcl 8.6. +.SH KEYWORDS +stubs +.SH "SEE ALSO" +Tcl_InitStubs(3) +.\" Local variables: +.\" mode: nroff +.\" fill-column: 78 +.\" End: diff --git a/doc/Object.3 b/doc/Object.3 index 3d52f61..55451ab 100644 --- a/doc/Object.3 +++ b/doc/Object.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Obj 3 8.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_NewObj, Tcl_DuplicateObj, Tcl_IncrRefCount, Tcl_DecrRefCount, Tcl_IsShared, Tcl_InvalidateStringRep \- manipulate Tcl values diff --git a/doc/ObjectType.3 b/doc/ObjectType.3 index ca2c7a0..424d560 100644 --- a/doc/ObjectType.3 +++ b/doc/ObjectType.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_ObjType 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_RegisterObjType, Tcl_GetObjType, Tcl_AppendAllObjTypes, Tcl_ConvertToType \- manipulate Tcl value types diff --git a/doc/OpenFileChnl.3 b/doc/OpenFileChnl.3 index 82f51ce..cca76c2 100644 --- a/doc/OpenFileChnl.3 +++ b/doc/OpenFileChnl.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_OpenFileChannel 3 8.3 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/OpenTcp.3 b/doc/OpenTcp.3 index 78ac70b..9fe2615 100644 --- a/doc/OpenTcp.3 +++ b/doc/OpenTcp.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_OpenTcpClient 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/Panic.3 b/doc/Panic.3 index 48aed2b..28d56fa 100644 --- a/doc/Panic.3 +++ b/doc/Panic.3 @@ -2,8 +2,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Panic 3 8.4 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/ParseArgs.3 b/doc/ParseArgs.3 index 1ceafe5..df0ad33 100644 --- a/doc/ParseArgs.3 +++ b/doc/ParseArgs.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_ParseArgsObjv 3 8.6 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_ParseArgsObjv \- parse arguments according to a tabular description diff --git a/doc/ParseCmd.3 b/doc/ParseCmd.3 index 5fd9b9c..7090dd3 100644 --- a/doc/ParseCmd.3 +++ b/doc/ParseCmd.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_ParseCommand 3 8.3 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokens, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions diff --git a/doc/PkgRequire.3 b/doc/PkgRequire.3 index d54d7af..5c9fdca 100644 --- a/doc/PkgRequire.3 +++ b/doc/PkgRequire.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_PkgRequire 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_PkgRequire, Tcl_PkgRequireEx, Tcl_PkgRequireProc, Tcl_PkgPresent, Tcl_PkgPresentEx, Tcl_PkgProvide, Tcl_PkgProvideEx \- package version control diff --git a/doc/Preserve.3 b/doc/Preserve.3 index 905a31d..970bded 100644 --- a/doc/Preserve.3 +++ b/doc/Preserve.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Preserve 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_Preserve, Tcl_Release, Tcl_EventuallyFree \- avoid freeing storage while it is being used diff --git a/doc/PrintDbl.3 b/doc/PrintDbl.3 index 99b0113..730794f 100644 --- a/doc/PrintDbl.3 +++ b/doc/PrintDbl.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_PrintDouble 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_PrintDouble \- Convert floating value to string diff --git a/doc/RecEvalObj.3 b/doc/RecEvalObj.3 index 44888f6..387cc44 100644 --- a/doc/RecEvalObj.3 +++ b/doc/RecEvalObj.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_RecordAndEvalObj 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_RecordAndEvalObj \- save command on history list before evaluating diff --git a/doc/RecordEval.3 b/doc/RecordEval.3 index a29f974..e1625ff 100644 --- a/doc/RecordEval.3 +++ b/doc/RecordEval.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_RecordAndEval 3 7.4 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_RecordAndEval \- save command on history list before evaluating diff --git a/doc/RegConfig.3 b/doc/RegConfig.3 index 063cc85..d73e3d7 100644 --- a/doc/RegConfig.3 +++ b/doc/RegConfig.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_RegisterConfig 3 8.4 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/RegExp.3 b/doc/RegExp.3 index 882976c..63f650b 100644 --- a/doc/RegExp.3 +++ b/doc/RegExp.3 @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_RegExpMatch 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_RegExpMatch, Tcl_RegExpCompile, Tcl_RegExpExec, Tcl_RegExpRange, Tcl_GetRegExpFromObj, Tcl_RegExpMatchObj, Tcl_RegExpExecObj, Tcl_RegExpGetInfo \- Pattern matching with regular expressions diff --git a/doc/SaveResult.3 b/doc/SaveResult.3 index 8eaf38f..557391d 100644 --- a/doc/SaveResult.3 +++ b/doc/SaveResult.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_SaveResult 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_SaveInterpState, Tcl_RestoreInterpState, Tcl_DiscardInterpState, Tcl_SaveResult, Tcl_RestoreResult, Tcl_DiscardResult \- save and restore an interpreter's state diff --git a/doc/SetChanErr.3 b/doc/SetChanErr.3 index 3d37f59..5bb86be 100644 --- a/doc/SetChanErr.3 +++ b/doc/SetChanErr.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_SetChannelError 3 8.5 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/SetErrno.3 b/doc/SetErrno.3 index 1735952..21648b1 100644 --- a/doc/SetErrno.3 +++ b/doc/SetErrno.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_SetErrno 3 8.3 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_SetErrno, Tcl_GetErrno, Tcl_ErrnoId, Tcl_ErrnoMsg \- manipulate errno to store and retrieve error codes diff --git a/doc/SetRecLmt.3 b/doc/SetRecLmt.3 index e38ba2f..904d4ab 100644 --- a/doc/SetRecLmt.3 +++ b/doc/SetRecLmt.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_SetRecursionLimit 3 7.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_SetRecursionLimit \- set maximum allowable nesting depth in interpreter diff --git a/doc/SetResult.3 b/doc/SetResult.3 index bbeedf1..1f86340 100644 --- a/doc/SetResult.3 +++ b/doc/SetResult.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_SetResult 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_SetObjResult, Tcl_GetObjResult, Tcl_SetResult, Tcl_GetStringResult, Tcl_AppendResult, Tcl_AppendResultVA, Tcl_AppendElement, Tcl_ResetResult, Tcl_TransferResult, Tcl_FreeResult \- manipulate Tcl result diff --git a/doc/SetVar.3 b/doc/SetVar.3 index 0605ff2..1bef20b 100644 --- a/doc/SetVar.3 +++ b/doc/SetVar.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_SetVar 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_SetVar2Ex, Tcl_SetVar, Tcl_SetVar2, Tcl_ObjSetVar2, Tcl_GetVar2Ex, Tcl_GetVar, Tcl_GetVar2, Tcl_ObjGetVar2, Tcl_UnsetVar, Tcl_UnsetVar2 \- manipulate Tcl variables diff --git a/doc/Signal.3 b/doc/Signal.3 index 5b12654..70b9d91 100644 --- a/doc/Signal.3 +++ b/doc/Signal.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_SignalId 3 8.3 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_SignalId, Tcl_SignalMsg \- Convert signal codes diff --git a/doc/Sleep.3 b/doc/Sleep.3 index 2423ba1..2d36697 100644 --- a/doc/Sleep.3 +++ b/doc/Sleep.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Sleep 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_Sleep \- delay execution for a given number of milliseconds diff --git a/doc/SourceRCFile.3 b/doc/SourceRCFile.3 index eabc47c..0afb66b 100644 --- a/doc/SourceRCFile.3 +++ b/doc/SourceRCFile.3 @@ -2,8 +2,8 @@ '\" Copyright (c) 1998-2000 by Scriptics Corporation. '\" All rights reserved. '\" -.so man.macros .TH Tcl_SourceRCFile 3 8.3 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_SourceRCFile \- source the Tcl rc file diff --git a/doc/SplitList.3 b/doc/SplitList.3 index 219dfc7..3439f2e 100644 --- a/doc/SplitList.3 +++ b/doc/SplitList.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_SplitList 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_SplitList, Tcl_Merge, Tcl_ScanElement, Tcl_ConvertElement, Tcl_ScanCountedElement, Tcl_ConvertCountedElement \- manipulate Tcl lists diff --git a/doc/SplitPath.3 b/doc/SplitPath.3 index 3fd92ac..19cee05 100644 --- a/doc/SplitPath.3 +++ b/doc/SplitPath.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_SplitPath 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_SplitPath, Tcl_JoinPath, Tcl_GetPathType \- manipulate platform-dependent file paths diff --git a/doc/StaticPkg.3 b/doc/StaticPkg.3 index fa6c32f..5700ea7 100644 --- a/doc/StaticPkg.3 +++ b/doc/StaticPkg.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_StaticPackage 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_StaticPackage \- make a statically linked package available via the 'load' command diff --git a/doc/StdChannels.3 b/doc/StdChannels.3 index b5b020e..651ad7d 100644 --- a/doc/StdChannels.3 +++ b/doc/StdChannels.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH "Standard Channels" 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/StrMatch.3 b/doc/StrMatch.3 index 5adaf6e..f9c2be3 100644 --- a/doc/StrMatch.3 +++ b/doc/StrMatch.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_StringMatch 3 8.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_StringMatch, Tcl_StringCaseMatch \- test whether a string matches a pattern diff --git a/doc/StringObj.3 b/doc/StringObj.3 index e6f9d32..d81f23d 100644 --- a/doc/StringObj.3 +++ b/doc/StringObj.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_StringObj 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendStringsToObjVA, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj \- manipulate Tcl values as strings diff --git a/doc/SubstObj.3 b/doc/SubstObj.3 index d5a52c3..f582c5a 100644 --- a/doc/SubstObj.3 +++ b/doc/SubstObj.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_SubstObj 3 8.4 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_SubstObj \- perform substitutions on Tcl values diff --git a/doc/TCL_MEM_DEBUG.3 b/doc/TCL_MEM_DEBUG.3 index 5a3e08a..e3a6809 100644 --- a/doc/TCL_MEM_DEBUG.3 +++ b/doc/TCL_MEM_DEBUG.3 @@ -3,8 +3,8 @@ '\" Copyright (c) 2000 by Scriptics Corporation. '\" All rights reserved. '\" -.so man.macros .TH TCL_MEM_DEBUG 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME TCL_MEM_DEBUG \- Compile-time flag to enable Tcl memory debugging @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl n "8.6" Tcl "Tcl Built-In Commands" +.so man.macros .BS .SH NAME Tcl \- Tool Command Language @@ -28,7 +28,7 @@ First, the Tcl interpreter breaks the command into \fIwords\fR and performs substitutions as described below. These substitutions are performed in the same way for all commands. -The first word is used to locate a command procedure to +Secondly, the first word is used to locate a command procedure to carry out the command, then all of the words of the command are passed to the command procedure. The command procedure is free to interpret each of its words @@ -108,8 +108,8 @@ Variable substitution may take any of the following forms: \fIName\fR is the name of a scalar variable; the name is a sequence of one or more characters that are a letter, digit, underscore, or namespace separators (two or more colons). -Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\-\fB9\fR, -\fBA\fR\-\fBZ\fR and \fBa\fR\-\fBz\fR). +Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR, +\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR). .TP 15 \fB$\fIname\fB(\fIindex\fB)\fR . @@ -117,8 +117,8 @@ Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\-\fB9\fR, the name of an element within that array. \fIName\fR must contain only letters, digits, underscores, and namespace separators, and may be an empty string. -Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\-\fB9\fR, -\fBA\fR\-\fBZ\fR and \fBa\fR\-\fBz\fR). +Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR, +\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR). Command substitutions, variable substitutions, and backslash substitutions are performed on the characters of \fIindex\fR. .TP 15 @@ -158,25 +158,25 @@ handled specially, along with the value that replaces each sequence. .RS .TP 7 \e\fBa\fR -Audible alert (bell) (0x7). +Audible alert (bell) (Unicode U+000007). .TP 7 \e\fBb\fR -Backspace (0x8). +Backspace (Unicode U+000008). .TP 7 \e\fBf\fR -Form feed (0xc). +Form feed (Unicode U+00000C). .TP 7 \e\fBn\fR -Newline (0xa). +Newline (Unicode U+00000A). .TP 7 \e\fBr\fR -Carriage-return (0xd). +Carriage-return (Unicode U+00000D). .TP 7 \e\fBt\fR -Tab (0x9). +Tab (Unicode U+000009). .TP 7 \e\fBv\fR -Vertical tab (0xb). +Vertical tab (Unicode U+00000B). .TP 7 \e\fB<newline>\fIwhiteSpace\fR . @@ -194,8 +194,9 @@ Backslash \e\fIooo\fR . The digits \fIooo\fR (one, two, or three of them) give a eight-bit octal -value for the Unicode character that will be inserted, in the range \fI000\fR -- \fI377\fR. The parser will stop just before this range overflows, or when +value for the Unicode character that will be inserted, in the range +\fI000\fR\(en\fI377\fR (i.e., the range U+000000\(enU+0000FF). +The parser will stop just before this range overflows, or when the maximum of three digits is reached. The upper bits of the Unicode character will be 0. .TP 7 @@ -203,23 +204,27 @@ character will be 0. . The hexadecimal digits \fIhh\fR (one or two of them) give an eight-bit hexadecimal value for the Unicode character that will be inserted. The upper -bits of the Unicode character will be 0. +bits of the Unicode character will be 0 (i.e., the character will be in the +range U+000000\(enU+0000FF). .TP 7 \e\fBu\fIhhhh\fR . The hexadecimal digits \fIhhhh\fR (one, two, three, or four of them) give a sixteen-bit hexadecimal value for the Unicode character that will be -inserted. The upper bits of the Unicode character will be 0. +inserted. The upper bits of the Unicode character will be 0 (i.e., the +character will be in the range U+000000\(enU+00FFFF). .TP 7 \e\fBU\fIhhhhhhhh\fR . The hexadecimal digits \fIhhhhhhhh\fR (one up to eight of them) give a twenty-one-bit hexadecimal value for the Unicode character that will be -inserted, in the range U+0000..U+10FFFF. The parser will stop just +inserted, in the range U+000000\(enU+10FFFF. The parser will stop just before this range overflows, or when the maximum of eight digits is reached. The upper bits of the Unicode character will be 0. +.RS .PP -The range U+010000..U+10FFFD is reserved for the future. +The range U+010000\(enU+10FFFD is reserved for the future. +.RE .PP Backslash substitution is not performed on words enclosed in braces, except for backslash-newline as described above. diff --git a/doc/TclZlib.3 b/doc/TclZlib.3 index 854a525..c6a6417 100644 --- a/doc/TclZlib.3 +++ b/doc/TclZlib.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH TclZlib 3 8.6 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/Tcl_Main.3 b/doc/Tcl_Main.3 index 0a69835..5fd5002 100644 --- a/doc/Tcl_Main.3 +++ b/doc/Tcl_Main.3 @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Main 3 8.4 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_Main, Tcl_SetStartupScript, Tcl_GetStartupScript, Tcl_SetMainLoop \- main program, startup script, and event loop definition for Tcl-based applications diff --git a/doc/Thread.3 b/doc/Thread.3 index ca135ee..ac5f2ba 100644 --- a/doc/Thread.3 +++ b/doc/Thread.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Threads 3 "8.1" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_ConditionNotify, Tcl_ConditionWait, Tcl_ConditionFinalize, Tcl_GetThreadData, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_MutexFinalize, Tcl_CreateThread, Tcl_JoinThread \- Tcl thread support diff --git a/doc/ToUpper.3 b/doc/ToUpper.3 index d6b3006..587e76b 100644 --- a/doc/ToUpper.3 +++ b/doc/ToUpper.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_UtfToUpper 3 "8.1" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_UniCharToUpper, Tcl_UniCharToLower, Tcl_UniCharToTitle, Tcl_UtfToUpper, Tcl_UtfToLower, Tcl_UtfToTitle \- routines for manipulating the case of Unicode characters and UTF-8 strings diff --git a/doc/TraceCmd.3 b/doc/TraceCmd.3 index 5cc1337..1244576 100644 --- a/doc/TraceCmd.3 +++ b/doc/TraceCmd.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_TraceCommand 3 7.4 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CommandTraceInfo, Tcl_TraceCommand, Tcl_UntraceCommand \- monitor renames and deletes of a command diff --git a/doc/TraceVar.3 b/doc/TraceVar.3 index 6201a4f..97d035b 100644 --- a/doc/TraceVar.3 +++ b/doc/TraceVar.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_TraceVar 3 7.4 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_TraceVar, Tcl_TraceVar2, Tcl_UntraceVar, Tcl_UntraceVar2, Tcl_VarTraceInfo, Tcl_VarTraceInfo2 \- monitor accesses to a variable diff --git a/doc/Translate.3 b/doc/Translate.3 index 55233c3..0f223e4 100644 --- a/doc/Translate.3 +++ b/doc/Translate.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_TranslateFileName 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_TranslateFileName \- convert file name to native form and replace tilde with home directory diff --git a/doc/UniCharIsAlpha.3 b/doc/UniCharIsAlpha.3 index 6029b2d..ea6fc5b 100644 --- a/doc/UniCharIsAlpha.3 +++ b/doc/UniCharIsAlpha.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_UniCharIsAlpha 3 "8.1" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_UniCharIsAlnum, Tcl_UniCharIsAlpha, Tcl_UniCharIsControl, Tcl_UniCharIsDigit, Tcl_UniCharIsGraph, Tcl_UniCharIsLower, Tcl_UniCharIsPrint, Tcl_UniCharIsPunct, Tcl_UniCharIsSpace, Tcl_UniCharIsUpper, Tcl_UniCharIsWordChar \- routines for classification of Tcl_UniChar characters diff --git a/doc/UpVar.3 b/doc/UpVar.3 index f1e6fe4..8e7ba08 100644 --- a/doc/UpVar.3 +++ b/doc/UpVar.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_UpVar 3 7.4 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_UpVar, Tcl_UpVar2 \- link one variable to another @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Utf 3 "8.1" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_UniChar, Tcl_UniCharCaseMatch, Tcl_UniCharNcasecmp, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings diff --git a/doc/WrongNumArgs.3 b/doc/WrongNumArgs.3 index 15d5caf..33807d5 100644 --- a/doc/WrongNumArgs.3 +++ b/doc/WrongNumArgs.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_WrongNumArgs 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_WrongNumArgs \- generate standard error message for wrong number of arguments diff --git a/doc/after.n b/doc/after.n index d6181c6..e61bb88 100644 --- a/doc/after.n +++ b/doc/after.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH after n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/append.n b/doc/append.n index 034068d..4b3cfd0 100644 --- a/doc/append.n +++ b/doc/append.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH append n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/apply.n b/doc/apply.n index 9d373e1..4b730ff 100644 --- a/doc/apply.n +++ b/doc/apply.n @@ -2,8 +2,8 @@ '\" Copyright (c) 2006 Miguel Sofer '\" Copyright (c) 2006 Donal K. Fellows '\" -.so man.macros .TH apply n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/array.n b/doc/array.n index 47f9624..e253a37 100644 --- a/doc/array.n +++ b/doc/array.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH array n 8.3 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/bgerror.n b/doc/bgerror.n index ac53eca..ea8fe2a 100644 --- a/doc/bgerror.n +++ b/doc/bgerror.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH bgerror n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -85,6 +85,9 @@ proc bgerror {message} { } .CE .SH "SEE ALSO" -after(n), interp(n), tclvars(n) +after(n), errorCode(n), errorInfo(n), interp(n) .SH KEYWORDS background error, reporting +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/binary.n b/doc/binary.n index 68bf9cc..014704d 100644 --- a/doc/binary.n +++ b/doc/binary.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH binary n 8.0 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -36,6 +36,13 @@ The \fBbinary encode\fR and \fBbinary decode\fR subcommands convert binary data to or from string encodings such as base64 (used in MIME messages for example). .VE 8.6 +.PP +Note that other operations on binary data, such as taking a subsequence of it, +getting its length, or reinterpreting it as a string in some encoding, are +done by other Tcl commands (respectively \fBstring range\fR, +\fBstring length\fR and \fBencoding convertfrom\fR in the example cases). A +binary string in Tcl is merely one where all the characters it contains are in +the range \eu0000\-\eu00FF. .SH "BINARY ENCODE AND DECODE" .VS 8.6 .PP @@ -95,13 +102,14 @@ between Unix systems and on USENET, but is less common these days, having been largely superseded by the \fBbase64\fR binary encoding. .RS .PP -During encoding, the following options are supported: -'\" This is wrong! The uuencode format had more complexity than this! +During encoding, the following options are supported (though changing them may +produce files that other implementations of decoders cannot process): .TP \fB\-maxlen \fIlength\fR . Indicates that the output should be split into lines of no more than -\fIlength\fR characters. By default, lines are not split. +\fIlength\fR characters. By default, lines are split every 61 characters, and +this must be in the range 3 to 85 due to limitations in the encoding. .TP \fB\-wrapchar \fIcharacter\fR . @@ -114,7 +122,11 @@ During decoding, the following options are supported: .TP \fB\-strict\fR . -Instructs the decoder to throw an error if it encounters whitespace characters. Otherwise it ignores them. +Instructs the decoder to throw an error if it encounters unexpected whitespace +characters. Otherwise it ignores them. +.PP +Note that neither the encoder nor the decoder handle the header and footer of +the uuencode format. .RE .VE 8.6 .SH "BINARY FORMAT" @@ -855,6 +867,7 @@ architectures, use their textual representation (as produced by .PP This is a procedure to write a Tcl string to a binary-encoded channel as UTF-8 data preceded by a length word: +.PP .CS proc \fIwriteString\fR {channel string} { set data [encoding convertto utf-8 $string] @@ -865,6 +878,7 @@ proc \fIwriteString\fR {channel string} { .PP This procedure reads a string from a channel that was written by the previously presented \fIwriteString\fR procedure: +.PP .CS proc \fIreadString\fR {channel} { if {![\fBbinary scan\fR [read $channel 4] I length]} { @@ -877,6 +891,7 @@ proc \fIreadString\fR {channel} { .PP This converts the contents of a file (named in the variable \fIfilename\fR) to base64 and prints them: +.PP .CS set f [open $filename rb] set data [read $f] @@ -884,9 +899,10 @@ close $f puts [\fBbinary encode\fR base64 \-maxlen 64 $data] .CE .SH "SEE ALSO" -format(n), scan(n), tclvars(n) +encoding(n), format(n), scan(n), string(n), tcl_platform(n) .SH KEYWORDS binary, format, scan '\" Local Variables: '\" mode: nroff +'\" fill-column: 78 '\" End: diff --git a/doc/break.n b/doc/break.n index cef37c6..3e4ce5f 100644 --- a/doc/break.n +++ b/doc/break.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH break n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH case n 7.0 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/catch.n b/doc/catch.n index a05ca71..94fa5dd 100644 --- a/doc/catch.n +++ b/doc/catch.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH catch n "8.5" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -115,7 +115,8 @@ if { [\fBcatch\fR {open $someFile w} fid] } { There are more complex examples of \fBcatch\fR usage in the documentation for the \fBreturn\fR command. .SH "SEE ALSO" -break(n), continue(n), dict(n), error(n), info(n), return(n), tclvars(n) +break(n), continue(n), dict(n), error(n), errorCode(n), errorInfo(n), info(n), +return(n) .SH KEYWORDS catch, error, exception '\" Local Variables: @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH cd n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -3,8 +3,8 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -.so man.macros .TH chan n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/class.n b/doc/class.n index 88d1b44..198ae41 100644 --- a/doc/class.n +++ b/doc/class.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH class n 0.1 TclOO "TclOO Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/clock.n b/doc/clock.n index 8708029..42dca80 100644 --- a/doc/clock.n +++ b/doc/clock.n @@ -2,8 +2,8 @@ '\" Generated from file './doc/clock.dt' by tcllib/doctools with format 'nroff' '\" Copyright (c) 2004 Kevin B. Kenny <kennykb@acm.org>. All rights reserved. '\" -.so man.macros .TH "clock" n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS .SH NAME clock \- Obtain and manipulate dates and times diff --git a/doc/close.n b/doc/close.n index 2826d82..63da75b 100644 --- a/doc/close.n +++ b/doc/close.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH close n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/concat.n b/doc/concat.n index b079b30..575b9df 100644 --- a/doc/concat.n +++ b/doc/concat.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH concat n 8.3 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/continue.n b/doc/continue.n index de2f07c..17d16b4 100644 --- a/doc/continue.n +++ b/doc/continue.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH continue n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH copy n 0.1 TclOO "TclOO Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/coroutine.n b/doc/coroutine.n index 035d58a..c99f8d3 100644 --- a/doc/coroutine.n +++ b/doc/coroutine.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH coroutine n 8.6 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH dde n 1.4 dde "Tcl Bundled Packages" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/define.n b/doc/define.n index 1c36ca3..7599ec0 100644 --- a/doc/define.n +++ b/doc/define.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH define n 0.3 TclOO "TclOO Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH dict n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/encoding.n b/doc/encoding.n index 5269a18..be1dc3f 100644 --- a/doc/encoding.n +++ b/doc/encoding.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH encoding n "8.1" Tcl "Tcl Built-In Commands" +.so man.macros .BS .SH NAME encoding \- Manipulate encodings @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH eof n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/error.n b/doc/error.n index d61bd7b..a95c691 100644 --- a/doc/error.n +++ b/doc/error.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH error n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH eval n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -75,7 +75,8 @@ However, the last line would now normally be written without set var [linsert $var 0 {*}$args] .CE .SH "SEE ALSO" -catch(n), concat(n), error(n), interp(n), list(n), namespace(n), subst(n), tclvars(n), uplevel(n) +catch(n), concat(n), error(n), errorCode(n), errorInfo(n), interp(n), list(n), +namespace(n), subst(n), uplevel(n) .SH KEYWORDS concatenate, evaluate, script '\" Local Variables: @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH exec n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH exit n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH expr n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/fconfigure.n b/doc/fconfigure.n index ac0366c..ca23314 100644 --- a/doc/fconfigure.n +++ b/doc/fconfigure.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH fconfigure n 8.3 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -72,8 +72,8 @@ initially set to \fBline\fR, and \fBstderr\fR is set to \fBnone\fR. . \fINewvalue\fR must be an integer; its value is used to set the size of buffers, in bytes, subsequently allocated for this channel to store input -or output. \fINewvalue\fR must be between ten and one million, allowing -buffers of ten to one million bytes in size. +or output. \fINewvalue\fR must be between one and one million, allowing +buffers of one to one million bytes in size. .TP \fB\-encoding\fR \fIname\fR . diff --git a/doc/fcopy.n b/doc/fcopy.n index 6a4bf1a..ec3d5c6 100644 --- a/doc/fcopy.n +++ b/doc/fcopy.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH fcopy n 8.0 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH file n 8.3 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -481,6 +481,13 @@ Returns \fB1\fR if file \fIname\fR is writable by the current user, . These commands always operate using the real user and group identifiers, not the effective ones. +.TP +\fBWindows\fR\0\0\0\0 +. +The \fBfile owned\fR subcommand currently always reports that the current user +is the owner of the file, without regard for what the operating system +believes to be true, making an ownership test useless. This issue (#3613671) +may be fixed in a future release of Tcl. .SH EXAMPLES .PP This procedure shows how to search for C files in a given directory diff --git a/doc/fileevent.n b/doc/fileevent.n index df48d2a..8f6b880 100644 --- a/doc/fileevent.n +++ b/doc/fileevent.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH fileevent n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -80,13 +80,16 @@ A channel is considered to be writable if at least one byte of data can be written to the underlying file or device without blocking, or if an error condition is present on the underlying file or device. .PP -Event-driven I/O works best for channels that have been -placed into nonblocking mode with the \fBfconfigure\fR command. -In blocking mode, a \fBputs\fR command may block if you give it -more data than the underlying file or device can accept, and a -\fBgets\fR or \fBread\fR command will block if you attempt to read -more data than is ready; no events will be processed while the -commands block. +Event-driven I/O works best for channels that have been placed into +nonblocking mode with the \fBfconfigure\fR command. In blocking mode, +a \fBputs\fR command may block if you give it more data than the +underlying file or device can accept, and a \fBgets\fR or \fBread\fR +command will block if you attempt to read more data than is ready; a +readable underlying file or device may not even guarantee that a +blocking [read 1] will succeed (counter-examples being multi-byte +encodings, compression or encryption transforms ). In all such cases, +no events will be processed while the commands block. +.PP In nonblocking mode \fBputs\fR, \fBread\fR, and \fBgets\fR never block. See the documentation for the individual commands for information on how they handle blocking and nonblocking channels. diff --git a/doc/filename.n b/doc/filename.n index d481fc9..8b8b00b 100644 --- a/doc/filename.n +++ b/doc/filename.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH filename n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/flush.n b/doc/flush.n index b8bf3e9..d266d91 100644 --- a/doc/flush.n +++ b/doc/flush.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH flush n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH for n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/foreach.n b/doc/foreach.n index fb075d3..89a11f6 100644 --- a/doc/foreach.n +++ b/doc/foreach.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH foreach n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/format.n b/doc/format.n index 23dfe60..076a820 100644 --- a/doc/format.n +++ b/doc/format.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH format n 8.1 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH gets n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -.so man.macros .TH glob n 8.3 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/global.n b/doc/global.n index c17c370..aa8f2e4 100644 --- a/doc/global.n +++ b/doc/global.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH global n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/history.n b/doc/history.n index ba507b4..e1f9781 100644 --- a/doc/history.n +++ b/doc/history.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH history n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH "http" n 2.7 http "Tcl Bundled Packages" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH if n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH incr n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -8,8 +8,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH info n 8.4 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -296,7 +296,6 @@ Returns the name of the library directory in which standard Tcl scripts are stored. This is actually the value of the \fBtcl_library\fR variable and may be changed by setting \fBtcl_library\fR. -See the \fBtclvars\fR manual entry for more information. .TP \fBinfo loaded \fR?\fIinterp\fR? . @@ -336,8 +335,8 @@ described in \fBOBJECT INTROSPECTION\fR below. .TP \fBinfo patchlevel\fR . -Returns the value of the global variable \fBtcl_patchLevel\fR; see -the \fBtclvars\fR manual entry for more information. +Returns the value of the global variable \fBtcl_patchLevel\fR, which holds +the exact version of the Tcl library by default. .TP \fBinfo procs \fR?\fIpattern\fR? . @@ -374,8 +373,8 @@ string is returned. .TP \fBinfo tclversion\fR . -Returns the value of the global variable \fBtcl_version\fR; see -the \fBtclvars\fR manual entry for more information. +Returns the value of the global variable \fBtcl_version\fR, which holds the +major and minor version of the Tcl library by default. .TP \fBinfo vars\fR ?\fIpattern\fR? . @@ -763,8 +762,9 @@ proc getDef {obj method} { .VE 8.6 .SH "SEE ALSO" .VS 8.6 -global(n), oo::class(n), oo::define(n), oo::object(n), proc(n), self(n) +global(n), oo::class(n), oo::define(n), oo::object(n), proc(n), self(n), .VE 8.6 +tcl_library(n), tcl_patchLevel(n), tcl_version(n) .SH KEYWORDS command, information, interpreter, introspection, level, namespace, .VS 8.6 diff --git a/doc/interp.n b/doc/interp.n index 6ce10ee..92113a6 100644 --- a/doc/interp.n +++ b/doc/interp.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH interp n 8.6 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH join n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/lappend.n b/doc/lappend.n index 9bfab72..a324ca3 100644 --- a/doc/lappend.n +++ b/doc/lappend.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH lappend n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/lassign.n b/doc/lassign.n index 6f5042b..e250729 100644 --- a/doc/lassign.n +++ b/doc/lassign.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH lassign n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/library.n b/doc/library.n index 2413692..775b7d9 100644 --- a/doc/library.n +++ b/doc/library.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH library n "8.0" Tcl "Tcl Built-In Commands" +.so man.macros .BS .SH NAME auto_execok, auto_import, auto_load, auto_mkindex, auto_qualify, auto_reset, tcl_findLibrary, parray, tcl_endOfWord, tcl_startOfNextWord, tcl_startOfPreviousWord, tcl_wordBreakAfter, tcl_wordBreakBefore \- standard library of Tcl procedures @@ -262,13 +262,17 @@ If set to any value, then \fBunknown\fR will not attempt to auto-load any commands. .TP \fBauto_path\fR +. If set, then it must contain a valid Tcl list giving directories to -search during auto-load operations. +search during auto-load operations (including for package index +files when using the default \fBpackage unknown\fR handler). This variable is initialized during startup to contain, in order: the directories listed in the \fBTCLLIBPATH\fR environment variable, -the directory named by the \fBtcl_library\fR variable, +the directory named by the \fBtcl_library\fR global variable, the parent directory of \fBtcl_library\fR, the directories listed in the \fBtcl_pkgPath\fR variable. +Additional locations to look for files and package indices should +normally be added to this variable using \fBlappend\fR. .TP \fBenv(TCL_LIBRARY)\fR If set, then it specifies the location of the directory containing @@ -306,7 +310,7 @@ considered to be a word character. On Windows platforms, words are comprised of any character that is not a space, tab, or newline. Under Unix, words are comprised of numbers, letters or underscores. .SH "SEE ALSO" -info(n), re_syntax(n), tclvars(n) +env(n), info(n), re_syntax(n) .SH KEYWORDS auto-exec, auto-load, library, unknown, word, whitespace '\"Local Variables: diff --git a/doc/lindex.n b/doc/lindex.n index bb272a6..b42904b 100644 --- a/doc/lindex.n +++ b/doc/lindex.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH lindex n 8.4 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/linsert.n b/doc/linsert.n index c722e4f..51b64cf 100644 --- a/doc/linsert.n +++ b/doc/linsert.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH linsert n 8.2 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH list n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/llength.n b/doc/llength.n index b0ee4d9..d3f9610 100644 --- a/doc/llength.n +++ b/doc/llength.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH llength n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH lmap n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH load n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/lrange.n b/doc/lrange.n index 4f4816a..4e26a0f 100644 --- a/doc/lrange.n +++ b/doc/lrange.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH lrange n 7.4 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/lrepeat.n b/doc/lrepeat.n index 59a1edf..466339d 100644 --- a/doc/lrepeat.n +++ b/doc/lrepeat.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH lrepeat n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/lreplace.n b/doc/lreplace.n index 6e6c3ea..7bba543 100644 --- a/doc/lreplace.n +++ b/doc/lreplace.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH lreplace n 7.4 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/lreverse.n b/doc/lreverse.n index f52db9b..51a9e57 100644 --- a/doc/lreverse.n +++ b/doc/lreverse.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH lreverse n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/lsearch.n b/doc/lsearch.n index 7835352..44ebce4 100644 --- a/doc/lsearch.n +++ b/doc/lsearch.n @@ -7,8 +7,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH lsearch n 8.6 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH lset n 8.4 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/lsort.n b/doc/lsort.n index 312048e..48c62f0 100644 --- a/doc/lsort.n +++ b/doc/lsort.n @@ -7,8 +7,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH lsort n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/mathfunc.n b/doc/mathfunc.n index 14b448e..84853d8 100644 --- a/doc/mathfunc.n +++ b/doc/mathfunc.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH mathfunc n 8.5 Tcl "Tcl Mathematical Functions" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/mathop.n b/doc/mathop.n index ac2ebc1..4c16d76 100644 --- a/doc/mathop.n +++ b/doc/mathop.n @@ -4,8 +4,8 @@ .\" See the file "license.terms" for information on usage and redistribution .\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. .\" -.so man.macros .TH mathop n 8.5 Tcl "Tcl Mathematical Operator Commands" +.so man.macros .BS .\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/memory.n b/doc/memory.n index f82c5b4..5a1524b 100644 --- a/doc/memory.n +++ b/doc/memory.n @@ -3,8 +3,8 @@ '\" Copyright (c) 2000 by Scriptics Corporation. '\" All rights reserved. '\" -.so man.macros .TH memory n 8.1 Tcl "Tcl Built-In Commands" +.so man.macros .BS .SH NAME memory \- Control Tcl memory debugging capabilities diff --git a/doc/msgcat.n b/doc/msgcat.n index 57fbb78..bae6dbe 100644 --- a/doc/msgcat.n +++ b/doc/msgcat.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH "msgcat" n 1.5 msgcat "Tcl Bundled Packages" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -13,7 +13,7 @@ msgcat \- Tcl message catalog .SH SYNOPSIS \fBpackage require Tcl 8.5\fR .sp -\fBpackage require msgcat 1.5.0\fR +\fBpackage require msgcat 1.5\fR .sp \fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR? .sp @@ -35,7 +35,7 @@ msgcat \- Tcl message catalog \fB::msgcat::mcflmset \fIsrc-trans-list\fR .VE "TIP 404" .sp -\fB::msgcat::mcunknown \fIlocale src-string\fR +\fB::msgcat::mcunknown \fIlocale src-string\fR ?\fIarg arg ...\fR? .BE .SH DESCRIPTION .PP @@ -157,12 +157,13 @@ translate-string\fR ?\fIsrc-string translate-string ...\fR?} of \fB::msgcat::mcflset\fR. The function returns the number of translations set. .VE "TIP 404" .TP -\fB::msgcat::mcunknown \fIlocale src-string\fR +\fB::msgcat::mcunknown \fIlocale src-string\fR ?\fIarg arg ...\fR? . This routine is called by \fB::msgcat::mc\fR in the case when a translation for \fIsrc-string\fR is not defined in the current locale. The default action is to return -\fIsrc-string\fR. This procedure can be redefined by the +\fIsrc-string\fR passed by format if there are any arguments. This +procedure can be redefined by the application, for example to log error messages for each unknown string. The \fB::msgcat::mcunknown\fR procedure is invoked at the same stack context as the call to \fB::msgcat::mc\fR. The return value @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH my n 0.1 TclOO "TclOO Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/namespace.n b/doc/namespace.n index b06d27a..1f4e85f 100644 --- a/doc/namespace.n +++ b/doc/namespace.n @@ -7,8 +7,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH namespace n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -287,7 +287,7 @@ This command is the complement of the \fBnamespace qualifiers\fR command. It does not check whether the namespace names are, in fact, the names of currently defined namespaces. .TP -\fBnamespace upvar\fR \fInamespace\fR ?\fIotherVar myVar \fR... +\fBnamespace upvar\fR \fInamespace\fR ?\fIotherVar myVar \fR...? . This command arranges for zero or more local variables in the current procedure to refer to variables in \fInamespace\fR. The namespace name is @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH next n 0.1 TclOO "TclOO Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -62,14 +62,14 @@ The method chain is cached for future use. When constructing the method chain, method implementations are searched for in the following order: .IP [1] -In the object. -.IP [2] In the classes mixed into the object, in class traversal order. The list of mixins is checked in natural order. -.IP [3] +.IP [2] In the classes mixed into the classes of the object, with sources of mixing in being searched in class traversal order. Within each class, the list of mixins is processed in natural order. +.IP [3] +In the object itself. .IP [4] In the object's class. .IP [5] @@ -77,7 +77,10 @@ In the superclasses of the class, following each superclass in a depth-first fashion in the natural order of the superclass list. .PP Any particular method implementation always comes as \fIlate\fR in the -resulting list of implementations as possible. +resulting list of implementations as possible; this means that if some class, +A, is both mixed into a class, B, and is also a superclass of B, the instances +of B will always treat A as a superclass from the perspective of inheritance. +This is true even when the multiple inheritance is processed indirectly. .SS FILTERS .PP When an object has a list of filter names set upon it, or is an instance of a diff --git a/doc/object.n b/doc/object.n index 6737e7e..df657a9 100644 --- a/doc/object.n +++ b/doc/object.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH object n 0.1 TclOO "TclOO Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH open n 8.3 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/package.n b/doc/package.n index 6cf8991..07a3d47 100644 --- a/doc/package.n +++ b/doc/package.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH package n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/packagens.n b/doc/packagens.n index 30617a3..61e7eca 100644 --- a/doc/packagens.n +++ b/doc/packagens.n @@ -2,8 +2,8 @@ '\" Copyright (c) 1998-2000 by Scriptics Corporation. '\" All rights reserved. '\" -.so man.macros .TH pkg::create n 8.3 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH pid n 7.0 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/pkgMkIndex.n b/doc/pkgMkIndex.n index 2753208..c2f23ed 100644 --- a/doc/pkgMkIndex.n +++ b/doc/pkgMkIndex.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH pkg_mkIndex n 8.3 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/platform.n b/doc/platform.n index 1553698..6abc289 100644 --- a/doc/platform.n +++ b/doc/platform.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH "platform" n 1.0.4 platform "Tcl Bundled Packages" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/platform_shell.n b/doc/platform_shell.n index eef4d4e..64a2e46 100644 --- a/doc/platform_shell.n +++ b/doc/platform_shell.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH "platform::shell" n 1.1.4 platform::shell "Tcl Bundled Packages" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/prefix.n b/doc/prefix.n index eb79996..344ade7 100644 --- a/doc/prefix.n +++ b/doc/prefix.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH prefix n 8.6 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH proc n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH puts n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH pwd n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH read n 8.1 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/refchan.n b/doc/refchan.n index a51c3d7..2232d50 100644 --- a/doc/refchan.n +++ b/doc/refchan.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH refchan n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS .\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/regexp.n b/doc/regexp.n index 5e857f8..17bf564 100644 --- a/doc/regexp.n +++ b/doc/regexp.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH regexp n 8.3 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/registry.n b/doc/registry.n index 2e69b1e..001def9 100644 --- a/doc/registry.n +++ b/doc/registry.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH registry n 1.1 registry "Tcl Bundled Packages" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/regsub.n b/doc/regsub.n index fe473d9..ef4c289 100644 --- a/doc/regsub.n +++ b/doc/regsub.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH regsub n 8.3 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/rename.n b/doc/rename.n index 77dc095..744bf5a 100644 --- a/doc/rename.n +++ b/doc/rename.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH rename n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/return.n b/doc/return.n index b59a93d..383ed8c 100644 --- a/doc/return.n +++ b/doc/return.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH return n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -317,8 +317,8 @@ proc myReturn {args} { } .CE .SH "SEE ALSO" -break(n), catch(n), continue(n), dict(n), error(n), proc(n), -source(n), tclvars(n), throw(n), try(n) +break(n), catch(n), continue(n), dict(n), error(n), errorCode(n), +errorInfo(n), proc(n), source(n), throw(n), try(n) .SH KEYWORDS break, catch, continue, error, exception, procedure, result, return .\" Local Variables: @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH "Safe Tcl" n 8.0 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH scan n 8.4 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -99,7 +99,7 @@ The input substring must be an octal integer. It is read in and the integer value is stored in the variable, truncated as required by the size modifier value. .TP -\fBx\fR +\fBx\fR or \fBX\fR . The input substring must be a hexadecimal integer. It is read in and the integer value is stored in the variable, @@ -140,7 +140,7 @@ substring may be a white-space character. The input substring consists of all the characters up to the next white-space character; the characters are copied to the variable. .TP -\fBe\fR or \fBf\fR or \fBg\fR +\fBe\fR or \fBf\fR or \fBg\fR or \fBE\fR or \fBG\fR . The input substring must be a floating-point number consisting of an optional sign, a string of decimal digits possibly @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH seek n 8.1 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH self n 0.1 TclOO "TclOO Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH set n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/socket.n b/doc/socket.n index 0a60457..b7a4a45 100644 --- a/doc/socket.n +++ b/doc/socket.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH socket n 8.6 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/source.n b/doc/source.n index 57a9fa2..9f488c5 100644 --- a/doc/source.n +++ b/doc/source.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH source n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/split.n b/doc/split.n index e3259df..f1c66d0 100644 --- a/doc/split.n +++ b/doc/split.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH split n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/string.n b/doc/string.n index f5eae39..76005fc 100644 --- a/doc/string.n +++ b/doc/string.n @@ -5,8 +5,8 @@ .\" See the file "license.terms" for information on usage and redistribution .\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. .\" -.so man.macros .TH string n 8.1 Tcl "Tcl Built-In Commands" +.so man.macros .BS .\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -19,7 +19,7 @@ string \- Manipulate strings Performs one of several string operations, depending on \fIoption\fR. The legal \fIoption\fRs (which may be abbreviated) are: .TP -\fBstring compare\fR ?\fB\-nocase\fR? ?\fB\-length int\fR? \fIstring1 string2\fR +\fBstring compare\fR ?\fB\-nocase\fR? ?\fB\-length\fI length\fR? \fIstring1 string2\fR . Perform a character-by-character comparison of strings \fIstring1\fR and \fIstring2\fR. Returns \-1, 0, or 1, depending on whether @@ -29,7 +29,7 @@ first \fIlength\fR characters are used in the comparison. If \fB\-length\fR is negative, it is ignored. If \fB\-nocase\fR is specified, then the strings are compared in a case-insensitive manner. .TP -\fBstring equal\fR ?\fB\-nocase\fR? ?\fB\-length int\fR? \fIstring1 string2\fR +\fBstring equal\fR ?\fB\-nocase\fR? ?\fB\-length\fI length\fR? \fIstring1 string2\fR . Perform a character-by-character comparison of strings \fIstring1\fR and \fIstring2\fR. Returns 1 if \fIstring1\fR and \fIstring2\fR are diff --git a/doc/subst.n b/doc/subst.n index aba2bc9..990b9d3 100644 --- a/doc/subst.n +++ b/doc/subst.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH subst n 7.4 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/switch.n b/doc/switch.n index acde6cb..6e27f56 100644 --- a/doc/switch.n +++ b/doc/switch.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH switch n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/tailcall.n b/doc/tailcall.n index 6a88aca..926c608 100644 --- a/doc/tailcall.n +++ b/doc/tailcall.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH tailcall n 8.6 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/tclsh.1 b/doc/tclsh.1 index 8e7fb9e..6ed5eb6 100644 --- a/doc/tclsh.1 +++ b/doc/tclsh.1 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH tclsh 1 "" Tcl "Tcl Applications" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -102,7 +102,9 @@ but also the disadvantage of making it harder to write scripts that start up uniformly across different versions of Tcl. .SH "VARIABLES" .PP -\fBTclsh\fR sets the following Tcl variables: +\fBTclsh\fR sets the following global Tcl variables in addition to those +created by the Tcl library itself (such as \fBenv\fR, which maps +environment variables such as \fBPATH\fR into Tcl): .TP 15 \fBargc\fR . @@ -129,7 +131,7 @@ device), 0 otherwise. When \fBtclsh\fR is invoked interactively it normally prompts for each command with .QW "\fB% \fR" . -You can change the prompt by setting the +You can change the prompt by setting the global variables \fBtcl_prompt1\fR and \fBtcl_prompt2\fR. If variable \fBtcl_prompt1\fR exists then it must consist of a Tcl script to output a prompt; instead of outputting a prompt \fBtclsh\fR @@ -142,6 +144,6 @@ incomplete commands. .PP See \fBTcl_StandardChannels\fR for more explanations. .SH "SEE ALSO" -encoding(n), fconfigure(n), tclvars(n) +auto_path(n), encoding(n), env(n), fconfigure(n) .SH KEYWORDS application, argument, interpreter, prompt, script file, shell diff --git a/doc/tcltest.n b/doc/tcltest.n index 731bed7..8d2398b 100644 --- a/doc/tcltest.n +++ b/doc/tcltest.n @@ -8,8 +8,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH "tcltest" n 2.3 tcltest "Tcl Bundled Packages" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/tclvars.n b/doc/tclvars.n index 44a8e11..2fec222 100644 --- a/doc/tclvars.n +++ b/doc/tclvars.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH tclvars n 8.0 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH tell n 8.1 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/throw.n b/doc/throw.n index d49fb24..0d1df78 100644 --- a/doc/throw.n +++ b/doc/throw.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH throw n 8.6 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -40,7 +40,7 @@ The following produces an error that is identical to that produced by \fBthrow\fR {ARITH DIVZERO {divide by zero}} {divide by zero} .CE .SH "SEE ALSO" -catch(n), error(n), return(n), tclvars(n), try(n) +catch(n), error(n), errorCode(n), errorInfo(n), return(n), try(n) .SH "KEYWORDS" error, exception '\" Local Variables: @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH time n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH tm n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/trace.n b/doc/trace.n index 63ed1cb..4ae7e19 100644 --- a/doc/trace.n +++ b/doc/trace.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH trace n "8.4" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/transchan.n b/doc/transchan.n index e308e13..e00aa84 100644 --- a/doc/transchan.n +++ b/doc/transchan.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH transchan n 8.6 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH try n 8.6 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -87,7 +87,7 @@ Handle different reasons for a file to not be openable for reading: .PP .CS \fBtry\fR { - set f [open /some/file/name] + set f [open /some/file/name w] } \fBtrap\fR {POSIX EISDIR} {} { puts "failed to open /some/file/name: it's a directory" } \fBtrap\fR {POSIX ENOENT} {} { diff --git a/doc/unknown.n b/doc/unknown.n index fc2a5a1..cdfbe43 100644 --- a/doc/unknown.n +++ b/doc/unknown.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH unknown n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/unload.n b/doc/unload.n index 4c0b292..febd694 100644 --- a/doc/unload.n +++ b/doc/unload.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH unload n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/unset.n b/doc/unset.n index 64b334d..8b63959 100644 --- a/doc/unset.n +++ b/doc/unset.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH unset n 8.4 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/update.n b/doc/update.n index 0c77c5f..875172a 100644 --- a/doc/update.n +++ b/doc/update.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH update n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/uplevel.n b/doc/uplevel.n index 6c8a957..a96f729 100644 --- a/doc/uplevel.n +++ b/doc/uplevel.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH uplevel n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/upvar.n b/doc/upvar.n index 60e5324..380a390 100644 --- a/doc/upvar.n +++ b/doc/upvar.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH upvar n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/variable.n b/doc/variable.n index 96263b6..7d58a02 100644 --- a/doc/variable.n +++ b/doc/variable.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH variable n 8.0 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/vwait.n b/doc/vwait.n index 38a8081..c9b51ab 100644 --- a/doc/vwait.n +++ b/doc/vwait.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH vwait n 8.0 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/while.n b/doc/while.n index 5416e25..60275e8 100644 --- a/doc/while.n +++ b/doc/while.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH while n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH zlib n 8.6 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/generic/regc_color.c b/generic/regc_color.c index b7a571c..f5d6dfd 100644 --- a/generic/regc_color.c +++ b/generic/regc_color.c @@ -254,7 +254,14 @@ newcolor( * Oops, must allocate more. */ + if (cm->max == MAX_COLOR) { + CERR(REG_ECOLORS); + return COLORLESS; /* too many colors */ + } n = cm->ncds * 2; + if (n < MAX_COLOR + 1) { + n = MAX_COLOR + 1; + } if (cm->cd == cm->cdspace) { newCd = (struct colordesc *) MALLOC(n * sizeof(struct colordesc)); if (newCd != NULL) { diff --git a/generic/regc_locale.c b/generic/regc_locale.c index f3db471..0f8d1b2 100644 --- a/generic/regc_locale.c +++ b/generic/regc_locale.c @@ -118,7 +118,7 @@ static const struct cname { * Unicode character-class tables. */ -typedef struct crange { +typedef struct { chr start; chr end; } crange; @@ -259,8 +259,9 @@ static const chr alphaCharTable[] = { */ static const crange controlRangeTable[] = { - {0x7f, 0x9f}, {0x600, 0x604}, {0x200b, 0x200f}, {0x202a, 0x202e}, - {0x2060, 0x2064}, {0x206a, 0x206f}, {0xe000, 0xf8ff}, {0xfff9, 0xfffb} + {0x0, 0x1f}, {0x7f, 0x9f}, {0x600, 0x604}, {0x200b, 0x200f}, + {0x202a, 0x202e}, {0x2060, 0x2064}, {0x2066, 0x206f}, {0xe000, 0xf8ff}, + {0xfff9, 0xfffb} #if TCL_UTF_MAX > 4 ,{0x1d173, 0x1d17a}, {0xe0020, 0xe007f}, {0xf0000, 0xffffd}, {0x100000, 0x10fffd} #endif @@ -269,7 +270,7 @@ static const crange controlRangeTable[] = { #define NUM_CONTROL_RANGE (sizeof(controlRangeTable)/sizeof(crange)) static const chr controlCharTable[] = { - 0xad, 0x6dd, 0x70f, 0xfeff + 0xad, 0x61c, 0x6dd, 0x70f, 0x180e, 0xfeff #if TCL_UTF_MAX > 4 ,0x110bd, 0xe0001 #endif @@ -315,12 +316,13 @@ static const crange punctRangeTable[] = { {0x17d8, 0x17da}, {0x1800, 0x180a}, {0x1aa0, 0x1aa6}, {0x1aa8, 0x1aad}, {0x1b5a, 0x1b60}, {0x1bfc, 0x1bff}, {0x1c3b, 0x1c3f}, {0x1cc0, 0x1cc7}, {0x2010, 0x2027}, {0x2030, 0x2043}, {0x2045, 0x2051}, {0x2053, 0x205e}, - {0x2768, 0x2775}, {0x27e6, 0x27ef}, {0x2983, 0x2998}, {0x29d8, 0x29db}, - {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e3b}, {0x3001, 0x3003}, - {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f}, {0xa6f2, 0xa6f7}, - {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd}, {0xaa5c, 0xaa5f}, - {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61}, {0xff01, 0xff03}, - {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d}, {0xff5f, 0xff65} + {0x2308, 0x230b}, {0x2768, 0x2775}, {0x27e6, 0x27ef}, {0x2983, 0x2998}, + {0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e3b}, + {0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f}, + {0xa6f2, 0xa6f7}, {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd}, + {0xaa5c, 0xaa5f}, {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61}, + {0xff01, 0xff03}, {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d}, + {0xff5f, 0xff65} #if TCL_UTF_MAX > 4 ,{0x10100, 0x10102}, {0x10a50, 0x10a58}, {0x10b39, 0x10b3f}, {0x11047, 0x1104d}, {0x110be, 0x110c1}, {0x11140, 0x11143}, {0x111c5, 0x111c8}, {0x12470, 0x12473} diff --git a/generic/regc_nfa.c b/generic/regc_nfa.c index 4fb3ea6..42489dd 100644 --- a/generic/regc_nfa.c +++ b/generic/regc_nfa.c @@ -497,6 +497,62 @@ freearc( } /* + - hasnonemptyout - Does state have a non-EMPTY out arc? + ^ static int hasnonemptyout(struct state *); + */ +static int +hasnonemptyout( + struct state *s) +{ + struct arc *a; + + for (a = s->outs; a != NULL; a = a->outchain) { + if (a->type != EMPTY) { + return 1; + } + } + return 0; +} + +/* + - nonemptyouts - count non-EMPTY out arcs of a state + ^ static int nonemptyouts(struct state *); + */ +static int +nonemptyouts( + struct state *s) +{ + int n = 0; + struct arc *a; + + for (a = s->outs; a != NULL; a = a->outchain) { + if (a->type != EMPTY) { + n++; + } + } + return n; +} + +/* + - nonemptyins - count non-EMPTY in arcs of a state + ^ static int nonemptyins(struct state *); + */ +static int +nonemptyins( + struct state *s) +{ + int n = 0; + struct arc *a; + + for (a = s->ins; a != NULL; a = a->inchain) { + if (a->type != EMPTY) { + n++; + } + } + return n; +} + +/* - findarc - find arc, if any, from given source with given type and color * If there is more than one such arc, the result is random. ^ static struct arc *findarc(struct state *, int, pcolor); @@ -559,21 +615,25 @@ moveins( } /* - - copyins - copy all in arcs of a state to another state - ^ static void copyins(struct nfa *, struct state *, struct state *); + - copyins - copy in arcs of a state to another state + * Either all arcs, or only non-empty ones as determined by all value. + ^ static VOID copyins(struct nfa *, struct state *, struct state *, int); */ static void copyins( struct nfa *nfa, struct state *oldState, - struct state *newState) + struct state *newState, + int all) { struct arc *a; assert(oldState != newState); for (a=oldState->ins ; a!=NULL ; a=a->inchain) { - cparc(nfa, a, a->from, newState); + if (all || a->type != EMPTY) { + cparc(nfa, a, a->from, newState); + } } } @@ -598,21 +658,25 @@ moveouts( } /* - - copyouts - copy all out arcs of a state to another state - ^ static void copyouts(struct nfa *, struct state *, struct state *); + - copyouts - copy out arcs of a state to another state + * Either all arcs, or only non-empty ones as determined by all value. + ^ static VOID copyouts(struct nfa *, struct state *, struct state *, int); */ static void copyouts( struct nfa *nfa, struct state *oldState, - struct state *newState) + struct state *newState, + int all) { struct arc *a; assert(oldState != newState); for (a=oldState->outs ; a!=NULL ; a=a->outchain) { - cparc(nfa, a, newState, a->to); + if (all || a->type != EMPTY) { + cparc(nfa, a, newState, a->to); + } } } @@ -759,7 +823,9 @@ duptraverse( * Arbitrary depth limit. Needs tuning, but this value is sufficient to * make all normal tests (not reg-33.14) pass. */ -#define DUPTRAVERSE_MAX_DEPTH 500 +#ifndef DUPTRAVERSE_MAX_DEPTH +#define DUPTRAVERSE_MAX_DEPTH 15000 +#endif if (depth++ > DUPTRAVERSE_MAX_DEPTH) { NERR(REG_ESPACE); @@ -968,9 +1034,9 @@ pull( if (NISERR()) { return 0; } - assert(to != from); /* con is not an inarc */ - copyins(nfa, from, s); /* duplicate inarcs */ - cparc(nfa, con, s, to); /* move constraint arc */ + assert(to != from); /* con is not an inarc */ + copyins(nfa, from, s, 1); /* duplicate inarcs */ + cparc(nfa, con, s, to); /* move constraint arc */ freearc(nfa, con); from = s; con = from->outs; @@ -1128,7 +1194,7 @@ push( if (NISERR()) { return 0; } - copyouts(nfa, to, s); /* duplicate outarcs */ + copyouts(nfa, to, s, 1); /* duplicate outarcs */ cparc(nfa, con, from, s); /* move constraint */ freearc(nfa, con); to = s; @@ -1245,100 +1311,209 @@ fixempties( FILE *f) /* for debug output; NULL none */ { struct state *s; + struct state *s2; struct state *nexts; struct arc *a; struct arc *nexta; - int progress; /* - * Find and eliminate empties until there are no more. + * First, get rid of any states whose sole out-arc is an EMPTY, + * since they're basically just aliases for their successor. The + * parsing algorithm creates enough of these that it's worth + * special-casing this. */ + for (s = nfa->states; s != NULL && !NISERR(); s = nexts) { + nexts = s->next; + if (s->flag || s->nouts != 1) { + continue; + } + a = s->outs; + assert(a != NULL && a->outchain == NULL); + if (a->type != EMPTY) { + continue; + } + if (s != a->to) { + moveins(nfa, s, a->to); + } + dropstate(nfa, s); + } - do { - progress = 0; - for (s = nfa->states; s != NULL && !NISERR() - && s->no != FREESTATE; s = nexts) { - nexts = s->next; - for (a = s->outs; a != NULL && !NISERR(); a = nexta) { - nexta = a->outchain; - if (a->type == EMPTY && unempty(nfa, a)) { - progress = 1; - } - assert(nexta == NULL || s->no != FREESTATE); + /* + * Similarly, get rid of any state with a single EMPTY in-arc, by + * folding it into its predecessor. + */ + for (s = nfa->states; s != NULL && !NISERR(); s = nexts) { + nexts = s->next; + /* Ensure tmp fields are clear for next step */ + assert(s->tmp = NULL); + if (s->flag || s->nins != 1) { + continue; + } + a = s->ins; + assert(a != NULL && a->inchain == NULL); + if (a->type != EMPTY) { + continue; + } + if (s != a->from) { + moveouts(nfa, s, a->from); + } + dropstate(nfa, s); + } + + /* + * For each remaining NFA state, find all other states that are + * reachable from it by a chain of one or more EMPTY arcs. Then + * generate new arcs that eliminate the need for each such chain. + * + * If we just do this straightforwardly, the algorithm gets slow in + * complex graphs, because the same arcs get copied to all + * intermediate states of an EMPTY chain, and then uselessly pushed + * repeatedly to the chain's final state; we waste a lot of time in + * newarc's duplicate checking. To improve matters, we decree that + * any state with only EMPTY out-arcs is "doomed" and will not be + * part of the final NFA. That can be ensured by not adding any new + * out-arcs to such a state. Having ensured that, we need not update + * the state's in-arcs list either; all arcs that might have gotten + * pushed forward to it will just get pushed directly to successor + * states. This eliminates most of the useless duplicate arcs. + */ + for (s = nfa->states; s != NULL && !NISERR(); s = s->next) { + for (s2 = emptyreachable(s, s); s2 != s && !NISERR(); + s2 = nexts) { + /* + * If s2 is doomed, we decide that (1) we will always push + * arcs forward to it, not pull them back to s; and (2) we + * can optimize away the push-forward, per comment above. + * So do nothing. + */ + if (s2->flag || hasnonemptyout(s2)) { + replaceempty(nfa, s, s2); } + + /* Reset the tmp fields as we walk back */ + nexts = s2->tmp; + s2->tmp = NULL; } - if (progress && f != NULL) { - dumpnfa(nfa, f); + s->tmp = NULL; + } + if (NISERR()) { + return; + } + + /* + * Remove all the EMPTY arcs, since we don't need them anymore. + */ + for (s = nfa->states; s != NULL; s = s->next) { + for (a = s->outs; a != NULL; a = nexta) { + nexta = a->outchain; + if (a->type == EMPTY) { + freearc(nfa, a); + } } - } while (progress && !NISERR()); + } + + /* + * And remove any states that have become useless. (This cleanup is + * not very thorough, and would be even less so if we tried to + * combine it with the previous step; but cleanup() will take care + * of anything we miss.) + */ + for (s = nfa->states; s != NULL; s = nexts) { + nexts = s->next; + if ((s->nins == 0 || s->nouts == 0) && !s->flag) { + dropstate(nfa, s); + } + } + + if (f != NULL) { + dumpnfa(nfa, f); + } } /* - - unempty - optimize out an EMPTY arc, if possible - * Actually, as it stands this function always succeeds, but the return value - * is kept with an eye on possible future changes. - ^ static int unempty(struct nfa *, struct arc *); + - emptyreachable - recursively find all states reachable from s by EMPTY arcs + * The return value is the last such state found. Its tmp field links back + * to the next-to-last such state, and so on back to s, so that all these + * states can be located without searching the whole NFA. + * The maximum recursion depth here is equal to the length of the longest + * loop-free chain of EMPTY arcs, which is surely no more than the size of + * the NFA, and in practice will be a lot less than that. + ^ static struct state *emptyreachable(struct state *, struct state *); */ -static int /* 0 couldn't, 1 could */ -unempty( - struct nfa *nfa, - struct arc *a) +static struct state * +emptyreachable( + struct state *s, + struct state *lastfound) { - struct state *from = a->from; - struct state *to = a->to; - int usefrom; /* work on from, as opposed to to? */ - - assert(a->type == EMPTY); - assert(from != nfa->pre && to != nfa->post); + struct arc *a; - if (from == to) { /* vacuous loop */ - freearc(nfa, a); - return 1; + s->tmp = lastfound; + lastfound = s; + for (a = s->outs; a != NULL; a = a->outchain) { + if (a->type == EMPTY && a->to->tmp == NULL) { + lastfound = emptyreachable(a->to, lastfound); + } } + return lastfound; +} + +/* + - replaceempty - replace an EMPTY arc chain with some non-empty arcs + * The EMPTY arc(s) should be deleted later, but we can't do it here because + * they may still be needed to identify other arc chains during fixempties(). + ^ static void replaceempty(struct nfa *, struct state *, struct state *); + */ +static void +replaceempty( + struct nfa *nfa, + struct state *from, + struct state *to) +{ + int fromouts; + int toins; + + assert(from != to); /* - * Decide which end to work on. + * Create replacement arcs that bypass the need for the EMPTY chain. We + * can do this either by pushing arcs forward (linking directly from + * "from"'s predecessors to "to") or by pulling them back (linking + * directly from "from" to "to"'s successors). In general, we choose + * whichever way creates greater fan-out or fan-in, so as to improve the + * odds of reducing the other state to zero in-arcs or out-arcs and + * thereby being able to delete it. However, if "from" is doomed (has no + * non-EMPTY out-arcs), we must keep it so, so always push forward in that + * case. + * + * The fan-out/fan-in comparison should count only non-EMPTY arcs. If + * "from" is doomed, we can skip counting "to"'s arcs, since we want to + * force taking the copynonemptyins path in that case. */ + fromouts = nonemptyouts(from); + toins = (fromouts == 0) ? 1 : nonemptyins(to); - usefrom = 1; /* default: attack from */ - if (from->nouts > to->nins) { - usefrom = 0; - } else if (from->nouts == to->nins) { - /* - * Decide on secondary issue: move/copy fewest arcs. - */ - - if (from->nins > to->nouts) { - usefrom = 0; - } + if (fromouts > toins) { + copyouts(nfa, to, from, 0); + return; + } + if (fromouts < toins) { + copyins(nfa, from, to, 0); + return; } - freearc(nfa, a); - if (usefrom) { - if (from->nouts == 0) { - /* - * Was the state's only outarc. - */ - - moveins(nfa, from, to); - freestate(nfa, from); - } else { - copyins(nfa, from, to); - } - } else { - if (to->nins == 0) { - /* - * Was the state's only inarc. - */ - - moveouts(nfa, to, from); - freestate(nfa, to); - } else { - copyouts(nfa, to, from); - } + /* + * fromouts == toins. Decide on secondary issue: copy fewest arcs. + * + * Doesn't seem to be worth the trouble to exclude empties from these + * comparisons; that takes extra time and doesn't seem to improve the + * resulting graph much. + */ + if (from->nins > to->nouts) { + copyouts(nfa, to, from, 0); + return; } - return 1; + copyins(nfa, from, to, 0); } /* diff --git a/generic/regcomp.c b/generic/regcomp.c index 65555aa..c93eb24 100644 --- a/generic/regcomp.c +++ b/generic/regcomp.c @@ -121,12 +121,15 @@ static void destroystate(struct nfa *, struct state *); static void newarc(struct nfa *, int, pcolor, struct state *, struct state *); static struct arc *allocarc(struct nfa *, struct state *); static void freearc(struct nfa *, struct arc *); +static int hasnonemptyout(struct state *); +static int nonemptyouts(struct state *); +static int nonemptyins(struct state *); static struct arc *findarc(struct state *, int, pcolor); static void cparc(struct nfa *, struct arc *, struct state *, struct state *); static void moveins(struct nfa *, struct state *, struct state *); -static void copyins(struct nfa *, struct state *, struct state *); +static void copyins(struct nfa *, struct state *, struct state *, int); static void moveouts(struct nfa *, struct state *, struct state *); -static void copyouts(struct nfa *, struct state *, struct state *); +static void copyouts(struct nfa *, struct state *, struct state *, int); static void cloneouts(struct nfa *, struct state *, struct state *, struct state *, int); static void delsub(struct nfa *, struct state *, struct state *); static void deltraverse(struct nfa *, struct state *, struct state *); @@ -144,7 +147,8 @@ static int push(struct nfa *, struct arc *); #define COMPATIBLE 3 /* compatible but not satisfied yet */ static int combine(struct arc *, struct arc *); static void fixempties(struct nfa *, FILE *); -static int unempty(struct nfa *, struct arc *); +static struct state *emptyreachable(struct state *, struct state *); +static void replaceempty(struct nfa *, struct state *, struct state *); static void cleanup(struct nfa *); static void markreachable(struct nfa *, struct state *, struct state *, struct state *); static void markcanreach(struct nfa *, struct state *, struct state *, struct state *); @@ -607,7 +611,7 @@ makesearch( for (s=slist ; s!=NULL ; s=s2) { s2 = newstate(nfa); - copyouts(nfa, s, s2); + copyouts(nfa, s, s2, 1); for (a=s->ins ; a!=NULL ; a=b) { b = a->inchain; @@ -738,6 +742,7 @@ parsebranch( /* NB, recursion in parseqatom() may swallow rest of branch */ parseqatom(v, stopper, type, lp, right, t); + NOERRN(); } if (!seencontent) { /* empty branch */ @@ -1234,6 +1239,7 @@ parseqatom( EMPTYARC(atom->end, rp); t->right = subre(v, '=', 0, atom->end, rp); } + NOERR(); assert(SEE('|') || SEE(stopper) || SEE(EOS)); t->flags |= COMBINE(t->flags, t->right->flags); top->flags |= COMBINE(top->flags, t->flags); diff --git a/generic/regerrs.h b/generic/regerrs.h index 259c0cb..72548ff 100644 --- a/generic/regerrs.h +++ b/generic/regerrs.h @@ -17,3 +17,4 @@ { REG_MIXED, "REG_MIXED", "character widths of regex and string differ" }, { REG_BADOPT, "REG_BADOPT", "invalid embedded option" }, { REG_ETOOBIG, "REG_ETOOBIG", "nfa has too many states" }, +{ REG_ECOLORS, "REG_ECOLORS", "too many colors" }, diff --git a/generic/regex.h b/generic/regex.h index d6d46ce..9466fbb 100644 --- a/generic/regex.h +++ b/generic/regex.h @@ -281,6 +281,7 @@ typedef struct { #define REG_MIXED 17 /* character widths of regex and string differ */ #define REG_BADOPT 18 /* invalid embedded option */ #define REG_ETOOBIG 19 /* nfa has too many states */ +#define REG_ECOLORS 20 /* too many colors */ /* two specials for debugging and testing */ #define REG_ATOI 101 /* convert error-code name to number */ #define REG_ITOA 102 /* convert error-code number to name */ diff --git a/generic/regexec.c b/generic/regexec.c index 9b6a693..ad4b6e6 100644 --- a/generic/regexec.c +++ b/generic/regexec.c @@ -504,12 +504,7 @@ complicatedFindLoop( return er; } if ((shorter) ? end == estop : end == begin) { - /* - * No point in trying again. - */ - - *coldp = cold; - return REG_NOMATCH; + break; } /* diff --git a/generic/regguts.h b/generic/regguts.h index e57b8f8..b478e4c 100644 --- a/generic/regguts.h +++ b/generic/regguts.h @@ -145,6 +145,7 @@ typedef short color; /* colors of characters */ typedef int pcolor; /* what color promotes to */ +#define MAX_COLOR SHRT_MAX /* max color value */ #define COLORLESS (-1) /* impossible color */ #define WHITE 0 /* default color, parent of all others */ @@ -340,12 +341,12 @@ struct subre { #define CAP 010 /* capturing parens below */ #define BACKR 020 /* back reference below */ #define INUSE 0100 /* in use in final tree */ -#define LOCAL 03 /* bits which may not propagate up */ +#define NOPROP 03 /* bits which may not propagate up */ #define LMIX(f) ((f)<<2) /* LONGER -> MIXED */ #define SMIX(f) ((f)<<1) /* SHORTER -> MIXED */ -#define UP(f) (((f)&~LOCAL) | (LMIX(f) & SMIX(f) & MIXED)) +#define UP(f) (((f)&~NOPROP) | (LMIX(f) & SMIX(f) & MIXED)) #define MESSY(f) ((f)&(MIXED|CAP|BACKR)) -#define PREF(f) ((f)&LOCAL) +#define PREF(f) ((f)&NOPROP) #define PREF2(f1, f2) ((PREF(f1) != 0) ? PREF(f1) : PREF(f2)) #define COMBINE(f1, f2) (UP((f1)|(f2)) | PREF2(f1, f2)) short retry; /* index into retry memory */ @@ -366,7 +367,7 @@ struct subre { */ struct fns { - VOID FUNCPTR(free, (regex_t *)); + void FUNCPTR(free, (regex_t *)); }; /* diff --git a/generic/tcl.h b/generic/tcl.h index 3003abf..4bf81cc 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -56,10 +56,10 @@ extern "C" { #define TCL_MAJOR_VERSION 8 #define TCL_MINOR_VERSION 6 #define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE -#define TCL_RELEASE_SERIAL 0 +#define TCL_RELEASE_SERIAL 1 #define TCL_VERSION "8.6" -#define TCL_PATCH_LEVEL "8.6.0" +#define TCL_PATCH_LEVEL "8.6.1" /* *---------------------------------------------------------------------------- @@ -168,7 +168,7 @@ extern "C" { */ #if defined(__GNUC__) && ((__GNUC__ >= 4) || ((__GNUC__ == 3) && (__GNUC_MINOR__ >= 1))) -# if (__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC__MINOR__ >= 5)) +# if (__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ >= 5)) # define TCL_DEPRECATED_API(msg) __attribute__ ((__deprecated__ (msg))) # else # define TCL_DEPRECATED_API(msg) __attribute__ ((__deprecated__)) @@ -329,10 +329,12 @@ typedef long LONG; * in ANSI C; maps them to type "char *" in non-ANSI systems. */ -#ifndef NO_VOID -# define VOID void -#else -# define VOID char +#ifndef __VXWORKS__ +# ifndef NO_VOID +# define VOID void +# else +# define VOID char +# endif #endif /* @@ -456,7 +458,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; typedef struct _stat32i64 Tcl_StatBuf; # endif /* _MSC_VER < 1400 */ #elif defined(__CYGWIN__) - typedef struct _stat32i64 { + typedef struct { dev_t st_dev; unsigned short st_ino; unsigned short st_mode; @@ -472,7 +474,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; struct {long tv_sec;} st_ctim; /* Here is a 4-byte gap */ } Tcl_StatBuf; -#elif defined(HAVE_STRUCT_STAT64) +#elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__) typedef struct stat64 Tcl_StatBuf; #else typedef struct stat Tcl_StatBuf; @@ -504,11 +506,11 @@ typedef struct Tcl_Interp /* TIP #330: Strongly discourage extensions from using the string * result. */ #ifdef USE_INTERP_RESULT - char *result TCL_DEPRECATED_API("use Tcl_GetResult/Tcl_SetResult"); + char *result TCL_DEPRECATED_API("use Tcl_GetStringResult/Tcl_SetResult"); /* If the last command returned a string * result, this points to it. */ void (*freeProc) (char *blockPtr) - TCL_DEPRECATED_API("use Tcl_GetResult/Tcl_SetResult"); + TCL_DEPRECATED_API("use Tcl_GetStringResult/Tcl_SetResult"); /* Zero means the string result is statically * allocated. TCL_DYNAMIC means it was * allocated with ckalloc and should be freed @@ -2415,7 +2417,7 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, */ #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ - (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)())) + ((Tcl_CreateInterp)())) EXTERN void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp, @@ -2449,15 +2451,15 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); #ifdef TCL_MEM_DEBUG # define ckalloc(x) \ - ((VOID *) Tcl_DbCkalloc((unsigned)(x), __FILE__, __LINE__)) + ((void *) Tcl_DbCkalloc((unsigned)(x), __FILE__, __LINE__)) # define ckfree(x) \ Tcl_DbCkfree((char *)(x), __FILE__, __LINE__) # define ckrealloc(x,y) \ - ((VOID *) Tcl_DbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) + ((void *) Tcl_DbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) # define attemptckalloc(x) \ - ((VOID *) Tcl_AttemptDbCkalloc((unsigned)(x), __FILE__, __LINE__)) + ((void *) Tcl_AttemptDbCkalloc((unsigned)(x), __FILE__, __LINE__)) # define attemptckrealloc(x,y) \ - ((VOID *) Tcl_AttemptDbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) + ((void *) Tcl_AttemptDbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) #else /* !TCL_MEM_DEBUG */ @@ -2468,15 +2470,15 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); */ # define ckalloc(x) \ - ((VOID *) Tcl_Alloc((unsigned)(x))) + ((void *) Tcl_Alloc((unsigned)(x))) # define ckfree(x) \ Tcl_Free((char *)(x)) # define ckrealloc(x,y) \ - ((VOID *) Tcl_Realloc((char *)(x), (unsigned)(y))) + ((void *) Tcl_Realloc((char *)(x), (unsigned)(y))) # define attemptckalloc(x) \ - ((VOID *) Tcl_AttemptAlloc((unsigned)(x))) + ((void *) Tcl_AttemptAlloc((unsigned)(x))) # define attemptckrealloc(x,y) \ - ((VOID *) Tcl_AttemptRealloc((char *)(x), (unsigned)(y))) + ((void *) Tcl_AttemptRealloc((char *)(x), (unsigned)(y))) # undef Tcl_InitMemory # define Tcl_InitMemory(x) # undef Tcl_DumpActiveMemory @@ -2602,13 +2604,6 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); */ #ifndef TCL_NO_DEPRECATED -# undef Tcl_EvalObj -# define Tcl_EvalObj(interp,objPtr) \ - Tcl_EvalObjEx((interp),(objPtr),0) -# undef Tcl_GlobalEvalObj -# define Tcl_GlobalEvalObj(interp,objPtr) \ - Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL) - /* * These function have been renamed. The old names are deprecated, but we * define these macros for backwards compatibilty. diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 7833105..89c286a 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -20,7 +20,7 @@ *- break and continue - if exception ranges can be sorted out. *- foreach_start4, foreach_step4 *- returnImm, returnStk - *- expandStart, expandStkTop, invokeExpanded + *- expandStart, expandStkTop, invokeExpanded, expandDrop *- dictFirst, dictNext, dictDone *- dictUpdateStart, dictUpdateEnd *- jumpTable testing @@ -324,29 +324,6 @@ static const Tcl_ObjType assembleCodeType = { }; /* - * TIP #280: Remember the per-word line information of the current command. An - * index is used instead of a pointer as recursive compilation may reallocate, - * i.e. move, the array. This is also the reason to save the nuloc now, it may - * change during the course of the function. - * - * Macro to encapsulate the variable definition and setup. - */ - -#define DefineLineInformation \ - ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \ - int eclIndex = mapPtr->nuloc - 1 - -#define SetLineInformation(word) \ - envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \ - envPtr->clNext = mapPtr->loc[eclIndex].next[(word)] - -/* - * Flags bits used by PushVarName. - */ - -#define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */ - -/* * Source instructions recognized in the Tcl Assembly Language (TAL) */ @@ -372,7 +349,8 @@ static const TalInstDesc TalInstructionTable[] = { {"bitnot", ASSEM_1BYTE, INST_BITNOT, 1, 1}, {"bitor", ASSEM_1BYTE, INST_BITOR, 2, 1}, {"bitxor", ASSEM_1BYTE, INST_BITXOR, 2, 1}, - {"concat", ASSEM_CONCAT1, INST_CONCAT1, INT_MIN,1}, + {"concat", ASSEM_CONCAT1, INST_STR_CONCAT1, INT_MIN,1}, + {"concatStk", ASSEM_LIST, INST_CONCAT_STK, INT_MIN,1}, {"coroName", ASSEM_1BYTE, INST_COROUTINE_NAME, 0, 1}, {"currentNamespace",ASSEM_1BYTE, INST_NS_CURRENT, 0, 1}, {"dictAppend", ASSEM_LVT4, INST_DICT_APPEND, 2, 1}, @@ -410,9 +388,8 @@ static const TalInstDesc TalInstructionTable[] = { {"incrArrayStkImm", ASSEM_SINT1, INST_INCR_ARRAY_STK_IMM,2, 1}, {"incrImm", ASSEM_LVT1_SINT1, INST_INCR_SCALAR1_IMM, 0, 1}, - {"incrStk", ASSEM_1BYTE, INST_INCR_SCALAR_STK, 2, 1}, - {"incrStkImm", ASSEM_SINT1, INST_INCR_SCALAR_STK_IMM, - 1, 1}, + {"incrStk", ASSEM_1BYTE, INST_INCR_STK, 2, 1}, + {"incrStkImm", ASSEM_SINT1, INST_INCR_STK_IMM, 1, 1}, {"infoLevelArgs", ASSEM_1BYTE, INST_INFO_LEVEL_ARGS, 1, 1}, {"infoLevelNumber", ASSEM_1BYTE, INST_INFO_LEVEL_NUM, 0, 1}, {"invokeStk", ASSEM_INVOKE, (INST_INVOKE_STK1 << 8 @@ -437,6 +414,7 @@ static const TalInstDesc TalInstructionTable[] = { {"lindexMulti", ASSEM_LINDEX_MULTI, INST_LIST_INDEX_MULTI, INT_MIN,1}, {"list", ASSEM_LIST, INST_LIST, INT_MIN,1}, + {"listConcat", ASSEM_1BYTE, INST_LIST_CONCAT, 2, 1}, {"listIn", ASSEM_1BYTE, INST_LIST_IN, 2, 1}, {"listIndex", ASSEM_1BYTE, INST_LIST_INDEX, 2, 1}, {"listIndexImm", ASSEM_INDEX, INST_LIST_INDEX_IMM, 1, 1}, @@ -447,7 +425,7 @@ static const TalInstDesc TalInstructionTable[] = { {"loadArray", ASSEM_LVT, (INST_LOAD_ARRAY1<<8 | INST_LOAD_ARRAY4), 1, 1}, {"loadArrayStk", ASSEM_1BYTE, INST_LOAD_ARRAY_STK, 2, 1}, - {"loadStk", ASSEM_1BYTE, INST_LOAD_SCALAR_STK, 1, 1}, + {"loadStk", ASSEM_1BYTE, INST_LOAD_STK, 1, 1}, {"lor", ASSEM_1BYTE, INST_LOR, 2, 1}, {"lsetFlat", ASSEM_LSET_FLAT,INST_LSET_FLAT, INT_MIN,1}, {"lsetList", ASSEM_1BYTE, INST_LSET_LIST, 3, 1}, @@ -459,6 +437,7 @@ static const TalInstDesc TalInstructionTable[] = { {"nop", ASSEM_1BYTE, INST_NOP, 0, 0}, {"not", ASSEM_1BYTE, INST_LNOT, 1, 1}, {"nsupvar", ASSEM_LVT4, INST_NSUPVAR, 2, 1}, + {"originCmd", ASSEM_1BYTE, INST_ORIGIN_COMMAND, 1, 1}, {"over", ASSEM_OVER, INST_OVER, INT_MIN,-1-1}, {"pop", ASSEM_1BYTE, INST_POP, 1, 0}, {"pushReturnCode", ASSEM_1BYTE, INST_PUSH_RETURN_CODE, 0, 1}, @@ -474,8 +453,12 @@ static const TalInstDesc TalInstructionTable[] = { {"storeArray", ASSEM_LVT, (INST_STORE_ARRAY1<<8 | INST_STORE_ARRAY4), 2, 1}, {"storeArrayStk", ASSEM_1BYTE, INST_STORE_ARRAY_STK, 3, 1}, - {"storeStk", ASSEM_1BYTE, INST_STORE_SCALAR_STK, 2, 1}, + {"storeStk", ASSEM_1BYTE, INST_STORE_STK, 2, 1}, + {"strcaseLower", ASSEM_1BYTE, INST_STR_LOWER, 1, 1}, + {"strcaseTitle", ASSEM_1BYTE, INST_STR_TITLE, 1, 1}, + {"strcaseUpper", ASSEM_1BYTE, INST_STR_UPPER, 1, 1}, {"strcmp", ASSEM_1BYTE, INST_STR_CMP, 2, 1}, + {"strcat", ASSEM_CONCAT1, INST_STR_CONCAT1, INT_MIN,1}, {"streq", ASSEM_1BYTE, INST_STR_EQ, 2, 1}, {"strfind", ASSEM_1BYTE, INST_STR_FIND, 2, 1}, {"strindex", ASSEM_1BYTE, INST_STR_INDEX, 2, 1}, @@ -484,7 +467,11 @@ static const TalInstDesc TalInstructionTable[] = { {"strmatch", ASSEM_BOOL, INST_STR_MATCH, 2, 1}, {"strneq", ASSEM_1BYTE, INST_STR_NEQ, 2, 1}, {"strrange", ASSEM_1BYTE, INST_STR_RANGE, 3, 1}, + {"strreplace", ASSEM_1BYTE, INST_STR_REPLACE, 4, 1}, {"strrfind", ASSEM_1BYTE, INST_STR_FIND_LAST, 2, 1}, + {"strtrim", ASSEM_1BYTE, INST_STR_TRIM, 2, 1}, + {"strtrimLeft", ASSEM_1BYTE, INST_STR_TRIM_LEFT, 2, 1}, + {"strtrimRight", ASSEM_1BYTE, INST_STR_TRIM_RIGHT, 2, 1}, {"sub", ASSEM_1BYTE, INST_SUB, 2, 1}, {"tclooClass", ASSEM_1BYTE, INST_TCLOO_CLASS, 1, 1}, {"tclooIsObject", ASSEM_1BYTE, INST_TCLOO_IS_OBJECT, 1, 1}, @@ -516,6 +503,7 @@ static const unsigned char NonThrowingByteCodes[] = { INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP, /* 1-4 */ INST_JUMP1, INST_JUMP4, /* 34-35 */ INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, /* 70-72 */ + INST_LIST, /* 79 */ INST_OVER, /* 95 */ INST_PUSH_RETURN_OPTIONS, /* 108 */ INST_REVERSE, /* 126 */ @@ -525,7 +513,10 @@ static const unsigned char NonThrowingByteCodes[] = { INST_COROUTINE_NAME, /* 149 */ INST_NS_CURRENT, /* 151 */ INST_INFO_LEVEL_NUM, /* 152 */ - INST_RESOLVE_COMMAND /* 154 */ + INST_RESOLVE_COMMAND, /* 154 */ + INST_STR_TRIM, INST_STR_TRIM_LEFT, INST_STR_TRIM_RIGHT, /* 166-168 */ + INST_CONCAT_STK, /* 169 */ + INST_STR_UPPER, INST_STR_LOWER, INST_STR_TITLE /* 170-172 */ }; /* @@ -673,7 +664,7 @@ BBEmitOpcode( } TclEmitInt1(op, envPtr); - envPtr->atCmdStart = ((op) == INST_START_CMD); + TclUpdateAtCmdStart(op, envPtr); BBUpdateStackReqs(bbPtr, tblIdx, count); } @@ -705,7 +696,7 @@ BBEmitInstInt4( * BBEmitInst1or4 -- * * Emits a 1- or 4-byte operation according to the magnitude of the - * operand + * operand. * *----------------------------------------------------------------------------- */ @@ -734,7 +725,7 @@ BBEmitInst1or4( } else { TclEmitInt4(param, envPtr); } - envPtr->atCmdStart = ((op) == INST_START_CMD); + TclUpdateAtCmdStart(op, envPtr); BBUpdateStackReqs(bbPtr, tblIdx, count); } @@ -798,12 +789,10 @@ TclNRAssembleObjCmd( if (codePtr == NULL) { Tcl_AddErrorInfo(interp, "\n (\""); - Tcl_AddErrorInfo(interp, Tcl_GetString(objv[0])); + Tcl_AppendObjToErrorInfo(interp, objv[0]); Tcl_AddErrorInfo(interp, "\" body, line "); backtrace = Tcl_NewIntObj(Tcl_GetErrorLine(interp)); - Tcl_IncrRefCount(backtrace); - Tcl_AddErrorInfo(interp, Tcl_GetString(backtrace)); - Tcl_DecrRefCount(backtrace); + Tcl_AppendObjToErrorInfo(interp, backtrace); Tcl_AddErrorInfo(interp, ")"); return TCL_ERROR; } @@ -841,16 +830,11 @@ CompileAssembleObj( CompileEnv compEnv; /* Compilation environment structure */ register ByteCode *codePtr = NULL; /* Bytecode resulting from the assembly */ - register const AuxData * auxDataPtr; - /* Pointer to an auxiliary data element - * in a compilation environment being - * destroyed. */ Namespace* namespacePtr; /* Namespace in which variable and command * names in the bytecode resolve */ int status; /* Status return from Tcl_AssembleCode */ const char* source; /* String representation of the source code */ int sourceLen; /* Length of the source code in bytes */ - int i; /* @@ -860,7 +844,7 @@ CompileAssembleObj( if (objPtr->typePtr == &assembleCodeType) { namespacePtr = iPtr->varFramePtr->nsPtr; - codePtr = objPtr->internalRep.otherValuePtr; + codePtr = objPtr->internalRep.twoPtrValue.ptr1; if (((Interp *) *codePtr->interpHandle == iPtr) && (codePtr->compileEpoch == iPtr->compileEpoch) && (codePtr->nsPtr == namespacePtr) @@ -888,44 +872,6 @@ CompileAssembleObj( /* * Assembly failed. Clean up and report the error. */ - - /* - * Free any literals that were constructed for the assembly. - */ - for (i = 0; i < compEnv.literalArrayNext; i++) { - TclReleaseLiteral(interp, compEnv.literalArrayPtr[i].objPtr); - } - - /* - * Free any auxiliary data that was attached to the bytecode - * under construction. - */ - - for (i = 0; i < compEnv.auxDataArrayNext; i++) { - auxDataPtr = compEnv.auxDataArrayPtr + i; - if (auxDataPtr->type->freeProc != NULL) { - (auxDataPtr->type->freeProc)(auxDataPtr->clientData); - } - } - - /* - * TIP 280. If there is extended command line information, - * we need to clean it up. - */ - - if (compEnv.extCmdMapPtr != NULL) { - if (compEnv.extCmdMapPtr->type == TCL_LOCATION_SOURCE) { - Tcl_DecrRefCount(compEnv.extCmdMapPtr->path); - } - for (i = 0; i < compEnv.extCmdMapPtr->nuloc; ++i) { - ckfree(compEnv.extCmdMapPtr->loc[i].line); - } - if (compEnv.extCmdMapPtr->loc != NULL) { - ckfree(compEnv.extCmdMapPtr->loc); - } - Tcl_DeleteHashTable(&(compEnv.extCmdMapPtr->litInfo)); - } - TclFreeCompileEnv(&compEnv); return NULL; } @@ -945,7 +891,7 @@ CompileAssembleObj( * Record the local variable context to which the bytecode pertains */ - codePtr = objPtr->internalRep.otherValuePtr; + codePtr = objPtr->internalRep.twoPtrValue.ptr1; if (iPtr->varFramePtr->localCachePtr) { codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr; codePtr->localCachePtr->refCount++; @@ -998,6 +944,10 @@ TclCompileAssembleCmd( { Tcl_Token *tokenPtr; /* Token in the input script */ + int numCommands = envPtr->numCommands; + int offset = envPtr->codeNext - envPtr->codeStart; + int depth = envPtr->currStackDepth; + /* * Make sure that the command has a single arg that is a simple word. */ @@ -1011,10 +961,23 @@ TclCompileAssembleCmd( } /* - * Compile the code and return any error from the compilation. + * Compile the code and convert any error from the compilation into + * bytecode reporting the error; */ - return TclAssembleCode(envPtr, tokenPtr[1].start, tokenPtr[1].size, 0); + if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start, + tokenPtr[1].size, TCL_EVAL_DIRECT)) { + + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (\"%.*s\" body, line %d)", + parsePtr->tokenPtr->size, parsePtr->tokenPtr->start, + Tcl_GetErrorLine(interp))); + envPtr->numCommands = numCommands; + envPtr->codeNext = envPtr->codeStart + offset; + envPtr->currStackDepth = depth; + TclCompileSyntaxError(interp, envPtr); + } + return TCL_OK; } /* @@ -1053,8 +1016,6 @@ TclAssembleCode( const char* instPtr = codePtr; /* Where to start looking for a line of code */ - int instLen; /* Length in bytes of the current line of - * code */ const char* nextPtr; /* Pointer to the end of the line of code */ int bytesLeft = codeLen; /* Number of bytes of source code remaining to * be parsed */ @@ -1068,10 +1029,6 @@ TclAssembleCode( */ status = Tcl_ParseCommand(interp, instPtr, bytesLeft, 0, parsePtr); - instLen = parsePtr->commandSize; - if (parsePtr->term == parsePtr->commandStart + instLen - 1) { - --instLen; - } /* * Report errors in the parse. @@ -1080,7 +1037,7 @@ TclAssembleCode( if (status != TCL_OK) { if (flags & TCL_EVAL_DIRECT) { Tcl_LogCommandInfo(interp, codePtr, parsePtr->commandStart, - instLen); + parsePtr->term + 1 - parsePtr->commandStart); } FreeAssemblyEnv(assemEnvPtr); return TCL_ERROR; @@ -1100,6 +1057,13 @@ TclAssembleCode( */ if (parsePtr->numWords > 0) { + int instLen = parsePtr->commandSize; + /* Length in bytes of the current command */ + + if (parsePtr->term == parsePtr->commandStart + instLen - 1) { + --instLen; + } + /* * If tracing, show each line assembled as it happens. */ @@ -1175,7 +1139,7 @@ NewAssemblyEnv( assemEnvPtr->envPtr = envPtr; assemEnvPtr->parsePtr = parsePtr; - assemEnvPtr->cmdLine = envPtr->line; + assemEnvPtr->cmdLine = 1; assemEnvPtr->clNext = envPtr->clNext; /* @@ -2667,6 +2631,7 @@ AllocBB( bb->minStackDepth = 0; bb->maxStackDepth = 0; bb->finalStackDepth = 0; + bb->catchDepth = 0; bb->enclosingCatch = NULL; bb->foreignExceptionBase = -1; bb->foreignExceptionCount = 0; @@ -3097,7 +3062,7 @@ ResolveJumpTableTargets( auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1); DEBUG_PRINT("bbPtr = %p jumpOffset = %d auxDataIndex = %d\n", bbPtr, bbPtr->jumpOffset, auxDataIndex); - realJumpTablePtr = envPtr->auxDataArrayPtr[auxDataIndex].clientData; + realJumpTablePtr = TclFetchAuxData(envPtr, auxDataIndex); realJumpHashPtr = &realJumpTablePtr->hashTable; /* @@ -4270,11 +4235,11 @@ AddBasicBlockRangeToErrorInfo( Tcl_AddErrorInfo(interp, "\n in assembly code between lines "); lineNo = Tcl_NewIntObj(bbPtr->startLine); Tcl_IncrRefCount(lineNo); - Tcl_AddErrorInfo(interp, Tcl_GetString(lineNo)); + Tcl_AppendObjToErrorInfo(interp, lineNo); Tcl_AddErrorInfo(interp, " and "); if (bbPtr->successor1 != NULL) { Tcl_SetIntObj(lineNo, bbPtr->successor1->startLine); - Tcl_AddErrorInfo(interp, Tcl_GetString(lineNo)); + Tcl_AppendObjToErrorInfo(interp, lineNo); } else { Tcl_AddErrorInfo(interp, "end of assembly code"); } @@ -4338,14 +4303,13 @@ static void FreeAssembleCodeInternalRep( Tcl_Obj *objPtr) { - ByteCode *codePtr = objPtr->internalRep.otherValuePtr; + ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1; codePtr->refCount--; if (codePtr->refCount <= 0) { TclCleanupByteCode(codePtr); } objPtr->typePtr = NULL; - objPtr->internalRep.otherValuePtr = NULL; } /* diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 562cca6..7c02706 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -127,15 +127,12 @@ static Tcl_ObjCmdProc ExprSqrtFunc; static Tcl_ObjCmdProc ExprSrandFunc; static Tcl_ObjCmdProc ExprUnaryFunc; static Tcl_ObjCmdProc ExprWideFunc; -static Tcl_Obj * GetCommandSource(Interp *iPtr, int objc, - Tcl_Obj *const objv[], int lookup); static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, int actual, Tcl_Obj *const *objv); static Tcl_NRPostProc NRCoroutineCallerCallback; static Tcl_NRPostProc NRCoroutineExitCallback; static int NRCommand(ClientData data[], Tcl_Interp *interp, int result); -static Tcl_NRPostProc NRRunObjProc; static Tcl_ObjCmdProc OldMathFuncProc; static void OldMathFuncDeleteProc(ClientData clientData); static void ProcessUnexpectedResult(Tcl_Interp *interp, @@ -149,8 +146,8 @@ static inline Command * TEOV_LookupCmdFromObj(Tcl_Interp *interp, static int TEOV_NotFound(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Namespace *lookupNsPtr); static int TEOV_RunEnterTraces(Tcl_Interp *interp, - Command **cmdPtrPtr, int objc, - Tcl_Obj *const objv[], Namespace *lookupNsPtr); + Command **cmdPtrPtr, Tcl_Obj *commandPtr, int objc, + Tcl_Obj *const objv[]); static Tcl_NRPostProc RewindCoroutineCallback; static Tcl_NRPostProc TailcallCleanup; static Tcl_NRPostProc TEOEx_ByteCodeCallback; @@ -160,11 +157,11 @@ static Tcl_NRPostProc TEOV_Exception; static Tcl_NRPostProc TEOV_NotFoundCallback; static Tcl_NRPostProc TEOV_RestoreVarFrame; static Tcl_NRPostProc TEOV_RunLeaveTraces; -static Tcl_NRPostProc YieldToCallback; +static Tcl_NRPostProc EvalObjvCore; +static Tcl_NRPostProc Dispatch; -static void ClearTailcall(Tcl_Interp *interp, - struct NRE_callback *tailcallPtr); static Tcl_ObjCmdProc NRCoroInjectObjCmd; +static Tcl_NRPostProc NRPostInvoke; MODULE_SCOPE const TclStubs tclStubs; @@ -188,11 +185,16 @@ typedef struct { Tcl_ObjCmdProc *objProc; /* Object-based function for command. */ CompileProc *compileProc; /* Function called to compile command. */ Tcl_ObjCmdProc *nreProc; /* NR-based function for command */ - int isSafe; /* If non-zero, command will be present in - * safe interpreter. Otherwise it will be - * hidden. */ + int flags; /* Various flag bits, as defined below. */ } CmdInfo; +#define CMD_IS_SAFE 1 /* Whether this command is part of the set of + * commands present by default in a safe + * interpreter. */ +/* CMD_COMPILES_EXPANDED - Whether the compiler for this command can handle + * expansion for itself rather than needing the generic layer to take care of + * it for it. Defined in tclInt.h. */ + /* * The built-in commands, and the functions that implement them: */ @@ -202,95 +204,95 @@ static const CmdInfo builtInCmds[] = { * Commands in the generic core. */ - {"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, 1}, - {"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, 1}, - {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, 1}, + {"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE}, + {"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE}, + {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE}, #ifndef EXCLUDE_OBSOLETE_COMMANDS - {"case", Tcl_CaseObjCmd, NULL, NULL, 1}, + {"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE}, #endif - {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, 1}, - {"concat", Tcl_ConcatObjCmd, NULL, NULL, 1}, - {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, 1}, - {"coroutine", NULL, NULL, TclNRCoroutineObjCmd, 1}, - {"error", Tcl_ErrorObjCmd, TclCompileErrorCmd, NULL, 1}, - {"eval", Tcl_EvalObjCmd, NULL, TclNREvalObjCmd, 1}, - {"expr", Tcl_ExprObjCmd, TclCompileExprCmd, TclNRExprObjCmd, 1}, - {"for", Tcl_ForObjCmd, TclCompileForCmd, TclNRForObjCmd, 1}, - {"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, TclNRForeachCmd, 1}, - {"format", Tcl_FormatObjCmd, TclCompileFormatCmd, NULL, 1}, - {"global", Tcl_GlobalObjCmd, TclCompileGlobalCmd, NULL, 1}, - {"if", Tcl_IfObjCmd, TclCompileIfCmd, TclNRIfObjCmd, 1}, - {"incr", Tcl_IncrObjCmd, TclCompileIncrCmd, NULL, 1}, - {"join", Tcl_JoinObjCmd, NULL, NULL, 1}, - {"lappend", Tcl_LappendObjCmd, TclCompileLappendCmd, NULL, 1}, - {"lassign", Tcl_LassignObjCmd, TclCompileLassignCmd, NULL, 1}, - {"lindex", Tcl_LindexObjCmd, TclCompileLindexCmd, NULL, 1}, - {"linsert", Tcl_LinsertObjCmd, NULL, NULL, 1}, - {"list", Tcl_ListObjCmd, TclCompileListCmd, NULL, 1}, - {"llength", Tcl_LlengthObjCmd, TclCompileLlengthCmd, NULL, 1}, - {"lmap", Tcl_LmapObjCmd, TclCompileLmapCmd, TclNRLmapCmd, 1}, - {"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, 1}, - {"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, 1}, - {"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, 1}, - {"lreverse", Tcl_LreverseObjCmd, NULL, NULL, 1}, - {"lsearch", Tcl_LsearchObjCmd, NULL, NULL, 1}, - {"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, 1}, - {"lsort", Tcl_LsortObjCmd, NULL, NULL, 1}, - {"package", Tcl_PackageObjCmd, NULL, NULL, 1}, - {"proc", Tcl_ProcObjCmd, NULL, NULL, 1}, - {"regexp", Tcl_RegexpObjCmd, TclCompileRegexpCmd, NULL, 1}, - {"regsub", Tcl_RegsubObjCmd, TclCompileRegsubCmd, NULL, 1}, - {"rename", Tcl_RenameObjCmd, NULL, NULL, 1}, - {"return", Tcl_ReturnObjCmd, TclCompileReturnCmd, NULL, 1}, - {"scan", Tcl_ScanObjCmd, NULL, NULL, 1}, - {"set", Tcl_SetObjCmd, TclCompileSetCmd, NULL, 1}, - {"split", Tcl_SplitObjCmd, NULL, NULL, 1}, - {"subst", Tcl_SubstObjCmd, TclCompileSubstCmd, TclNRSubstObjCmd, 1}, - {"switch", Tcl_SwitchObjCmd, TclCompileSwitchCmd, TclNRSwitchObjCmd, 1}, - {"tailcall", NULL, TclCompileTailcallCmd, TclNRTailcallObjCmd, 1}, - {"throw", Tcl_ThrowObjCmd, TclCompileThrowCmd, NULL, 1}, - {"trace", Tcl_TraceObjCmd, NULL, NULL, 1}, - {"try", Tcl_TryObjCmd, TclCompileTryCmd, TclNRTryObjCmd, 1}, - {"unset", Tcl_UnsetObjCmd, TclCompileUnsetCmd, NULL, 1}, - {"uplevel", Tcl_UplevelObjCmd, NULL, TclNRUplevelObjCmd, 1}, - {"upvar", Tcl_UpvarObjCmd, TclCompileUpvarCmd, NULL, 1}, - {"variable", Tcl_VariableObjCmd, TclCompileVariableCmd, NULL, 1}, - {"while", Tcl_WhileObjCmd, TclCompileWhileCmd, TclNRWhileObjCmd, 1}, - {"yield", NULL, TclCompileYieldCmd, TclNRYieldObjCmd, 1}, - {"yieldto", NULL, NULL, TclNRYieldToObjCmd, 1}, + {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE}, + {"concat", Tcl_ConcatObjCmd, TclCompileConcatCmd, NULL, CMD_IS_SAFE}, + {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, CMD_IS_SAFE}, + {"coroutine", NULL, NULL, TclNRCoroutineObjCmd, CMD_IS_SAFE}, + {"error", Tcl_ErrorObjCmd, TclCompileErrorCmd, NULL, CMD_IS_SAFE}, + {"eval", Tcl_EvalObjCmd, NULL, TclNREvalObjCmd, CMD_IS_SAFE}, + {"expr", Tcl_ExprObjCmd, TclCompileExprCmd, TclNRExprObjCmd, CMD_IS_SAFE}, + {"for", Tcl_ForObjCmd, TclCompileForCmd, TclNRForObjCmd, CMD_IS_SAFE}, + {"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, TclNRForeachCmd, CMD_IS_SAFE}, + {"format", Tcl_FormatObjCmd, TclCompileFormatCmd, NULL, CMD_IS_SAFE}, + {"global", Tcl_GlobalObjCmd, TclCompileGlobalCmd, NULL, CMD_IS_SAFE}, + {"if", Tcl_IfObjCmd, TclCompileIfCmd, TclNRIfObjCmd, CMD_IS_SAFE}, + {"incr", Tcl_IncrObjCmd, TclCompileIncrCmd, NULL, CMD_IS_SAFE}, + {"join", Tcl_JoinObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"lappend", Tcl_LappendObjCmd, TclCompileLappendCmd, NULL, CMD_IS_SAFE}, + {"lassign", Tcl_LassignObjCmd, TclCompileLassignCmd, NULL, CMD_IS_SAFE}, + {"lindex", Tcl_LindexObjCmd, TclCompileLindexCmd, NULL, CMD_IS_SAFE}, + {"linsert", Tcl_LinsertObjCmd, TclCompileLinsertCmd, NULL, CMD_IS_SAFE}, + {"list", Tcl_ListObjCmd, TclCompileListCmd, NULL, CMD_IS_SAFE|CMD_COMPILES_EXPANDED}, + {"llength", Tcl_LlengthObjCmd, TclCompileLlengthCmd, NULL, CMD_IS_SAFE}, + {"lmap", Tcl_LmapObjCmd, TclCompileLmapCmd, TclNRLmapCmd, CMD_IS_SAFE}, + {"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, CMD_IS_SAFE}, + {"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE}, + {"lreverse", Tcl_LreverseObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE}, + {"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"package", Tcl_PackageObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"proc", Tcl_ProcObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"regexp", Tcl_RegexpObjCmd, TclCompileRegexpCmd, NULL, CMD_IS_SAFE}, + {"regsub", Tcl_RegsubObjCmd, TclCompileRegsubCmd, NULL, CMD_IS_SAFE}, + {"rename", Tcl_RenameObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"return", Tcl_ReturnObjCmd, TclCompileReturnCmd, NULL, CMD_IS_SAFE}, + {"scan", Tcl_ScanObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"set", Tcl_SetObjCmd, TclCompileSetCmd, NULL, CMD_IS_SAFE}, + {"split", Tcl_SplitObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"subst", Tcl_SubstObjCmd, TclCompileSubstCmd, TclNRSubstObjCmd, CMD_IS_SAFE}, + {"switch", Tcl_SwitchObjCmd, TclCompileSwitchCmd, TclNRSwitchObjCmd, CMD_IS_SAFE}, + {"tailcall", NULL, TclCompileTailcallCmd, TclNRTailcallObjCmd, CMD_IS_SAFE}, + {"throw", Tcl_ThrowObjCmd, TclCompileThrowCmd, NULL, CMD_IS_SAFE}, + {"trace", Tcl_TraceObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"try", Tcl_TryObjCmd, TclCompileTryCmd, TclNRTryObjCmd, CMD_IS_SAFE}, + {"unset", Tcl_UnsetObjCmd, TclCompileUnsetCmd, NULL, CMD_IS_SAFE}, + {"uplevel", Tcl_UplevelObjCmd, NULL, TclNRUplevelObjCmd, CMD_IS_SAFE}, + {"upvar", Tcl_UpvarObjCmd, TclCompileUpvarCmd, NULL, CMD_IS_SAFE}, + {"variable", Tcl_VariableObjCmd, TclCompileVariableCmd, NULL, CMD_IS_SAFE}, + {"while", Tcl_WhileObjCmd, TclCompileWhileCmd, TclNRWhileObjCmd, CMD_IS_SAFE}, + {"yield", NULL, TclCompileYieldCmd, TclNRYieldObjCmd, CMD_IS_SAFE}, + {"yieldto", NULL, NULL, TclNRYieldToObjCmd, CMD_IS_SAFE}, /* * Commands in the OS-interface. Note that many of these are unsafe. */ - {"after", Tcl_AfterObjCmd, NULL, NULL, 1}, + {"after", Tcl_AfterObjCmd, NULL, NULL, CMD_IS_SAFE}, {"cd", Tcl_CdObjCmd, NULL, NULL, 0}, - {"close", Tcl_CloseObjCmd, NULL, NULL, 1}, - {"eof", Tcl_EofObjCmd, NULL, NULL, 1}, + {"close", Tcl_CloseObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"eof", Tcl_EofObjCmd, NULL, NULL, CMD_IS_SAFE}, {"encoding", Tcl_EncodingObjCmd, NULL, NULL, 0}, {"exec", Tcl_ExecObjCmd, NULL, NULL, 0}, {"exit", Tcl_ExitObjCmd, NULL, NULL, 0}, - {"fblocked", Tcl_FblockedObjCmd, NULL, NULL, 1}, + {"fblocked", Tcl_FblockedObjCmd, NULL, NULL, CMD_IS_SAFE}, {"fconfigure", Tcl_FconfigureObjCmd, NULL, NULL, 0}, - {"fcopy", Tcl_FcopyObjCmd, NULL, NULL, 1}, - {"fileevent", Tcl_FileEventObjCmd, NULL, NULL, 1}, - {"flush", Tcl_FlushObjCmd, NULL, NULL, 1}, - {"gets", Tcl_GetsObjCmd, NULL, NULL, 1}, + {"fcopy", Tcl_FcopyObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"fileevent", Tcl_FileEventObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"flush", Tcl_FlushObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"gets", Tcl_GetsObjCmd, NULL, NULL, CMD_IS_SAFE}, {"glob", Tcl_GlobObjCmd, NULL, NULL, 0}, {"load", Tcl_LoadObjCmd, NULL, NULL, 0}, {"open", Tcl_OpenObjCmd, NULL, NULL, 0}, - {"pid", Tcl_PidObjCmd, NULL, NULL, 1}, - {"puts", Tcl_PutsObjCmd, NULL, NULL, 1}, + {"pid", Tcl_PidObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"puts", Tcl_PutsObjCmd, NULL, NULL, CMD_IS_SAFE}, {"pwd", Tcl_PwdObjCmd, NULL, NULL, 0}, - {"read", Tcl_ReadObjCmd, NULL, NULL, 1}, - {"seek", Tcl_SeekObjCmd, NULL, NULL, 1}, + {"read", Tcl_ReadObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"seek", Tcl_SeekObjCmd, NULL, NULL, CMD_IS_SAFE}, {"socket", Tcl_SocketObjCmd, NULL, NULL, 0}, {"source", Tcl_SourceObjCmd, NULL, TclNRSourceObjCmd, 0}, - {"tell", Tcl_TellObjCmd, NULL, NULL, 1}, - {"time", Tcl_TimeObjCmd, NULL, NULL, 1}, + {"tell", Tcl_TellObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"time", Tcl_TimeObjCmd, NULL, NULL, CMD_IS_SAFE}, {"unload", Tcl_UnloadObjCmd, NULL, NULL, 0}, - {"update", Tcl_UpdateObjCmd, NULL, NULL, 1}, - {"vwait", Tcl_VwaitObjCmd, NULL, NULL, 1}, + {"update", Tcl_UpdateObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"vwait", Tcl_VwaitObjCmd, NULL, NULL, CMD_IS_SAFE}, {NULL, NULL, NULL, NULL, 0} }; @@ -484,6 +486,18 @@ Tcl_CreateInterp(void) Tcl_Panic("Tcl_CallFrame must not be smaller than CallFrame"); } +#if defined(_WIN32) && !defined(_WIN64) + if (sizeof(time_t) != 4) { + /*NOTREACHED*/ + Tcl_Panic("<time.h> is not compatible with MSVC"); + } + if ((TclOffset(Tcl_StatBuf,st_atime) != 32) + || (TclOffset(Tcl_StatBuf,st_ctime) != 40)) { + /*NOTREACHED*/ + Tcl_Panic("<sys/stat.h> is not compatible with MSVC"); + } +#endif + if (cancelTableInitialized == 0) { Tcl_MutexLock(&cancelLock); if (cancelTableInitialized == 0) { @@ -512,6 +526,9 @@ Tcl_CreateInterp(void) iPtr->hiddenCmdTablePtr = NULL; iPtr->interpInfo = NULL; + TCL_CT_ASSERT(sizeof(iPtr->extra) <= sizeof(Tcl_HashTable)); + iPtr->extra.optimizer = TclOptimizeBytecode; + iPtr->numLevels = 0; iPtr->maxNestingDepth = MAX_NESTING_DEPTH; iPtr->framePtr = NULL; /* Initialise as soon as :: is available */ @@ -771,6 +788,9 @@ Tcl_CreateInterp(void) cmdPtr->deleteProc = NULL; cmdPtr->deleteData = NULL; cmdPtr->flags = 0; + if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) { + cmdPtr->flags |= CMD_COMPILES_EXPANDED; + } cmdPtr->importRefPtr = NULL; cmdPtr->tracePtr = NULL; cmdPtr->nreProc = cmdInfoPtr->nreProc; @@ -1003,7 +1023,7 @@ TclHideUnsafeCommands( return TCL_ERROR; } for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) { - if (!cmdInfoPtr->isSafe) { + if (!(cmdInfoPtr->flags & CMD_IS_SAFE)) { Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name); } } @@ -1592,8 +1612,6 @@ DeleteInterpProc( ckfree(eclPtr->loc); } - Tcl_DeleteHashTable(&eclPtr->litInfo); - ckfree(eclPtr); Tcl_DeleteHashEntry(hPtr); } @@ -2159,12 +2177,9 @@ Tcl_CreateCommand( * future calls to Tcl_GetCommandName. * * Side effects: - * If no command named "cmdName" already exists for interp, one is - * created. Otherwise, if a command does exist, then if the object-based - * Tcl_ObjCmdProc is TclInvokeStringCommand, we assume Tcl_CreateCommand - * was called previously for the same command and just set its - * Tcl_ObjCmdProc to the argument "proc"; otherwise, we delete the old - * command. + * If a command named "cmdName" already exists for interp, it is + * first deleted. Then the new command is created from the arguments. + * [***] (See below for exception). * * In the future, during bytecode evaluation when "cmdName" is seen as * the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based @@ -2231,17 +2246,22 @@ Tcl_CreateObjCommand( if (!isNew) { cmdPtr = Tcl_GetHashValue(hPtr); + /* Command already exists. */ + /* - * Command already exists. If its object-based Tcl_ObjCmdProc is - * TclInvokeStringCommand, we just set its Tcl_ObjCmdProc to the - * argument "proc". Otherwise, we delete the old command. + * [***] This is wrong. See Tcl Bug a16752c252. + * However, this buggy behavior is kept under particular + * circumstances to accommodate deployed binaries of the + * "tclcompiler" program. http://sourceforge.net/projects/tclpro/ + * that crash if the bug is fixed. */ - if (cmdPtr->objProc == TclInvokeStringCommand) { + if (cmdPtr->objProc == TclInvokeStringCommand + && cmdPtr->clientData == clientData + && cmdPtr->deleteData == clientData + && cmdPtr->deleteProc == deleteProc) { cmdPtr->objProc = proc; cmdPtr->objClientData = clientData; - cmdPtr->deleteProc = deleteProc; - cmdPtr->deleteData = clientData; return (Tcl_Command) cmdPtr; } @@ -2394,8 +2414,8 @@ TclInvokeStringCommand( * A standard Tcl string result value. * * Side effects: - * Besides those side effects of the called Tcl_CmdProc, - * TclInvokeStringCommand allocates and frees storage. + * Besides those side effects of the called Tcl_ObjCmdProc, + * TclInvokeObjectCommand allocates and frees storage. * *---------------------------------------------------------------------- */ @@ -3338,66 +3358,6 @@ CancelEvalProc( /* *---------------------------------------------------------------------- * - * 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. The Tcl_Obj has refCount==1. - * - * *** MAINTAINER WARNING *** - * The returned Tcl_Obj is all wrong for any purpose but getting the - * source string for an objc/objv command line in the stringRep (no - * stringRep if no source is available) and the corresponding substituted - * version in the List intrep. - * This means that the intRep and stringRep DO NOT COINCIDE! Using these - * Tcl_Objs normally is likely to break things. - * - *---------------------------------------------------------------------- - */ - -static Tcl_Obj * -GetCommandSource( - Interp *iPtr, - int objc, - Tcl_Obj *const objv[], - int lookup) -{ - Tcl_Obj *objPtr, *obj2Ptr; - CmdFrame *cfPtr = iPtr->cmdFramePtr; - const char *command = NULL; - int numChars; - - objPtr = Tcl_NewListObj(objc, objv); - if (lookup && cfPtr && (cfPtr->numLevels == iPtr->numLevels-1)) { - switch (cfPtr->type) { - case TCL_LOCATION_EVAL: - case TCL_LOCATION_SOURCE: - command = cfPtr->cmd.str.cmd; - numChars = cfPtr->cmd.str.len; - break; - case TCL_LOCATION_BC: - case TCL_LOCATION_PREBC: - command = TclGetSrcInfoForCmd(iPtr, &numChars); - break; - case TCL_LOCATION_EVAL_LIST: - /* Got it already */ - break; - } - if (command) { - obj2Ptr = Tcl_NewStringObj(command, numChars); - objPtr->bytes = obj2Ptr->bytes; - objPtr->length = numChars; - obj2Ptr->bytes = NULL; - Tcl_DecrRefCount(obj2Ptr); - } - } - Tcl_IncrRefCount(objPtr); - return objPtr; -} - -/* - *---------------------------------------------------------------------- - * * TclCleanupCommand -- * * This function frees up a Command structure unless it is still @@ -4158,43 +4118,39 @@ TclNREvalObjv( * requested Command struct to be invoked. */ { Interp *iPtr = (Interp *) interp; - int result; - Namespace *lookupNsPtr = iPtr->lookupNsPtr; - Command **cmdPtrPtr; - - iPtr->lookupNsPtr = NULL; /* - * Push a callback with cleanup tasks for commands; the cmdPtr at data[0] - * will be filled later when the command is found: save its address at - * objProcPtr. - * * data[1] stores a marker for use by tailcalls; it will be set to 1 by * command redirectors (imports, alias, ensembles) so that tailcalls * finishes the source command and not just the target. */ - if (iPtr->evalFlags & TCL_EVAL_REDIRECT) { - TclNRAddCallback(interp, NRCommand, NULL, INT2PTR(1), INT2PTR(objc), objv); - iPtr->evalFlags &= ~TCL_EVAL_REDIRECT; + if (iPtr->deferredCallbacks) { + iPtr->deferredCallbacks = NULL; } else { - TclNRAddCallback(interp, NRCommand, NULL, NULL, INT2PTR(objc), objv); + TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL); } - cmdPtrPtr = (Command **) &(TOP_CB(interp)->data[0]); - - TclNRSpliceDeferred(interp); iPtr->numLevels++; - result = TclInterpReady(interp); - - if ((result != TCL_OK) || (objc == 0)) { - return result; - } - - if (cmdPtr) { - goto commandFound; - } + TclNRAddCallback(interp, EvalObjvCore, cmdPtr, INT2PTR(flags), + INT2PTR(objc), objv); + return TCL_OK; +} +static int +EvalObjvCore( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + Command *cmdPtr = NULL, *preCmdPtr = data[0]; + int flags = PTR2INT(data[1]); + int objc = PTR2INT(data[2]); + Tcl_Obj **objv = data[3]; + Interp *iPtr = (Interp *) interp; + Namespace *lookupNsPtr = NULL; + int enterTracesDone = 0; + /* * Push records for task to be done on return, in INVERSE order. First, if * needed, the exception handlers (as they should happen last). @@ -4204,61 +4160,150 @@ TclNREvalObjv( TEOV_PushExceptionHandlers(interp, objc, objv, flags); } + if (TCL_OK != TclInterpReady(interp)) { + return TCL_ERROR; + } + + if (objc == 0) { + return TCL_OK; + } + + if (TclLimitExceeded(iPtr->limit)) { + return TCL_ERROR; + } + /* * Configure evaluation context to match the requested flags. */ - if ((flags & TCL_EVAL_INVOKE) || lookupNsPtr) { - if (!lookupNsPtr) { - lookupNsPtr = iPtr->globalNsPtr; - } + if (iPtr->lookupNsPtr) { + + /* + * Capture the namespace we should do command name resolution in, as + * instructed by our caller sneaking it in to us in a private interp + * field. Clear that field right away so we cannot possibly have its + * use leak where it should not. The sneaky message pass is done. + * + * Use of this mechanism overrides the TCL_EVAL_GLOBAL flag. + * TODO: Is that a bug? + */ + + lookupNsPtr = iPtr->lookupNsPtr; + iPtr->lookupNsPtr = NULL; + } else if (flags & TCL_EVAL_INVOKE) { + lookupNsPtr = iPtr->globalNsPtr; } else { - if (flags & TCL_EVAL_GLOBAL) { - TEOV_SwitchVarFrame(interp); - lookupNsPtr = iPtr->globalNsPtr; - } /* * TCL_EVAL_INVOKE was not set: clear rewrite rules */ iPtr->ensembleRewrite.sourceObjs = NULL; + + if (flags & TCL_EVAL_GLOBAL) { + TEOV_SwitchVarFrame(interp); + lookupNsPtr = iPtr->globalNsPtr; + } } /* - * Lookup the command + * Lookup the Command to dispatch. */ - cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr); - if (!cmdPtr) { - return TEOV_NotFound(interp, objc, objv, lookupNsPtr); + reresolve: + assert(cmdPtr == NULL); + if (preCmdPtr) { + /* Caller gave it to us */ + if (!(preCmdPtr->flags & CMD_IS_DELETED)) { + /* So long as it exists, use it. */ + cmdPtr = preCmdPtr; + } else if (flags & TCL_EVAL_NORESOLVE) { + /* + * When it's been deleted, and we're told not to attempt + * resolving it ourselves, all we can do is raise an error. + */ + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "attempt to invoke a deleted command")); + Tcl_SetErrorCode(interp, "TCL", "EVAL", "DELETEDCOMMAND", NULL); + return TCL_ERROR; + } } - - iPtr->cmdCount++; - if (TclLimitExceeded(iPtr->limit)) { - return TCL_ERROR; + if (cmdPtr == NULL) { + cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr); + if (!cmdPtr) { + return TEOV_NotFound(interp, objc, objv, lookupNsPtr); + } } - /* - * Found a command! The real work begins now ... - */ + if (enterTracesDone || iPtr->tracePtr + || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) { - commandFound: - if (iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) { - /* - * Call enter traces. They will schedule a call to the leave traces if - * necessary. - */ + Tcl_Obj *commandPtr = TclGetSourceFromFrame( + flags & TCL_EVAL_SOURCE_IN_FRAME ? iPtr->cmdFramePtr : NULL, + objc, objv); + Tcl_IncrRefCount(commandPtr); - result = TEOV_RunEnterTraces(interp, &cmdPtr, objc, objv, lookupNsPtr); - if (!cmdPtr) { - return TEOV_NotFound(interp, objc, objv, lookupNsPtr); - } - if (result != TCL_OK) { - return result; + if (!enterTracesDone) { + + int code = TEOV_RunEnterTraces(interp, &cmdPtr, commandPtr, + objc, objv); + + /* + * Send any exception from enter traces back as an exception + * raised by the traced command. + * TODO: Is this a bug? Letting an execution trace BREAK or + * CONTINUE or RETURN in the place of the traced command? + * Would either converting all exceptions to TCL_ERROR, or + * just swallowing them be better? (Swallowing them has the + * problem of permanently hiding program errors.) + */ + + if (code != TCL_OK) { + Tcl_DecrRefCount(commandPtr); + return code; + } + + /* + * If the enter traces made the resolved cmdPtr unusable, go + * back and resolve again, but next time don't run enter + * traces again. + */ + + if (cmdPtr == NULL) { + enterTracesDone = 1; + Tcl_DecrRefCount(commandPtr); + goto reresolve; + } } + + /* + * Schedule leave traces. Raise the refCount on the resolved + * cmdPtr, so that when it passes to the leave traces we know + * it's still valid. + */ + + cmdPtr->refCount++; + TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc), + commandPtr, cmdPtr, objv); } + TclNRAddCallback(interp, Dispatch, + cmdPtr->nreProc ? cmdPtr->nreProc : cmdPtr->objProc, + cmdPtr->objClientData, INT2PTR(objc), objv); + return TCL_OK; +} + +static int +Dispatch( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + Tcl_ObjCmdProc *objProc = data[0]; + ClientData clientData = data[1]; + int objc = PTR2INT(data[2]); + Tcl_Obj **objv = data[3]; + Interp *iPtr = (Interp *) interp; #ifdef USE_DTRACE if (TCL_DTRACE_CMD_ARGS_ENABLED()) { @@ -4279,42 +4324,18 @@ TclNREvalObjv( TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]); TclDecrRefCount(info); } - if (TCL_DTRACE_CMD_RETURN_ENABLED() || TCL_DTRACE_CMD_RESULT_ENABLED()) { + if ((TCL_DTRACE_CMD_RETURN_ENABLED() || TCL_DTRACE_CMD_RESULT_ENABLED()) + && objc) { TclNRAddCallback(interp, DTraceCmdReturn, objv[0], NULL, NULL, NULL); } - if (TCL_DTRACE_CMD_ENTRY_ENABLED()) { + if (TCL_DTRACE_CMD_ENTRY_ENABLED() && objc) { TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1, (Tcl_Obj **)(objv + 1)); } #endif /* USE_DTRACE */ - /* - * Fix the original callback to point to the now known cmdPtr. Insure that - * the Command struct lives until the command returns. - */ - - *cmdPtrPtr = cmdPtr; - cmdPtr->refCount++; - /* - * Find the objProc to call: nreProc if available, objProc otherwise. Push - * a callback to do the actual running. - */ - - if (cmdPtr->nreProc) { - TclNRAddCallback(interp, NRRunObjProc, cmdPtr, - INT2PTR(objc), (ClientData) objv, NULL); - return TCL_OK; - } else { - return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv); - } -} - -void -TclPushTailcallPoint( - Tcl_Interp *interp) -{ - TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL); - ((Interp *) interp)->numLevels++; + iPtr->cmdCount++; + return objProc(clientData, interp, objc, objv); } int @@ -4360,13 +4381,16 @@ NRCommand( int result) { Interp *iPtr = (Interp *) interp; - Command *cmdPtr = data[0]; - /* int cmdStart = PTR2INT(data[1]); NOT USED HERE */ - if (cmdPtr) { - TclCleanupCommandMacro(cmdPtr); + iPtr->numLevels--; + + /* + * If there is a tailcall, schedule it + */ + + if (data[1] && (data[1] != INT2PTR(1))) { + TclNRAddCallback(interp, TclNRTailcallEval, data[1], NULL, NULL, NULL); } - ((Interp *)interp)->numLevels--; /* OPT ?? * Do not interrupt a series of cleanups with async or limit checks: @@ -4385,22 +4409,6 @@ NRCommand( return result; } - -static int -NRRunObjProc( - ClientData data[], - Tcl_Interp *interp, - int result) -{ - /* OPT: do not call? */ - - Command* cmdPtr = data[0]; - int objc = PTR2INT(data[1]); - Tcl_Obj **objv = data[2]; - - return cmdPtr->nreProc(cmdPtr->objClientData, interp, objc, objv); -} - /* *---------------------------------------------------------------------- @@ -4625,9 +4633,9 @@ TEOV_NotFound( savedNsPtr = varFramePtr->nsPtr; varFramePtr->nsPtr = lookupNsPtr; } - TclNRDeferCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc), + TclSkipTailcall(interp); + TclNRAddCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc), newObjv, savedNsPtr, NULL); - iPtr->evalFlags |= TCL_EVAL_REDIRECT; return TclNREvalObjv(interp, newObjc, newObjv, TCL_EVAL_NOERR, NULL); } @@ -4664,27 +4672,21 @@ static int TEOV_RunEnterTraces( Tcl_Interp *interp, Command **cmdPtrPtr, + Tcl_Obj *commandPtr, int objc, - Tcl_Obj *const objv[], - Namespace *lookupNsPtr) + Tcl_Obj *const objv[]) { Interp *iPtr = (Interp *) interp; Command *cmdPtr = *cmdPtrPtr; - int traceCode = TCL_OK; - int cmdEpoch = cmdPtr->cmdEpoch; - int newEpoch; - const char *command; - int length; - Tcl_Obj *commandPtr; - - commandPtr = GetCommandSource(iPtr, objc, objv, 1); - command = Tcl_GetStringFromObj(commandPtr, &length); + int newEpoch, cmdEpoch = cmdPtr->cmdEpoch; + int length, traceCode = TCL_OK; + const char *command = Tcl_GetStringFromObj(commandPtr, &length); /* * Call trace functions. * 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. + * command's reference count for the duration of the calling of the + * traces so that the structure doesn't go away underneath our feet. */ cmdPtr->refCount++; @@ -4699,29 +4701,22 @@ TEOV_RunEnterTraces( newEpoch = cmdPtr->cmdEpoch; TclCleanupCommandMacro(cmdPtr); - /* - * If the traces modified/deleted the command or any existing traces, they - * will update the command's epoch. We need to lookup again, but do not - * run enter traces on the newly found cmdPtr. - */ - - if (cmdEpoch != newEpoch) { - cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr); - *cmdPtrPtr = cmdPtr; + if (traceCode != TCL_OK) { + if (traceCode == TCL_ERROR) { + Tcl_Obj *info; + + TclNewLiteralStringObj(info, "\n (enter trace on \""); + Tcl_AppendLimitedToObj(info, command, length, 55, "..."); + Tcl_AppendToObj(info, "\")", 2); + Tcl_AppendObjToErrorInfo(interp, info); + iPtr->flags |= ERR_ALREADY_LOGGED; + } + return traceCode; } - - if (cmdPtr) { - /* - * Command was found: push a record to schedule the leave traces. - */ - - TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(traceCode), - commandPtr, cmdPtr, NULL); - cmdPtr->refCount++; - } else { - Tcl_DecrRefCount(commandPtr); + if (cmdEpoch != newEpoch) { + *cmdPtrPtr = NULL; } - return traceCode; + return TCL_OK; } static int @@ -4731,20 +4726,16 @@ TEOV_RunLeaveTraces( int result) { Interp *iPtr = (Interp *) interp; - const char *command; - int length, objc; - Tcl_Obj **objv; - int traceCode = PTR2INT(data[0]); + int traceCode = TCL_OK; + int objc = PTR2INT(data[0]); Tcl_Obj *commandPtr = data[1]; Command *cmdPtr = data[2]; - - command = Tcl_GetStringFromObj(commandPtr, &length); - if (TCL_OK != Tcl_ListObjGetElements(interp, commandPtr, &objc, &objv)) { - Tcl_Panic("Who messed with commandPtr?"); - } + Tcl_Obj **objv = data[3]; + int length; + const char *command = Tcl_GetStringFromObj(commandPtr, &length); if (!(cmdPtr->flags & CMD_IS_DELETED)) { - if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && traceCode == TCL_OK){ + if (cmdPtr->flags & CMD_HAS_EXEC_TRACES){ traceCode = TclCheckExecutionTraces(interp, command, length, cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv); } @@ -4753,7 +4744,6 @@ TEOV_RunLeaveTraces( cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv); } } - Tcl_DecrRefCount(commandPtr); /* * As cmdPtr is set, TclNRRunCallbacks is about to reduce the numlevels. @@ -4764,8 +4754,18 @@ TEOV_RunLeaveTraces( TclCleanupCommandMacro(cmdPtr); if (traceCode != TCL_OK) { - return traceCode; + if (traceCode == TCL_ERROR) { + Tcl_Obj *info; + + TclNewLiteralStringObj(info, "\n (leave trace on \""); + Tcl_AppendLimitedToObj(info, command, length, 55, "..."); + Tcl_AppendToObj(info, "\")", 2); + Tcl_AppendObjToErrorInfo(interp, info); + iPtr->flags |= ERR_ALREADY_LOGGED; + } + result = traceCode; } + Tcl_DecrRefCount(commandPtr); return result; } @@ -4781,7 +4781,6 @@ TEOV_LookupCmdFromObj( if (lookupNsPtr) { iPtr->varFramePtr->nsPtr = lookupNsPtr; - iPtr->lookupNsPtr = NULL; } cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, namePtr); iPtr->varFramePtr->nsPtr = savedNsPtr; @@ -5000,31 +4999,22 @@ TclEvalEx( /* * TIP #280 Initialize tracking. Do not push on the frame stack yet. * - * We may continue counting based on a specific context (CTX), or open a - * new context, either for a sourced script, or 'eval'. For sourced files - * we always have a path object, even if nothing was specified in the - * interp itself. That makes code using it simpler as NULL checks can be - * left out. Sourced file without path in the 'scriptFile' is possible - * during Tcl initialization. + * We open a new context, either for a sourced script, or 'eval'. + * For sourced files we always have a path object, even if nothing was + * specified in the interp itself. That makes code using it simpler as + * NULL checks can be left out. Sourced file without path in the + * 'scriptFile' is possible during Tcl initialization. */ eeFramePtr->level = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level + 1 : 1; - eeFramePtr->numLevels = iPtr->numLevels; eeFramePtr->framePtr = iPtr->framePtr; eeFramePtr->nextPtr = iPtr->cmdFramePtr; eeFramePtr->nline = 0; eeFramePtr->line = NULL; + eeFramePtr->cmdObj = NULL; iPtr->cmdFramePtr = eeFramePtr; - if (iPtr->evalFlags & TCL_EVAL_CTX) { - /* - * Path information comes out of the context. - */ - - eeFramePtr->type = TCL_LOCATION_SOURCE; - eeFramePtr->data.eval.path = iPtr->invokeCmdFramePtr->data.eval.path; - Tcl_IncrRefCount(eeFramePtr->data.eval.path); - } else if (iPtr->evalFlags & TCL_EVAL_FILE) { + if (iPtr->evalFlags & TCL_EVAL_FILE) { /* * Set up for a sourced file. */ @@ -5067,7 +5057,9 @@ TclEvalEx( do { if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) { code = TCL_ERROR; - goto error; + Tcl_LogCommandInfo(interp, script, parsePtr->commandStart, + parsePtr->term + 1 - parsePtr->commandStart); + goto posterror; } /* @@ -5233,23 +5225,28 @@ TclEvalEx( * have been executed. */ - eeFramePtr->cmd.str.cmd = parsePtr->commandStart; - eeFramePtr->cmd.str.len = parsePtr->commandSize; + eeFramePtr->cmd = parsePtr->commandStart; + eeFramePtr->len = parsePtr->commandSize; if (parsePtr->term == parsePtr->commandStart + parsePtr->commandSize - 1) { - eeFramePtr->cmd.str.len--; + eeFramePtr->len--; } eeFramePtr->nline = objectsUsed; eeFramePtr->line = lines; TclArgumentEnter(interp, objv, objectsUsed, eeFramePtr); - code = Tcl_EvalObjv(interp, objectsUsed, objv, TCL_EVAL_NOERR); + code = Tcl_EvalObjv(interp, objectsUsed, objv, + TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME); TclArgumentRelease(interp, objv, objectsUsed); eeFramePtr->line = NULL; eeFramePtr->nline = 0; + if (eeFramePtr->cmdObj) { + Tcl_DecrRefCount(eeFramePtr->cmdObj); + eeFramePtr->cmdObj = NULL; + } if (code != TCL_OK) { goto error; @@ -5323,6 +5320,7 @@ TclEvalEx( Tcl_LogCommandInfo(interp, script, parsePtr->commandStart, commandLength); } + posterror: iPtr->flags &= ~ERR_ALREADY_LOGGED; /* @@ -5597,76 +5595,88 @@ TclArgumentBCEnter( int objc, void *codePtr, CmdFrame *cfPtr, + int cmd, int pc) { + ExtCmdLoc *eclPtr; + int word; + ECL *ePtr; + CFWordBC *lastPtr = NULL; Interp *iPtr = (Interp *) interp; Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr); - ExtCmdLoc *eclPtr; if (!hePtr) { return; } eclPtr = Tcl_GetHashValue(hePtr); - hePtr = Tcl_FindHashEntry(&eclPtr->litInfo, INT2PTR(pc)); - if (hePtr) { - int word; - int cmd = PTR2INT(Tcl_GetHashValue(hePtr)); - ECL *ePtr = &eclPtr->loc[cmd]; - CFWordBC *lastPtr = NULL; + ePtr = &eclPtr->loc[cmd]; - /* - * A few truths ... - * (1) ePtr->nline == objc - * (2) (ePtr->line[word] < 0) => !literal, for all words - * (3) (word == 0) => !literal - * - * Item (2) is why we can use objv to get the literals, and do not - * have to save them at compile time. - */ + /* + * ePtr->nline is the number of words originally parsed. + * + * objc is the number of elements getting invoked. + * + * If they are not the same, we arrived here by compiling an + * ensemble dispatch. Ensemble subcommands that lead to script + * evaluation are not supposed to get compiled, because a command + * such as [info level] in the script can expose some of the dispatch + * shenanigans. This means that we don't have to tend to the + * housekeeping, and can escape now. + */ + + if (ePtr->nline != objc) { + return; + } - if (ePtr->nline != objc) { - Tcl_Panic ("TIP 280 data structure inconsistency"); - } + /* + * Having disposed of the ensemble cases, we can state... + * A few truths ... + * (1) ePtr->nline == objc + * (2) (ePtr->line[word] < 0) => !literal, for all words + * (3) (word == 0) => !literal + * + * Item (2) is why we can use objv to get the literals, and do not + * have to save them at compile time. + */ - for (word = 1; word < objc; word++) { - if (ePtr->line[word] >= 0) { - int isnew; - Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr, - objv[word], &isnew); - CFWordBC *cfwPtr = ckalloc(sizeof(CFWordBC)); - - cfwPtr->framePtr = cfPtr; - cfwPtr->obj = objv[word]; - cfwPtr->pc = pc; - cfwPtr->word = word; - cfwPtr->nextPtr = lastPtr; - lastPtr = cfwPtr; - - if (isnew) { - /* - * The word is not on the stack yet, remember the current - * location and initialize references. - */ - - cfwPtr->prevPtr = NULL; - } else { - /* - * The object is already on the stack, however it may have - * a different location now (literal sharing may map - * multiple location to a single Tcl_Obj*. Save the old - * information in the new structure. - */ - - cfwPtr->prevPtr = Tcl_GetHashValue(hPtr); - } + for (word = 1; word < objc; word++) { + if (ePtr->line[word] >= 0) { + int isnew; + Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr, + objv[word], &isnew); + CFWordBC *cfwPtr = ckalloc(sizeof(CFWordBC)); + + cfwPtr->framePtr = cfPtr; + cfwPtr->obj = objv[word]; + cfwPtr->pc = pc; + cfwPtr->word = word; + cfwPtr->nextPtr = lastPtr; + lastPtr = cfwPtr; + + if (isnew) { + /* + * The word is not on the stack yet, remember the current + * location and initialize references. + */ - Tcl_SetHashValue(hPtr, cfwPtr); + cfwPtr->prevPtr = NULL; + } else { + /* + * The object is already on the stack, however it may have + * a different location now (literal sharing may map + * multiple location to a single Tcl_Obj*. Save the old + * information in the new structure. + */ + + cfwPtr->prevPtr = Tcl_GetHashValue(hPtr); } - } /* for */ - cfPtr->litarg = lastPtr; - } /* if */ + Tcl_SetHashValue(hPtr, cfwPtr); + } + } /* for */ + + cfPtr->litarg = lastPtr; } /* @@ -5814,6 +5824,7 @@ TclArgumentGet( *---------------------------------------------------------------------- */ +#undef Tcl_Eval int Tcl_Eval( Tcl_Interp *interp, /* Token for command interpreter (returned by @@ -5875,6 +5886,11 @@ Tcl_GlobalEvalObj( * compiled into bytecodes if necessary, unless TCL_EVAL_DIRECT is * specified. * + * If the flag TCL_EVAL_DIRECT is passed in, the value of invoker + * must be NULL. Support for non-NULL invokers in that mode has + * been removed since it was unused and untested. Failure to + * follow this limitation will lead to an assertion panic. + * * Results: * The return value is one of the return codes defined in tcl.h (such as * TCL_OK), and the interpreter's result contains a value to supplement @@ -5943,13 +5959,12 @@ TclNREvalObjEx( */ if (TclListObjIsCanonical(objPtr)) { - Tcl_Obj *listPtr = objPtr; CmdFrame *eoFramePtr = NULL; int objc; - Tcl_Obj **objv; + Tcl_Obj *listPtr, **objv; /* - * Pure List Optimization (no string representation). In this case, we + * Canonical List Optimization: In this case, we * can safely use Tcl_EvalObjv instead and get an appreciable * improvement in execution speed. This is because it allows us to * avoid a setFromAny step that would just pack everything into a @@ -5957,11 +5972,6 @@ TclNREvalObjEx( * * This also preserves any associations between list elements and * location information for such elements. - * - * This restriction has been relaxed a bit by storing in lists whether - * they are "canonical" or not (a canonical list being one that is - * either pure or that has its string rep derived by - * UpdateStringOfList from the internal rep). */ /* @@ -5970,13 +5980,13 @@ TclNREvalObjEx( * we always make a copy. The callback takes care od the refCounts for * both listPtr and objPtr. * + * TODO: Create a test to demo this need, or eliminate it. * FIXME OPT: preserve just the internal rep? */ Tcl_IncrRefCount(objPtr); listPtr = TclListObjCopy(interp, objPtr); Tcl_IncrRefCount(listPtr); - TclDecrRefCount(objPtr); if (word != INT_MIN) { /* @@ -5999,21 +6009,25 @@ TclNREvalObjEx( eoFramePtr->nline = 0; eoFramePtr->line = NULL; - eoFramePtr->type = TCL_LOCATION_EVAL_LIST; + eoFramePtr->type = TCL_LOCATION_EVAL; eoFramePtr->level = (iPtr->cmdFramePtr == NULL? 1 : iPtr->cmdFramePtr->level + 1); - eoFramePtr->numLevels = iPtr->numLevels; eoFramePtr->framePtr = iPtr->framePtr; eoFramePtr->nextPtr = iPtr->cmdFramePtr; - eoFramePtr->cmd.listPtr = listPtr; + eoFramePtr->cmdObj = objPtr; + eoFramePtr->cmd = NULL; + eoFramePtr->len = 0; eoFramePtr->data.eval.path = NULL; iPtr->cmdFramePtr = eoFramePtr; + + flags |= TCL_EVAL_SOURCE_IN_FRAME; } - TclNRDeferCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, - NULL, NULL); + TclMarkTailcall(interp); + TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, + objPtr, NULL); ListObjGetElements(listPtr, objc, objv); return TclNREvalObjv(interp, objc, objv, flags, NULL); @@ -6053,14 +6067,6 @@ TclNREvalObjEx( * We're not supposed to use the compiler or byte-code * interpreter. Let Tcl_EvalEx evaluate the command directly (and * probably more slowly). - * - * TIP #280. Propagate context as much as we can. Especially if the - * script to evaluate is a single literal it makes sense to look if - * our context is one with absolute line numbers we can then track - * into the literal itself too. - * - * See also tclCompile.c, TclInitCompileEnv, for the equivalent code - * in the bytecode compiler. */ const char *script; @@ -6084,92 +6090,19 @@ TclNREvalObjEx( */ ContLineLoc *saveCLLocPtr = iPtr->scriptCLLocPtr; - ContLineLoc *clLocPtr = TclContinuationsGet(objPtr); - - if (clLocPtr) { - iPtr->scriptCLLocPtr = clLocPtr; - Tcl_Preserve(iPtr->scriptCLLocPtr); - } else { - iPtr->scriptCLLocPtr = NULL; - } - Tcl_IncrRefCount(objPtr); - if (invoker == NULL) { - /* - * No context, force opening of our own. - */ + assert(invoker == NULL); - script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); - result = Tcl_EvalEx(interp, script, numSrcBytes, flags); - } else { - /* - * We have an invoker, describing the command asking for the - * evaluation of a subordinate script. This script may originate - * in a literal word, or from a variable, etc. Using the line - * array we now check if we have good line information for the - * relevant word. The type of context is relevant as well. In a - * non-'source' context we don't have to try tracking lines. - * - * First see if the word exists and is a literal. If not we go - * through the easy dynamic branch. No need to perform more - * complex invokations. - */ + iPtr->scriptCLLocPtr = TclContinuationsGet(objPtr); - int pc = 0; - CmdFrame *ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame)); - - *ctxPtr = *invoker; - if (invoker->type == TCL_LOCATION_BC) { - /* - * Note: Type BC => ctxPtr->data.eval.path is not used. - * ctxPtr->data.tebc.codePtr is used instead. - */ - - TclGetSrcInfoForPc(ctxPtr); - pc = 1; - } - - script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); - - if ((invoker->nline <= word) || - (invoker->line[word] < 0) || - (ctxPtr->type != TCL_LOCATION_SOURCE)) { - /* - * Dynamic script, or dynamic context, force our own context. - */ - - result = Tcl_EvalEx(interp, script, numSrcBytes, flags); - } else { - /* - * Absolute context to reuse. - */ - - iPtr->invokeCmdFramePtr = ctxPtr; - iPtr->evalFlags |= TCL_EVAL_CTX; - - result = TclEvalEx(interp, script, numSrcBytes, flags, - ctxPtr->line[word], NULL, script); - } - if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) { - /* - * Death of SrcInfo reference. - */ + Tcl_IncrRefCount(objPtr); - Tcl_DecrRefCount(ctxPtr->data.eval.path); - } - TclStackFree(interp, ctxPtr); - } + script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); + result = Tcl_EvalEx(interp, script, numSrcBytes, flags); - /* - * Now release the lock on the continuation line information, if any, - * and restore the caller's settings. - */ + TclDecrRefCount(objPtr); - if (iPtr->scriptCLLocPtr) { - Tcl_Release(iPtr->scriptCLLocPtr); - } iPtr->scriptCLLocPtr = saveCLLocPtr; - TclDecrRefCount(objPtr); return result; } } @@ -6229,6 +6162,7 @@ TEOEx_ListCallback( Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr = data[0]; CmdFrame *eoFramePtr = data[1]; + Tcl_Obj *objPtr = data[2]; /* * Remove the cmdFrame @@ -6238,6 +6172,7 @@ TEOEx_ListCallback( iPtr->cmdFramePtr = eoFramePtr->nextPtr; TclStackFree(interp, eoFramePtr); } + TclDecrRefCount(objPtr); TclDecrRefCount(listPtr); return result; @@ -6600,30 +6535,32 @@ TclObjInvoke( * TCL_INVOKE_HIDDEN, TCL_INVOKE_NO_UNKNOWN, * or TCL_INVOKE_NO_TRACEBACK. */ { - register Interp *iPtr = (Interp *) interp; - Tcl_HashTable *hTblPtr; /* Table of hidden commands. */ - const char *cmdName; /* Name of the command from objv[0]. */ - Tcl_HashEntry *hPtr = NULL; - Command *cmdPtr; - int result; - if (interp == NULL) { return TCL_ERROR; } - if ((objc < 1) || (objv == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "illegal argument vector", -1)); return TCL_ERROR; } - if ((flags & TCL_INVOKE_HIDDEN) == 0) { Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN"); } + return Tcl_NRCallObjProc(interp, TclNRInvoke, NULL, objc, objv); +} - if (TclInterpReady(interp) == TCL_ERROR) { - return TCL_ERROR; - } +int +TclNRInvoke( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + register Interp *iPtr = (Interp *) interp; + Tcl_HashTable *hTblPtr; /* Table of hidden commands. */ + const char *cmdName; /* Name of the command from objv[0]. */ + Tcl_HashEntry *hPtr = NULL; + Command *cmdPtr; cmdName = TclGetString(objv[0]); hTblPtr = iPtr->hiddenCmdTablePtr; @@ -6639,36 +6576,27 @@ TclObjInvoke( } cmdPtr = Tcl_GetHashValue(hPtr); - /* - * Invoke the command function. - */ - - iPtr->cmdCount++; - if (cmdPtr->objProc != NULL) { - result = cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv); - } else { - result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc, - cmdPtr->objClientData, objc, objv); - } + /* Avoid the exception-handling brain damage when numLevels == 0 . */ + iPtr->numLevels++; + Tcl_NRAddCallback(interp, NRPostInvoke, NULL, NULL, NULL, NULL); /* - * If an error occurred, record information about what was being executed - * when the error occurred. + * Normal command resolution of objv[0] isn't going to find cmdPtr. + * That's the whole point of **hidden** commands. So tell the + * Eval core machinery not to even try (and risk finding something wrong). */ - if ((result == TCL_ERROR) - && ((flags & TCL_INVOKE_NO_TRACEBACK) == 0) - && ((iPtr->flags & ERR_ALREADY_LOGGED) == 0)) { - int length; - Tcl_Obj *command = Tcl_NewListObj(objc, objv); - const char *cmdString; + return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NORESOLVE, cmdPtr); +} - Tcl_IncrRefCount(command); - cmdString = Tcl_GetStringFromObj(command, &length); - Tcl_LogCommandInfo(interp, cmdString, cmdString, length); - Tcl_DecrRefCount(command); - iPtr->flags &= ~ERR_ALREADY_LOGGED; - } +static int +NRPostInvoke( + ClientData clientData[], + Tcl_Interp *interp, + int result) +{ + Interp *iPtr = (Interp *)interp; + iPtr->numLevels--; return result; } @@ -6745,6 +6673,7 @@ Tcl_ExprString( *---------------------------------------------------------------------- */ +#undef Tcl_AddObjErrorInfo void Tcl_AppendObjToErrorInfo( Tcl_Interp *interp, /* Interpreter to which error information @@ -6778,6 +6707,7 @@ Tcl_AppendObjToErrorInfo( *---------------------------------------------------------------------- */ +#undef Tcl_AddErrorInfo void Tcl_AddErrorInfo( Tcl_Interp *interp, /* Interpreter to which error information @@ -6958,6 +6888,7 @@ Tcl_VarEval( *---------------------------------------------------------------------- */ +#undef Tcl_GlobalEval int Tcl_GlobalEval( Tcl_Interp *interp, /* Interpreter in which to evaluate @@ -7476,7 +7407,7 @@ ExprAbsFunc( return TCL_OK; } -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG if (type == TCL_NUMBER_WIDE) { Tcl_WideInt w = *((const Tcl_WideInt *) ptr); @@ -8116,39 +8047,11 @@ Tcl_NRCallObjProc( int objc, Tcl_Obj *const objv[]) { - int result = TCL_OK; NRE_callback *rootPtr = TOP_CB(interp); -#ifdef USE_DTRACE - if (TCL_DTRACE_CMD_ARGS_ENABLED()) { - const char *a[10]; - int i = 0; - - while (i < 10) { - a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++; - } - TCL_DTRACE_CMD_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], - a[8], a[9]); - } - if (TCL_DTRACE_CMD_INFO_ENABLED() && ((Interp *) interp)->cmdFramePtr) { - Tcl_Obj *info = TclInfoFrame(interp, ((Interp *) interp)->cmdFramePtr); - const char *a[6]; int i[2]; - - TclDTraceInfo(info, a, i); - TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]); - TclDecrRefCount(info); - } - if ((TCL_DTRACE_CMD_RETURN_ENABLED() || TCL_DTRACE_CMD_RESULT_ENABLED()) - && objc) { - TclNRAddCallback(interp, DTraceCmdReturn, objv[0], NULL, NULL, NULL); - } - if (TCL_DTRACE_CMD_ENTRY_ENABLED() && objc) { - TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1, - (Tcl_Obj **)(objv + 1)); - } -#endif /* USE_DTRACE */ - result = objProc(clientData, interp, objc, objv); - return TclNRRunCallbacks(interp, result, rootPtr); + TclNRAddCallback(interp, Dispatch, objProc, clientData, + INT2PTR(objc), objv); + return TclNRRunCallbacks(interp, TCL_OK, rootPtr); } /* @@ -8241,7 +8144,8 @@ Tcl_NRCmdSwap( Tcl_Obj *const objv[], int flags) { - return TclNREvalObjv(interp, objc, objv, flags, (Command *) cmd); + return TclNREvalObjv(interp, objc, objv, flags|TCL_EVAL_NOERR, + (Command *) cmd); } /***************************************************************************** @@ -8269,29 +8173,58 @@ Tcl_NRCmdSwap( */ void -TclSpliceTailcall( +TclMarkTailcall( + Tcl_Interp *interp) +{ + Interp *iPtr = (Interp *) interp; + + if (iPtr->deferredCallbacks == NULL) { + TclNRAddCallback(interp, NRCommand, NULL, NULL, + NULL, NULL); + iPtr->deferredCallbacks = TOP_CB(interp); + } +} + +void +TclSkipTailcall( + Tcl_Interp *interp) +{ + Interp *iPtr = (Interp *) interp; + + TclMarkTailcall(interp); + iPtr->deferredCallbacks->data[1] = INT2PTR(1); +} + +void +TclPushTailcallPoint( + Tcl_Interp *interp) +{ + TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL); + ((Interp *) interp)->numLevels++; +} + +void +TclSetTailcall( Tcl_Interp *interp, - NRE_callback *tailcallPtr) + Tcl_Obj *listPtr) { /* * Find the splicing spot: right before the NRCommand of the thing - * being tailcalled. Note that we skip NRCommands marked in data[1] + * being tailcalled. Note that we skip NRCommands marked by a 1 in data[1] * (used by command redirectors). */ NRE_callback *runPtr; for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) { - if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) { + if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) { break; } } if (!runPtr) { Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!"); } - - tailcallPtr->nextPtr = runPtr->nextPtr; - runPtr->nextPtr = tailcallPtr; + runPtr->data[1] = listPtr; } int @@ -8321,7 +8254,7 @@ TclNRTailcallObjCmd( */ if (iPtr->varFramePtr->tailcallPtr) { - ClearTailcall(interp, iPtr->varFramePtr->tailcallPtr); + Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr); iPtr->varFramePtr->tailcallPtr = NULL; } @@ -8336,23 +8269,20 @@ TclNRTailcallObjCmd( Tcl_Obj *listPtr, *nsObjPtr; Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; Tcl_Namespace *ns1Ptr; - NRE_callback *tailcallPtr; - listPtr = Tcl_NewListObj(objc-1, objv+1); - Tcl_IncrRefCount(listPtr); + /* The tailcall data is in a Tcl list: the first element is the + * namespace, the rest the command to be tailcalled. */ + + listPtr = Tcl_NewListObj(objc, objv); nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr)) || (nsPtr != ns1Ptr)) { Tcl_Panic("Tailcall failed to find the proper namespace"); } - Tcl_IncrRefCount(nsObjPtr); - - TclNRAddCallback(interp, TclNRTailcallEval, listPtr, nsObjPtr, - NULL, NULL); - tailcallPtr = TOP_CB(interp); - TOP_CB(interp) = tailcallPtr->nextPtr; - iPtr->varFramePtr->tailcallPtr = tailcallPtr; + TclListObjSetElement(interp, listPtr, 0, nsObjPtr); + + iPtr->varFramePtr->tailcallPtr = listPtr; } return TCL_RETURN; } @@ -8364,12 +8294,14 @@ TclNRTailcallEval( int result) { Interp *iPtr = (Interp *) interp; - Tcl_Obj *listPtr = data[0]; - Tcl_Obj *nsObjPtr = data[1]; + Tcl_Obj *listPtr = data[0], *nsObjPtr; Tcl_Namespace *nsPtr; int objc; Tcl_Obj **objv; + Tcl_ListObjGetElements(interp, listPtr, &objc, &objv); + nsObjPtr = objv[0]; + if (result == TCL_OK) { result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr); } @@ -8388,10 +8320,10 @@ TclNRTailcallEval( * Perform the tailcall */ - TclNRDeferCallback(interp, TailcallCleanup, listPtr, nsObjPtr, NULL,NULL); + TclMarkTailcall(interp); + TclNRAddCallback(interp, TailcallCleanup, listPtr, NULL, NULL,NULL); iPtr->lookupNsPtr = (Namespace *) nsPtr; - ListObjGetElements(listPtr, objc, objv); - return TclNREvalObjv(interp, objc, objv, 0, NULL); + return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL); } static int @@ -8401,19 +8333,9 @@ TailcallCleanup( int result) { Tcl_DecrRefCount((Tcl_Obj *) data[0]); - Tcl_DecrRefCount((Tcl_Obj *) data[1]); return result; } -static void -ClearTailcall( - Tcl_Interp *interp, - NRE_callback *tailcallPtr) -{ - TailcallCleanup(tailcallPtr->data, interp, TCL_OK); - TCLNR_FREE(interp, tailcallPtr); -} - void Tcl_NRAddCallback( @@ -8515,50 +8437,32 @@ TclNRYieldToObjCmd( * This is essentially code from TclNRTailcallObjCmd */ - listPtr = Tcl_NewListObj(objc-1, objv+1); - Tcl_IncrRefCount(listPtr); + /* + * Add the tailcall in the caller env, then just yield. + * + * This is essentially code from TclNRTailcallObjCmd + */ + + listPtr = Tcl_NewListObj(objc, objv); nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr)) || (nsPtr != ns1Ptr)) { Tcl_Panic("yieldto failed to find the proper namespace"); } - Tcl_IncrRefCount(nsObjPtr); + TclListObjSetElement(interp, listPtr, 0, nsObjPtr); + /* * Add the callback in the caller's env, then instruct TEBC to yield. */ iPtr->execEnvPtr = corPtr->callerEEPtr; - TclNRAddCallback(interp, YieldToCallback, corPtr, listPtr, nsObjPtr, - NULL); + TclSetTailcall(interp, listPtr); iPtr->execEnvPtr = corPtr->eePtr; return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv); } - -static int -YieldToCallback( - ClientData data[], - Tcl_Interp *interp, - int result) -{ - /* CoroutineData *corPtr = data[0];*/ - Tcl_Obj *listPtr = data[1]; - ClientData nsPtr = data[2]; - NRE_callback *cbPtr; - - /* - * yieldTo: invoke the command using tailcall tech. - */ - - TclNRAddCallback(interp, TclNRTailcallEval, listPtr, nsPtr, NULL, NULL); - cbPtr = TOP_CB(interp); - TOP_CB(interp) = cbPtr->nextPtr; - - TclSpliceTailcall(interp, cbPtr); - return TCL_OK; -} static int RewindCoroutineCallback( diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 5c33308..4e977f2 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -87,10 +87,13 @@ static int BinaryDecodeHex(ClientData clientData, static int BinaryEncode64(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int BinaryDecodeUu(ClientData clientData, +static int BinaryDecode64(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int BinaryDecode64(ClientData clientData, +static int BinaryEncodeUu(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +static int BinaryDecodeUu(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -128,6 +131,30 @@ static const char B64Digits[65] = { }; /* + * How to construct the ensembles. + */ + +static const EnsembleImplMap binaryMap[] = { + { "format", BinaryFormatCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0 }, + { "scan", BinaryScanCmd, TclCompileBasicMin2ArgCmd, NULL, NULL, 0 }, + { "encode", NULL, NULL, NULL, NULL, 0 }, + { "decode", NULL, NULL, NULL, NULL, 0 }, + { NULL, NULL, NULL, NULL, NULL, 0 } +}; +static const EnsembleImplMap encodeMap[] = { + { "hex", BinaryEncodeHex, TclCompileBasic1ArgCmd, NULL, NULL, 0 }, + { "uuencode", BinaryEncodeUu, NULL, NULL, NULL, 0 }, + { "base64", BinaryEncode64, NULL, NULL, NULL, 0 }, + { NULL, NULL, NULL, NULL, NULL, 0 } +}; +static const EnsembleImplMap decodeMap[] = { + { "hex", BinaryDecodeHex, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, + { "uuencode", BinaryDecodeUu, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, + { "base64", BinaryDecode64, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, + { NULL, NULL, NULL, NULL, NULL, 0 } +}; + +/* * The following object type represents an array of bytes. An array of bytes * is not equivalent to an internationalized string. Conceptually, a string is * an array of 16-bit quantities organized as a sequence of properly formed @@ -180,9 +207,10 @@ typedef struct ByteArray { #define BYTEARRAY_SIZE(len) \ ((unsigned) (TclOffset(ByteArray, bytes) + (len))) #define GET_BYTEARRAY(objPtr) \ - ((ByteArray *) (objPtr)->internalRep.otherValuePtr) + ((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1) #define SET_BYTEARRAY(objPtr, baPtr) \ - (objPtr)->internalRep.otherValuePtr = (void *) (baPtr) + (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (baPtr) + /* *---------------------------------------------------------------------- @@ -301,7 +329,7 @@ Tcl_SetByteArrayObj( Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj"); } TclFreeIntRep(objPtr); - Tcl_InvalidateStringRep(objPtr); + TclInvalidateStringRep(objPtr); if (length < 0) { length = 0; @@ -396,7 +424,7 @@ Tcl_SetByteArrayLength( byteArrayPtr->allocated = length; SET_BYTEARRAY(objPtr, byteArrayPtr); } - Tcl_InvalidateStringRep(objPtr); + TclInvalidateStringRep(objPtr); byteArrayPtr->used = length; return byteArrayPtr->bytes; } @@ -667,7 +695,7 @@ TclAppendBytesToByteArray( if (len > 0) { memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len); byteArrayPtr->used += len; - Tcl_InvalidateStringRep(objPtr); + TclInvalidateStringRep(objPtr); } } @@ -688,26 +716,6 @@ TclAppendBytesToByteArray( *---------------------------------------------------------------------- */ -static const EnsembleImplMap binaryMap[] = { -{ "format", BinaryFormatCmd, NULL, NULL, NULL, 0 }, -{ "scan", BinaryScanCmd, NULL, NULL, NULL, 0 }, -{ "encode", NULL, NULL, NULL, NULL, 0 }, -{ "decode", NULL, NULL, NULL, NULL, 0 }, -{ NULL, NULL, NULL, NULL, NULL, 0 } -}; -static const EnsembleImplMap encodeMap[] = { -{ "hex", BinaryEncodeHex, NULL, NULL, (ClientData)HexDigits, 0 }, -{ "uuencode", BinaryEncode64, NULL, NULL, (ClientData)UueDigits, 0 }, -{ "base64", BinaryEncode64, NULL, NULL, (ClientData)B64Digits, 0 }, -{ NULL, NULL, NULL, NULL, NULL, 0 } -}; -static const EnsembleImplMap decodeMap[] = { -{ "hex", BinaryDecodeHex, NULL, NULL, NULL, 0 }, -{ "uuencode", BinaryDecodeUu, NULL, NULL, NULL, 0 }, -{ "base64", BinaryDecode64, NULL, NULL, NULL, 0 }, -{ NULL, NULL, NULL, NULL, NULL, 0 } -}; - Tcl_Command TclInitBinaryCmd( Tcl_Interp *interp) @@ -2307,7 +2315,6 @@ BinaryEncodeHex( Tcl_Obj *resultObj = NULL; unsigned char *data = NULL; unsigned char *cursor = NULL; - const char *digits = clientData; int offset = 0, count = 0; if (objc != 2) { @@ -2319,8 +2326,8 @@ BinaryEncodeHex( data = Tcl_GetByteArrayFromObj(objv[1], &count); cursor = Tcl_SetByteArrayLength(resultObj, count * 2); for (offset = 0; offset < count; ++offset) { - *cursor++ = digits[((data[offset] >> 4) & 0x0f)]; - *cursor++ = digits[(data[offset] & 0x0f)]; + *cursor++ = HexDigits[((data[offset] >> 4) & 0x0f)]; + *cursor++ = HexDigits[(data[offset] & 0x0f)]; } Tcl_SetObjResult(interp, resultObj); return TCL_OK; @@ -2357,7 +2364,7 @@ BinaryDecodeHex( static const char *const optStrings[] = { "-strict", NULL }; if (objc < 2 || objc > 3) { - Tcl_WrongNumArgs(interp, 1, objv, "data"); + Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); return TCL_ERROR; } for (i = 1; i < objc-1; ++i) { @@ -2381,29 +2388,32 @@ BinaryDecodeHex( while (data < dataend) { value = 0; for (i=0 ; i<2 ; i++) { - if (data < dataend) { - c = *data++; - - if (!isxdigit((int) c)) { - if (strict || !isspace(c)) { - goto badChar; - } - i--; - continue; - } + if (data >= dataend) { value <<= 4; - c -= '0'; - if (c > 9) { - c += ('0' - 'A') + 10; - } - if (c > 16) { - c += ('A' - 'a'); + break; + } + + c = *data++; + if (!isxdigit((int) c)) { + if (strict || !isspace(c)) { + goto badChar; } - value |= (c & 0xf); - } else { - value <<= 4; - cut++; + i--; + continue; + } + + value <<= 4; + c -= '0'; + if (c > 9) { + c += ('0' - 'A') + 10; + } + if (c > 16) { + c += ('A' - 'a'); } + value |= (c & 0xf); + } + if (i < 2) { + cut++; } *cursor++ = UCHAR(value); value = 0; @@ -2431,7 +2441,7 @@ BinaryDecodeHex( * This implements a generic 6 bit binary encoding. Input is broken into * 6 bit chunks and a lookup table passed in via clientData is used to * turn these values into output characters. This is used to implement - * base64 and uuencode binary encodings. + * base64 binary encodings. * * Results: * Interp result set to an encoded byte array object @@ -2467,7 +2477,6 @@ BinaryEncode64( { Tcl_Obj *resultObj; unsigned char *data, *cursor, *limit; - const char *digits = clientData; int maxlen = 0; const char *wrapchar = "\n"; int wrapcharlen = 1; @@ -2490,6 +2499,13 @@ BinaryEncode64( if (Tcl_GetIntFromObj(interp, objv[i+1], &maxlen) != TCL_OK) { return TCL_ERROR; } + if (maxlen < 0) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "line length out of range", -1)); + Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE", + "LINE_LENGTH", NULL); + return TCL_ERROR; + } break; case OPT_WRAPCHAR: wrapchar = Tcl_GetStringFromObj(objv[i+1], &wrapcharlen); @@ -2520,17 +2536,17 @@ BinaryEncode64( for (i = 0; i < 3 && offset+i < count; ++i) { d[i] = data[offset + i]; } - OUTPUT(digits[d[0] >> 2]); - OUTPUT(digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]); + OUTPUT(B64Digits[d[0] >> 2]); + OUTPUT(B64Digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]); if (offset+1 < count) { - OUTPUT(digits[((d[1] & 0x0f) << 2) | (d[2] >> 6)]); + OUTPUT(B64Digits[((d[1] & 0x0f) << 2) | (d[2] >> 6)]); } else { - OUTPUT(digits[64]); + OUTPUT(B64Digits[64]); } if (offset+2 < count) { - OUTPUT(digits[d[2] & 0x3f]); + OUTPUT(B64Digits[d[2] & 0x3f]); } else { - OUTPUT(digits[64]); + OUTPUT(B64Digits[64]); } } } @@ -2542,6 +2558,125 @@ BinaryEncode64( /* *---------------------------------------------------------------------- * + * BinaryEncodeUu -- + * + * This implements the uuencode binary encoding. Input is broken into 6 + * bit chunks and a lookup table is used to turn these values into output + * characters. This differs from the generic code above in that line + * lengths are also encoded. + * + * Results: + * Interp result set to an encoded byte array object + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ + +static int +BinaryEncodeUu( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_Obj *resultObj; + unsigned char *data, *start, *cursor; + int offset, count, rawLength, n, i, j, bits, index; + int lineLength = 61; + const unsigned char SingleNewline[] = { (unsigned char) '\n' }; + const unsigned char *wrapchar = SingleNewline; + int wrapcharlen = sizeof(SingleNewline); + enum { OPT_MAXLEN, OPT_WRAPCHAR }; + static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; + + if (objc < 2 || objc%2 != 0) { + Tcl_WrongNumArgs(interp, 1, objv, + "?-maxlen len? ?-wrapchar char? data"); + return TCL_ERROR; + } + for (i = 1; i < objc-1; i += 2) { + if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", + TCL_EXACT, &index) != TCL_OK) { + return TCL_ERROR; + } + switch (index) { + case OPT_MAXLEN: + if (Tcl_GetIntFromObj(interp, objv[i+1], &lineLength) != TCL_OK) { + return TCL_ERROR; + } + if (lineLength < 3 || lineLength > 85) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "line length out of range", -1)); + Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE", + "LINE_LENGTH", NULL); + return TCL_ERROR; + } + break; + case OPT_WRAPCHAR: + wrapchar = Tcl_GetByteArrayFromObj(objv[i+1], &wrapcharlen); + break; + } + } + + /* + * Allocate the buffer. This is a little bit too long, but is "good + * enough". + */ + + resultObj = Tcl_NewObj(); + offset = 0; + data = Tcl_GetByteArrayFromObj(objv[objc-1], &count); + rawLength = (lineLength - 1) * 3 / 4; + start = cursor = Tcl_SetByteArrayLength(resultObj, + (lineLength + wrapcharlen) * + ((count + (rawLength - 1)) / rawLength)); + n = bits = 0; + + /* + * Encode the data. Each output line first has the length of raw data + * encoded by the output line described in it by one encoded byte, then + * the encoded data follows (encoding each 6 bits as one character). + * Encoded lines are always terminated by a newline. + */ + + while (offset < count) { + int lineLen = count - offset; + + if (lineLen > rawLength) { + lineLen = rawLength; + } + *cursor++ = UueDigits[lineLen]; + for (i=0 ; i<lineLen ; i++) { + n <<= 8; + n |= data[offset++]; + for (bits += 8; bits > 6 ; bits -= 6) { + *cursor++ = UueDigits[(n >> (bits-6)) & 0x3f]; + } + } + if (bits > 0) { + n <<= 8; + *cursor++ = UueDigits[(n >> (bits + 2)) & 0x3f]; + bits = 0; + } + for (j=0 ; j<wrapcharlen ; ++j) { + *cursor++ = wrapchar[j]; + } + } + + /* + * Fix the length of the output bytearray. + */ + + Tcl_SetByteArrayLength(resultObj, cursor-start); + Tcl_SetObjResult(interp, resultObj); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * BinaryDecodeUu -- * * Decode a uuencoded string. @@ -2565,13 +2700,13 @@ BinaryDecodeUu( Tcl_Obj *resultObj = NULL; unsigned char *data, *datastart, *dataend; unsigned char *begin, *cursor; - int i, index, size, count = 0, cut = 0, strict = 0; - char c; + int i, index, size, count = 0, strict = 0, lineLen; + unsigned char c; enum {OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; if (objc < 2 || objc > 3) { - Tcl_WrongNumArgs(interp, 1, objv, "data"); + Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); return TCL_ERROR; } for (i = 1; i < objc-1; ++i) { @@ -2592,44 +2727,112 @@ BinaryDecodeUu( dataend = data + count; size = ((count + 3) & ~3) * 3 / 4; begin = cursor = Tcl_SetByteArrayLength(resultObj, size); + lineLen = -1; + + /* + * The decoding loop. First, we get the length of line (strictly, the + * number of data bytes we expect to generate from the line) we're + * processing this time round if it is not already known (i.e., when the + * lineLen variable is set to the magic value, -1). + */ + while (data < dataend) { char d[4] = {0, 0, 0, 0}; + if (lineLen < 0) { + c = *data++; + if (c < 32 || c > 96) { + if (strict || !isspace(c)) { + goto badUu; + } + i--; + continue; + } + lineLen = (c - 32) & 0x3f; + } + + /* + * Now we read a four-character grouping. + */ + for (i=0 ; i<4 ; i++) { if (data < dataend) { d[i] = c = *data++; - if (c < 33 || c > 96) { - if (strict || !isspace(UCHAR(c))) { - goto badUu; + if (c < 32 || c > 96) { + if (strict) { + if (!isspace(c)) { + goto badUu; + } else if (c == '\n') { + goto shortUu; + } } i--; continue; } - } else { - cut++; } } - if (cut > 3) { - cut = 3; + + /* + * Translate that grouping into (up to) three binary bytes output. + */ + + if (lineLen > 0) { + *cursor++ = (((d[0] - 0x20) & 0x3f) << 2) + | (((d[1] - 0x20) & 0x3f) >> 4); + if (--lineLen > 0) { + *cursor++ = (((d[1] - 0x20) & 0x3f) << 4) + | (((d[2] - 0x20) & 0x3f) >> 2); + if (--lineLen > 0) { + *cursor++ = (((d[2] - 0x20) & 0x3f) << 6) + | (((d[3] - 0x20) & 0x3f)); + lineLen--; + } + } + } + + /* + * If we've reached the end of the line, skip until we process a + * newline. + */ + + if (lineLen == 0 && data < dataend) { + lineLen = -1; + do { + c = *data++; + if (c == '\n') { + break; + } else if (c >= 32 && c <= 96) { + data--; + break; + } else if (strict || !isspace(c)) { + goto badUu; + } + } while (data < dataend); } - *cursor++ = (((d[0] - 0x20) & 0x3f) << 2) - | (((d[1] - 0x20) & 0x3f) >> 4); - *cursor++ = (((d[1] - 0x20) & 0x3f) << 4) - | (((d[2] - 0x20) & 0x3f) >> 2); - *cursor++ = (((d[2] - 0x20) & 0x3f) << 6) - | (((d[3] - 0x20) & 0x3f)); } - if (cut > size) { - cut = size; + + /* + * Sanity check, clean up and finish. + */ + + if (lineLen > 0 && strict) { + goto shortUu; } - Tcl_SetByteArrayLength(resultObj, cursor - begin - cut); + Tcl_SetByteArrayLength(resultObj, cursor - begin); Tcl_SetObjResult(interp, resultObj); return TCL_OK; + shortUu: + Tcl_SetObjResult(interp, Tcl_ObjPrintf("short uuencode data")); + Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "SHORT", NULL); + TclDecrRefCount(resultObj); + return TCL_ERROR; + badUu: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid uuencode character \"%c\" at position %d", c, (int) (data - datastart - 1))); + Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL); TclDecrRefCount(resultObj); return TCL_ERROR; } @@ -2667,7 +2870,7 @@ BinaryDecode64( static const char *const optStrings[] = { "-strict", NULL }; if (objc < 2 || objc > 3) { - Tcl_WrongNumArgs(interp, 1, objv, "data"); + Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); return TCL_ERROR; } for (i = 1; i < objc-1; ++i) { diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index ab977cb..70e64f0 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -156,6 +156,10 @@ TclInitDbCkalloc(void) if (!ckallocInit) { ckallocInit = 1; ckallocMutexPtr = Tcl_GetAllocMutex(); +#ifndef TCL_THREADS + /* Silence compiler warning */ + (void)ckallocMutexPtr; +#endif } } diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 133a61b..f90819a 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -194,8 +194,7 @@ Tcl_CaseObjCmd( for (i = 0; i < caseObjc; i += 2) { int patObjc, j; const char **patObjv; - const char *pat; - unsigned char *p; + const char *pat, *p; if (i == caseObjc-1) { Tcl_ResetResult(interp); @@ -210,8 +209,8 @@ Tcl_CaseObjCmd( */ pat = TclGetString(caseObjv[i]); - for (p = (unsigned char *) pat; *p != '\0'; p++) { - if (isspace(*p) || (*p == '\\')) { /* INTL: ISO space, UCHAR */ + for (p = pat; *p != '\0'; p++) { + if (TclIsSpaceProc(*p) || (*p == '\\')) { break; } } @@ -950,40 +949,40 @@ TclInitFileCmd( */ static const EnsembleImplMap initMap[] = { - {"atime", FileAttrAccessTimeCmd, NULL, NULL, NULL, 0}, - {"attributes", TclFileAttrsCmd, NULL, NULL, NULL, 0}, - {"channels", TclChannelNamesCmd, NULL, NULL, NULL, 0}, - {"copy", TclFileCopyCmd, NULL, NULL, NULL, 0}, - {"delete", TclFileDeleteCmd, NULL, NULL, NULL, 0}, - {"dirname", PathDirNameCmd, NULL, NULL, NULL, 0}, - {"executable", FileAttrIsExecutableCmd, NULL, NULL, NULL, 0}, - {"exists", FileAttrIsExistingCmd, NULL, NULL, NULL, 0}, - {"extension", PathExtensionCmd, NULL, NULL, NULL, 0}, - {"isdirectory", FileAttrIsDirectoryCmd, NULL, NULL, NULL, 0}, - {"isfile", FileAttrIsFileCmd, NULL, NULL, NULL, 0}, - {"join", PathJoinCmd, NULL, NULL, NULL, 0}, - {"link", TclFileLinkCmd, NULL, NULL, NULL, 0}, - {"lstat", FileAttrLinkStatCmd, NULL, NULL, NULL, 0}, - {"mtime", FileAttrModifyTimeCmd, NULL, NULL, NULL, 0}, - {"mkdir", TclFileMakeDirsCmd, NULL, NULL, NULL, 0}, - {"nativename", PathNativeNameCmd, NULL, NULL, NULL, 0}, - {"normalize", PathNormalizeCmd, NULL, NULL, NULL, 0}, - {"owned", FileAttrIsOwnedCmd, NULL, NULL, NULL, 0}, - {"pathtype", PathTypeCmd, NULL, NULL, NULL, 0}, - {"readable", FileAttrIsReadableCmd, NULL, NULL, NULL, 0}, - {"readlink", TclFileReadLinkCmd, NULL, NULL, NULL, 0}, - {"rename", TclFileRenameCmd, NULL, NULL, NULL, 0}, - {"rootname", PathRootNameCmd, NULL, NULL, NULL, 0}, - {"separator", FilesystemSeparatorCmd, NULL, NULL, NULL, 0}, - {"size", FileAttrSizeCmd, NULL, NULL, NULL, 0}, - {"split", PathSplitCmd, NULL, NULL, NULL, 0}, - {"stat", FileAttrStatCmd, NULL, NULL, NULL, 0}, - {"system", PathFilesystemCmd, NULL, NULL, NULL, 0}, - {"tail", PathTailCmd, NULL, NULL, NULL, 0}, - {"tempfile", TclFileTemporaryCmd, NULL, NULL, NULL, 0}, - {"type", FileAttrTypeCmd, NULL, NULL, NULL, 0}, - {"volumes", FilesystemVolumesCmd, NULL, NULL, NULL, 0}, - {"writable", FileAttrIsWritableCmd, NULL, NULL, NULL, 0}, + {"atime", FileAttrAccessTimeCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, + {"attributes", TclFileAttrsCmd, NULL, NULL, NULL, 0}, + {"channels", TclChannelNamesCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"copy", TclFileCopyCmd, NULL, NULL, NULL, 0}, + {"delete", TclFileDeleteCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, + {"dirname", PathDirNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"executable", FileAttrIsExecutableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"exists", FileAttrIsExistingCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"extension", PathExtensionCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"isdirectory", FileAttrIsDirectoryCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"isfile", FileAttrIsFileCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"join", PathJoinCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, + {"link", TclFileLinkCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0}, + {"lstat", FileAttrLinkStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, + {"mtime", FileAttrModifyTimeCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, + {"mkdir", TclFileMakeDirsCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, + {"nativename", PathNativeNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"normalize", PathNormalizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"owned", FileAttrIsOwnedCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"pathtype", PathTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"readable", FileAttrIsReadableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"readlink", TclFileReadLinkCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"rename", TclFileRenameCmd, NULL, NULL, NULL, 0}, + {"rootname", PathRootNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"separator", FilesystemSeparatorCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"size", FileAttrSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"split", PathSplitCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"stat", FileAttrStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, + {"system", PathFilesystemCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"tail", PathTailCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"tempfile", TclFileTemporaryCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 0}, + {"type", FileAttrTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"volumes", FilesystemVolumesCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, + {"writable", FileAttrIsWritableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; return TclMakeEnsemble(interp, "file", initMap); diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 155e8e4..41c1eb6 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -161,30 +161,30 @@ static Tcl_Obj * SelectObjFromSublist(Tcl_Obj *firstPtr, */ static const EnsembleImplMap defaultInfoMap[] = { - {"args", InfoArgsCmd, NULL, NULL, NULL, 0}, - {"body", InfoBodyCmd, NULL, NULL, NULL, 0}, - {"cmdcount", InfoCmdCountCmd, NULL, NULL, NULL, 0}, + {"args", InfoArgsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"body", InfoBodyCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"cmdcount", InfoCmdCountCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"commands", InfoCommandsCmd, TclCompileInfoCommandsCmd, NULL, NULL, 0}, - {"complete", InfoCompleteCmd, NULL, NULL, NULL, 0}, + {"complete", InfoCompleteCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"coroutine", TclInfoCoroutineCmd, TclCompileInfoCoroutineCmd, NULL, NULL, 0}, - {"default", InfoDefaultCmd, NULL, NULL, NULL, 0}, - {"errorstack", InfoErrorStackCmd, NULL, NULL, NULL, 0}, + {"default", InfoDefaultCmd, TclCompileBasic3ArgCmd, NULL, NULL, 0}, + {"errorstack", InfoErrorStackCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"exists", TclInfoExistsCmd, TclCompileInfoExistsCmd, NULL, NULL, 0}, - {"frame", InfoFrameCmd, NULL, NULL, NULL, 0}, - {"functions", InfoFunctionsCmd, NULL, NULL, NULL, 0}, - {"globals", TclInfoGlobalsCmd, NULL, NULL, NULL, 0}, - {"hostname", InfoHostnameCmd, NULL, NULL, NULL, 0}, + {"frame", InfoFrameCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"functions", InfoFunctionsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"globals", TclInfoGlobalsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"hostname", InfoHostnameCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"level", InfoLevelCmd, TclCompileInfoLevelCmd, NULL, NULL, 0}, - {"library", InfoLibraryCmd, NULL, NULL, NULL, 0}, - {"loaded", InfoLoadedCmd, NULL, NULL, NULL, 0}, - {"locals", TclInfoLocalsCmd, NULL, NULL, NULL, 0}, - {"nameofexecutable", InfoNameOfExecutableCmd, NULL, NULL, NULL, 0}, - {"patchlevel", InfoPatchLevelCmd, NULL, NULL, NULL, 0}, - {"procs", InfoProcsCmd, NULL, NULL, NULL, 0}, - {"script", InfoScriptCmd, NULL, NULL, NULL, 0}, - {"sharedlibextension", InfoSharedlibCmd, NULL, NULL, NULL, 0}, - {"tclversion", InfoTclVersionCmd, NULL, NULL, NULL, 0}, - {"vars", TclInfoVarsCmd, NULL, NULL, NULL, 0}, + {"library", InfoLibraryCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, + {"loaded", InfoLoadedCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"locals", TclInfoLocalsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"nameofexecutable", InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, + {"patchlevel", InfoPatchLevelCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, + {"procs", InfoProcsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"script", InfoScriptCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"sharedlibextension", InfoSharedlibCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, + {"tclversion", InfoTclVersionCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, + {"vars", TclInfoVarsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; @@ -1147,41 +1147,38 @@ InfoFrameCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; - int level, topLevel, code = TCL_OK; - CmdFrame *runPtr, *framePtr; + int level, code = TCL_OK; + CmdFrame *framePtr, **cmdFramePtrPtr = &iPtr->cmdFramePtr; CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; + int topLevel = 0; if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?number?"); return TCL_ERROR; } - topLevel = ((iPtr->cmdFramePtr == NULL) - ? 0 - : iPtr->cmdFramePtr->level); - - if (corPtr) { - /* - * A coroutine: must fix the level computations AND the cmdFrame chain, - * which is interrupted at the base. - */ - - CmdFrame *lastPtr = NULL; - - runPtr = iPtr->cmdFramePtr; + while (corPtr) { + while (*cmdFramePtrPtr) { + topLevel++; + cmdFramePtrPtr = &((*cmdFramePtrPtr)->nextPtr); + } + if (corPtr->caller.cmdFramePtr) { + *cmdFramePtrPtr = corPtr->caller.cmdFramePtr; + } + corPtr = corPtr->callerEEPtr->corPtr; + } + topLevel += (*cmdFramePtrPtr)->level; - /* TODO - deal with overflow */ - topLevel += corPtr->caller.cmdFramePtr->level; - while (runPtr) { - runPtr->level += corPtr->caller.cmdFramePtr->level; - lastPtr = runPtr; - runPtr = runPtr->nextPtr; + if (topLevel != iPtr->cmdFramePtr->level) { + framePtr = iPtr->cmdFramePtr; + while (framePtr) { + framePtr->level = topLevel--; + framePtr = framePtr->nextPtr; } - if (lastPtr) { - lastPtr->nextPtr = corPtr->caller.cmdFramePtr; - } else { - iPtr->cmdFramePtr = corPtr->caller.cmdFramePtr; + if (topLevel) { + Tcl_Panic("Broken frame level calculation"); } + topLevel = iPtr->cmdFramePtr->level; } if (objc == 1) { @@ -1231,20 +1228,27 @@ InfoFrameCmd( Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr)); done: - if (corPtr) { + cmdFramePtrPtr = &iPtr->cmdFramePtr; + corPtr = iPtr->execEnvPtr->corPtr; + while (corPtr) { + CmdFrame *endPtr = corPtr->caller.cmdFramePtr; + + if (endPtr) { + if (*cmdFramePtrPtr == endPtr) { + *cmdFramePtrPtr = NULL; + } else { + CmdFrame *runPtr = *cmdFramePtrPtr; - if (iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr) { - iPtr->cmdFramePtr = NULL; - } else { - runPtr = iPtr->cmdFramePtr; - while (runPtr->nextPtr != corPtr->caller.cmdFramePtr) { - runPtr->level -= corPtr->caller.cmdFramePtr->level; - runPtr = runPtr->nextPtr; + while (runPtr->nextPtr != endPtr) { + runPtr->level -= endPtr->level; + runPtr = runPtr->nextPtr; + } + runPtr->level = 1; + runPtr->nextPtr = NULL; } - runPtr->level = 1; - runPtr->nextPtr = NULL; + cmdFramePtrPtr = &corPtr->caller.cmdFramePtr; } - + corPtr = corPtr->callerEEPtr->corPtr; } return code; } @@ -1302,28 +1306,12 @@ TclInfoFrame( */ ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1)); - ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0])); - ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd.str.cmd, - framePtr->cmd.str.len)); - break; - - case TCL_LOCATION_EVAL_LIST: - /* - * List optimized evaluation. Type, line, cmd, the latter through - * listPtr, possibly a frame. - */ - - ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1)); - ADD_PAIR("line", Tcl_NewIntObj(1)); - - /* - * We put a duplicate of the command list obj into the result to - * ensure that the 'pure List'-property of the command itself is not - * destroyed. Otherwise the query here would disable the list - * optimization path in Tcl_EvalObjEx. - */ - - ADD_PAIR("cmd", Tcl_DuplicateObj(framePtr->cmd.listPtr)); + if (framePtr->line) { + ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0])); + } else { + ADD_PAIR("line", Tcl_NewIntObj(1)); + } + ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL)); break; case TCL_LOCATION_PREBC: @@ -1371,8 +1359,7 @@ TclInfoFrame( Tcl_DecrRefCount(fPtr->data.eval.path); } - ADD_PAIR("cmd", - Tcl_NewStringObj(fPtr->cmd.str.cmd, fPtr->cmd.str.len)); + ADD_PAIR("cmd", TclGetSourceFromFrame(fPtr, 0, NULL)); TclStackFree(interp, fPtr); break; } @@ -1391,8 +1378,7 @@ TclInfoFrame( * the result list object. */ - ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd.str.cmd, - framePtr->cmd.str.len)); + ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL)); break; case TCL_LOCATION_PROC: @@ -3005,7 +2991,7 @@ Tcl_LsearchObjCmd( dataType = INTEGER; break; case LSEARCH_NOCASE: /* -nocase */ - strCmpFn = strcasecmp; + strCmpFn = TclUtfCasecmp; noCase = 1; break; case LSEARCH_NOT: /* -not */ @@ -3400,7 +3386,7 @@ Tcl_LsearchObjCmd( */ if (noCase) { - match = (strcasecmp(bytes, patternBytes) == 0); + match = (TclUtfCasecmp(bytes, patternBytes) == 0); } else { match = (memcmp(bytes, patternBytes, (size_t) length) == 0); @@ -3645,7 +3631,8 @@ Tcl_LsortObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { - int i, j, index, indices, length, nocase = 0, sortMode, indexc; + int i, j, index, indices, length, nocase = 0, indexc; + int sortMode = SORTMODE_ASCII; int group, groupSize, groupOffset, idx, allocatedIndexVector = 0; Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr; SortElement *elementArray, *elementPtr; @@ -3991,7 +3978,7 @@ Tcl_LsortObjCmd( goto done1; } elementArray[i].collationKey.intValue = a; - } else if (sortInfo.sortMode == SORTMODE_REAL) { + } else if (sortMode == SORTMODE_REAL) { double a; if (Tcl_GetDoubleFromObj(sortInfo.interp, indexPtr, @@ -4088,7 +4075,7 @@ Tcl_LsortObjCmd( TclStackFree(interp, elementArray); done: - if (sortInfo.sortMode == SORTMODE_COMMAND) { + if (sortMode == SORTMODE_COMMAND) { TclDecrRefCount(sortInfo.compareCmdPtr); TclDecrRefCount(listObj); sortInfo.compareCmdPtr = NULL; @@ -4233,7 +4220,7 @@ SortCompare( order = strcmp(elemPtr1->collationKey.strValuePtr, elemPtr2->collationKey.strValuePtr); } else if (infoPtr->sortMode == SORTMODE_ASCII_NC) { - order = strcasecmp(elemPtr1->collationKey.strValuePtr, + order = TclUtfCasecmp(elemPtr1->collationKey.strValuePtr, elemPtr2->collationKey.strValuePtr); } else if (infoPtr->sortMode == SORTMODE_DICTIONARY) { order = DictionaryCompare(elemPtr1->collationKey.strValuePtr, diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index fc957c4..cefe850 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -35,6 +35,8 @@ static int UniCharIsHexDigit(int character); /* * Default set of characters to trim in [string trim] and friends. This is a * UTF-8 literal string containing all Unicode space characters [TIP #413] + * + * Synch with tclCompCmdsSZ.c */ #define DEFAULT_TRIM_SET \ @@ -1540,7 +1542,8 @@ StringIsCmd( case STR_IS_BOOL: case STR_IS_TRUE: case STR_IS_FALSE: - if (TCL_OK != Tcl_ConvertToType(NULL, objPtr, &tclBooleanType)) { + if ((objPtr->typePtr != &tclBooleanType) + && (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) { if (strict) { result = 0; } else { @@ -1564,7 +1567,7 @@ StringIsCmd( /* TODO */ if ((objPtr->typePtr == &tclDoubleType) || (objPtr->typePtr == &tclIntType) || -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG (objPtr->typePtr == &tclWideIntType) || #endif (objPtr->typePtr == &tclBignumType)) { @@ -1601,7 +1604,7 @@ StringIsCmd( goto failedIntParse; case STR_IS_ENTIER: if ((objPtr->typePtr == &tclIntType) || -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG (objPtr->typePtr == &tclWideIntType) || #endif (objPtr->typePtr == &tclBignumType)) { @@ -3324,7 +3327,7 @@ TclInitStringCmd( Tcl_Interp *interp) /* Current interpreter. */ { static const EnsembleImplMap stringImplMap[] = { - {"bytelength", StringBytesCmd, NULL, NULL, NULL, 0}, + {"bytelength", StringBytesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0}, {"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0}, {"first", StringFirstCmd, TclCompileStringFirstCmd, NULL, NULL, 0}, @@ -3335,17 +3338,17 @@ TclInitStringCmd( {"map", StringMapCmd, TclCompileStringMapCmd, NULL, NULL, 0}, {"match", StringMatchCmd, TclCompileStringMatchCmd, NULL, NULL, 0}, {"range", StringRangeCmd, TclCompileStringRangeCmd, NULL, NULL, 0}, - {"repeat", StringReptCmd, NULL, NULL, NULL, 0}, - {"replace", StringRplcCmd, NULL, NULL, NULL, 0}, - {"reverse", StringRevCmd, NULL, NULL, NULL, 0}, - {"tolower", StringLowerCmd, NULL, NULL, NULL, 0}, - {"toupper", StringUpperCmd, NULL, NULL, NULL, 0}, - {"totitle", StringTitleCmd, NULL, NULL, NULL, 0}, - {"trim", StringTrimCmd, NULL, NULL, NULL, 0}, - {"trimleft", StringTrimLCmd, NULL, NULL, NULL, 0}, - {"trimright", StringTrimRCmd, NULL, NULL, NULL, 0}, - {"wordend", StringEndCmd, NULL, NULL, NULL, 0}, - {"wordstart", StringStartCmd, NULL, NULL, NULL, 0}, + {"repeat", StringReptCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, + {"replace", StringRplcCmd, TclCompileStringReplaceCmd, NULL, NULL, 0}, + {"reverse", StringRevCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"tolower", StringLowerCmd, TclCompileStringToLowerCmd, NULL, NULL, 0}, + {"toupper", StringUpperCmd, TclCompileStringToUpperCmd, NULL, NULL, 0}, + {"totitle", StringTitleCmd, TclCompileStringToTitleCmd, NULL, NULL, 0}, + {"trim", StringTrimCmd, TclCompileStringTrimCmd, NULL, NULL, 0}, + {"trimleft", StringTrimLCmd, TclCompileStringTrimLCmd, NULL, NULL, 0}, + {"trimright", StringTrimRCmd, TclCompileStringTrimRCmd, NULL, NULL, 0}, + {"wordend", StringEndCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, + {"wordstart", StringStartCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; @@ -3526,7 +3529,7 @@ TclNRSwitchObjCmd( i++; goto finishedOptions; case OPT_NOCASE: - strCmpFn = strcasecmp; + strCmpFn = TclUtfCasecmp; noCase = 1; break; diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 67f92b0..51ac9ed 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -7,7 +7,7 @@ * Copyright (c) 1997-1998 Sun Microsystems, Inc. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * Copyright (c) 2002 ActiveState Corporation. - * Copyright (c) 2004-2006 by Donal K. Fellows. + * Copyright (c) 2004-2013 by Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -31,16 +31,9 @@ static void FreeForeachInfo(ClientData clientData); static void PrintForeachInfo(ClientData clientData, Tcl_Obj *appendObj, ByteCode *codePtr, unsigned int pcOffset); -static void CompileReturnInternal(CompileEnv *envPtr, - unsigned char op, int code, int level, - Tcl_Obj *returnOpts); -static int IndexTailVarIfKnown(Tcl_Interp *interp, - Tcl_Token *varTokenPtr, CompileEnv *envPtr); -static int PushVarName(Tcl_Interp *interp, - Tcl_Token *varTokenPtr, CompileEnv *envPtr, - int flags, int *localIndexPtr, - int *simpleVarNamePtr, int *isScalarPtr, - int line, int *clNext); +static void PrintNewForeachInfo(ClientData clientData, + Tcl_Obj *appendObj, ByteCode *codePtr, + unsigned int pcOffset); static int CompileEachloopCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, CompileEnv *envPtr, int collect); @@ -48,66 +41,6 @@ static int CompileDictEachCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr, int collect); - -/* - * Macro that encapsulates an efficiency trick that avoids a function call for - * the simplest of compiles. The ANSI C "prototype" for this macro is: - * - * static void CompileWord(CompileEnv *envPtr, Tcl_Token *tokenPtr, - * Tcl_Interp *interp, int word); - */ - -#define CompileWord(envPtr, tokenPtr, interp, word) \ - if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) { \ - TclEmitPush(TclRegisterNewLiteral((envPtr), (tokenPtr)[1].start, \ - (tokenPtr)[1].size), (envPtr)); \ - } else { \ - envPtr->line = mapPtr->loc[eclIndex].line[word]; \ - envPtr->clNext = mapPtr->loc[eclIndex].next[word]; \ - TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \ - (envPtr)); \ - } - -/* - * TIP #280: Remember the per-word line information of the current command. An - * index is used instead of a pointer as recursive compilation may reallocate, - * i.e. move, the array. This is also the reason to save the nuloc now, it may - * change during the course of the function. - * - * Macro to encapsulate the variable definition and setup. - */ - -#define DefineLineInformation \ - ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \ - int eclIndex = mapPtr->nuloc - 1 - -#define SetLineInformation(word) \ - envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \ - envPtr->clNext = mapPtr->loc[eclIndex].next[(word)] - -#define PushVarNameWord(i,v,e,f,l,s,sc,word) \ - PushVarName(i,v,e,f,l,s,sc, \ - mapPtr->loc[eclIndex].line[(word)], \ - mapPtr->loc[eclIndex].next[(word)]) - -/* - * Often want to issue one of two versions of an instruction based on whether - * the argument will fit in a single byte or not. This makes it much clearer. - */ - -#define Emit14Inst(nm,idx,envPtr) \ - if (idx <= 255) { \ - TclEmitInstInt1(nm##1,idx,envPtr); \ - } else { \ - TclEmitInstInt4(nm##4,idx,envPtr); \ - } - -/* - * Flags bits used by PushVarName. - */ - -#define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */ - /* * The structures below define the AuxData types defined in this file. */ @@ -119,12 +52,26 @@ const AuxDataType tclForeachInfoType = { PrintForeachInfo /* printProc */ }; +const AuxDataType tclNewForeachInfoType = { + "NewForeachInfo", /* name */ + DupForeachInfo, /* dupProc */ + FreeForeachInfo, /* freeProc */ + PrintNewForeachInfo /* printProc */ +}; + const AuxDataType tclDictUpdateInfoType = { "DictUpdateInfo", /* name */ DupDictUpdateInfo, /* dupProc */ FreeDictUpdateInfo, /* freeProc */ PrintDictUpdateInfo /* printProc */ }; + +/* + * The definition of what whitespace is stripped when [concat]enating. Must be + * kept in synch with tclUtil.c + */ + +#define CONCAT_WS " \f\v\r\t\n" /* *---------------------------------------------------------------------- @@ -154,9 +101,10 @@ TclCompileAppendCmd( CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr, *valueTokenPtr; - int simpleVarName, isScalar, localIndex, numWords; + int isScalar, localIndex, numWords, i; DefineLineInformation; /* TIP #280 */ + /* TODO: Consider support for compiling expanded args. */ numWords = parsePtr->numWords; if (numWords == 1) { return TCL_ERROR; @@ -168,10 +116,11 @@ TclCompileAppendCmd( return TclCompileSetCmd(interp, parsePtr, cmdPtr, envPtr); } else if (numWords > 3) { /* - * APPEND instructions currently only handle one value. + * APPEND instructions currently only handle one value, but we can + * handle some multi-value cases by stringing them together. */ - return TCL_ERROR; + goto appendMultiple; } /* @@ -185,7 +134,7 @@ TclCompileAppendCmd( varTokenPtr = TokenAfter(parsePtr->tokenPtr); PushVarNameWord(interp, varTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + &localIndex, &isScalar, 1); /* * We are doing an assignment, otherwise TclCompileSetCmd was called, so @@ -193,16 +142,13 @@ TclCompileAppendCmd( * each argument. */ - if (numWords > 2) { valueTokenPtr = TokenAfter(varTokenPtr); CompileWord(envPtr, valueTokenPtr, interp, 2); - } /* * Emit instructions to set/get the variable. */ - if (simpleVarName) { if (isScalar) { if (localIndex < 0) { TclEmitOpcode(INST_APPEND_STK, envPtr); @@ -216,8 +162,38 @@ TclCompileAppendCmd( Emit14Inst(INST_APPEND_ARRAY, localIndex, envPtr); } } - } else { - TclEmitOpcode(INST_APPEND_STK, envPtr); + + return TCL_OK; + + appendMultiple: + /* + * Can only handle the case where we are appending to a local scalar when + * there are multiple values to append. Fortunately, this is common. + */ + + varTokenPtr = TokenAfter(parsePtr->tokenPtr); + PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT, + &localIndex, &isScalar, 1); + if (!isScalar || localIndex < 0) { + return TCL_ERROR; + } + + /* + * Definitely appending to a local scalar; generate the words and append + * them. + */ + + valueTokenPtr = TokenAfter(varTokenPtr); + for (i = 2 ; i < numWords ; i++) { + CompileWord(envPtr, valueTokenPtr, interp, i); + valueTokenPtr = TokenAfter(valueTokenPtr); + } + TclEmitInstInt4( INST_REVERSE, numWords-2, envPtr); + for (i = 2 ; i < numWords ;) { + Emit14Inst( INST_APPEND_SCALAR, localIndex, envPtr); + if (++i < numWords) { + TclEmitOpcode(INST_POP, envPtr); + } } return TCL_OK; @@ -252,15 +228,15 @@ TclCompileArrayExistsCmd( { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; - int simpleVarName, isScalar, localIndex; + int isScalar, localIndex; if (parsePtr->numWords != 2) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(interp, tokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + PushVarNameWord(interp, tokenPtr, envPtr, TCL_NO_ELEMENT, + &localIndex, &isScalar, 1); if (!isScalar) { return TCL_ERROR; } @@ -283,30 +259,61 @@ TclCompileArraySetCmd( CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ - Tcl_Token *tokenPtr; - int simpleVarName, isScalar, localIndex; - int dataVar, iterVar, keyVar, valVar, infoIndex; - int back, fwd, offsetBack, offsetFwd, savedStackDepth; + Tcl_Token *varTokenPtr, *dataTokenPtr; + int isScalar, localIndex, code = TCL_OK; + int isDataLiteral, isDataValid, isDataEven, len; + int keyVar, valVar, infoIndex; + int fwd, offsetBack, offsetFwd; + Tcl_Obj *literalObj; ForeachInfo *infoPtr; if (parsePtr->numWords != 3) { return TCL_ERROR; } - tokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(interp, tokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + varTokenPtr = TokenAfter(parsePtr->tokenPtr); + dataTokenPtr = TokenAfter(varTokenPtr); + literalObj = Tcl_NewObj(); + isDataLiteral = TclWordKnownAtCompileTime(dataTokenPtr, literalObj); + isDataValid = (isDataLiteral + && Tcl_ListObjLength(NULL, literalObj, &len) == TCL_OK); + isDataEven = (isDataValid && (len & 1) == 0); + + /* + * Special case: literal odd-length argument is always an error. + */ + + if (isDataValid && !isDataEven) { + PushStringLiteral(envPtr, "list must have an even number of elements"); + PushStringLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}"); + TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR, envPtr); + TclEmitInt4( 0, envPtr); + goto done; + } + + /* + * Except for the special "ensure array" case below, when we're not in + * a proc, we cannot do a better compile than generic. + */ + + if (envPtr->procPtr == NULL && !(isDataEven && len == 0)) { + code = TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr); + goto done; + } + + PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT, + &localIndex, &isScalar, 1); if (!isScalar) { - return TCL_ERROR; + code = TCL_ERROR; + goto done; } - tokenPtr = TokenAfter(tokenPtr); /* * Special case: literal empty value argument is just an "ensure array" * operation. */ - if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD && tokenPtr[1].size == 0) { + if (isDataEven && len == 0) { if (localIndex >= 0) { TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr); TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr); @@ -315,33 +322,39 @@ TclCompileArraySetCmd( TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr); TclEmitInstInt1(INST_JUMP_TRUE1, 5, envPtr); - savedStackDepth = envPtr->currStackDepth; TclEmitOpcode( INST_ARRAY_MAKE_STK, envPtr); TclEmitInstInt1(INST_JUMP1, 3, envPtr); - envPtr->currStackDepth = savedStackDepth; + /* Each branch decrements stack depth, but we only take one. */ + TclAdjustStackDepth(1, envPtr); TclEmitOpcode( INST_POP, envPtr); } - PushLiteral(envPtr, "", 0); - return TCL_OK; + PushStringLiteral(envPtr, ""); + goto done; } + if (localIndex < 0) { + /* + * a non-local variable: upvar from a local one! This consumes the + * variable name that was left at stacktop. + */ + + localIndex = AnonymousLocal(envPtr); + PushStringLiteral(envPtr, "0"); + TclEmitInstInt4(INST_REVERSE, 2, envPtr); + TclEmitInstInt4(INST_UPVAR, localIndex, envPtr); + TclEmitOpcode(INST_POP, envPtr); + } + /* * Prepare for the internal foreach. */ - if (envPtr->procPtr == NULL) { - return TCL_ERROR; - } - dataVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); - iterVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); - keyVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); - valVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); + keyVar = AnonymousLocal(envPtr); + valVar = AnonymousLocal(envPtr); - infoPtr = ckalloc(sizeof(ForeachInfo) + sizeof(ForeachVarList *)); + infoPtr = ckalloc(sizeof(ForeachInfo)); infoPtr->numLists = 1; - infoPtr->firstValueTemp = dataVar; - infoPtr->loopCtTemp = iterVar; - infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) * 2*sizeof(int)); + infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) + sizeof(int)); infoPtr->varLists[0]->numVars = 2; infoPtr->varLists[0]->varIndexes[0] = keyVar; infoPtr->varLists[0]->varIndexes[1] = valVar; @@ -351,73 +364,48 @@ TclCompileArraySetCmd( * Start issuing instructions to write to the array. */ - CompileWord(envPtr, tokenPtr, interp, 2); - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_LIST_LENGTH, envPtr); - PushLiteral(envPtr, "1", 1); - TclEmitOpcode( INST_BITAND, envPtr); - offsetFwd = CurrentOffset(envPtr); - TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr); - savedStackDepth = envPtr->currStackDepth; - PushLiteral(envPtr, "list must have an even number of elements", - strlen("list must have an even number of elements")); - PushLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}", - strlen("-errorCode {TCL ARGUMENT FORMAT}")); - TclEmitInstInt4( INST_RETURN_IMM, 1, envPtr); - TclEmitInt4( 0, envPtr); - envPtr->currStackDepth = savedStackDepth; - fwd = CurrentOffset(envPtr) - offsetFwd; - TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1); - Emit14Inst( INST_STORE_SCALAR, dataVar, envPtr); - TclEmitOpcode( INST_POP, envPtr); + CompileWord(envPtr, dataTokenPtr, interp, 2); + if (!isDataLiteral || !isDataValid) { + /* + * Only need this safety check if we're handling a non-literal or list + * containing an invalid literal; with valid list literals, we've + * already checked (worth it because literals are a very common + * use-case with [array set]). + */ - if (localIndex >= 0) { - TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr); - TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr); - TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr); - TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr); - offsetBack = CurrentOffset(envPtr); - TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr); - offsetFwd = CurrentOffset(envPtr); - TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr); - savedStackDepth = envPtr->currStackDepth; - Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr); - Emit14Inst( INST_LOAD_SCALAR, valVar, envPtr); - Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); - back = offsetBack - CurrentOffset(envPtr); - TclEmitInstInt1(INST_JUMP1, back, envPtr); - fwd = CurrentOffset(envPtr) - offsetFwd; - TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1); - envPtr->currStackDepth = savedStackDepth; - } else { TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr); - TclEmitInstInt1(INST_JUMP_TRUE1, 4, envPtr); - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_ARRAY_MAKE_STK, envPtr); - TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr); - offsetBack = CurrentOffset(envPtr); - TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr); + TclEmitOpcode( INST_LIST_LENGTH, envPtr); + PushStringLiteral(envPtr, "1"); + TclEmitOpcode( INST_BITAND, envPtr); offsetFwd = CurrentOffset(envPtr); TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr); - savedStackDepth = envPtr->currStackDepth; - TclEmitOpcode( INST_DUP, envPtr); - Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr); - Emit14Inst( INST_LOAD_SCALAR, valVar, envPtr); - TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr); - TclEmitOpcode( INST_POP, envPtr); - back = offsetBack - CurrentOffset(envPtr); - TclEmitInstInt1(INST_JUMP1, back, envPtr); + PushStringLiteral(envPtr, "list must have an even number of elements"); + PushStringLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}"); + TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR, envPtr); + TclEmitInt4( 0, envPtr); + TclAdjustStackDepth(-1, envPtr); fwd = CurrentOffset(envPtr) - offsetFwd; TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1); - envPtr->currStackDepth = savedStackDepth; - TclEmitOpcode( INST_POP, envPtr); } - TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( dataVar, envPtr); - PushLiteral(envPtr, "", 0); - return TCL_OK; + + TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr); + TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr); + TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr); + TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr); + offsetBack = CurrentOffset(envPtr); + Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr); + Emit14Inst( INST_LOAD_SCALAR, valVar, envPtr); + Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr); + TclEmitOpcode( INST_POP, envPtr); + infoPtr->loopCtTemp = offsetBack - CurrentOffset(envPtr); /*misuse */ + TclEmitOpcode( INST_FOREACH_STEP, envPtr); + TclEmitOpcode( INST_FOREACH_END, envPtr); + TclAdjustStackDepth(-3, envPtr); + PushStringLiteral(envPtr, ""); + + done: + Tcl_DecrRefCount(literalObj); + return code; } int @@ -431,14 +419,14 @@ TclCompileArrayUnsetCmd( { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); - int simpleVarName, isScalar, localIndex, savedStackDepth; + int isScalar, localIndex; if (parsePtr->numWords != 2) { - return TCL_ERROR; + return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } - PushVarNameWord(interp, tokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + PushVarNameWord(interp, tokenPtr, envPtr, TCL_NO_ELEMENT, + &localIndex, &isScalar, 1); if (!isScalar) { return TCL_ERROR; } @@ -452,13 +440,13 @@ TclCompileArrayUnsetCmd( TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr); TclEmitInstInt1(INST_JUMP_FALSE1, 6, envPtr); - savedStackDepth = envPtr->currStackDepth; TclEmitInstInt1(INST_UNSET_STK, 1, envPtr); TclEmitInstInt1(INST_JUMP1, 3, envPtr); - envPtr->currStackDepth = savedStackDepth; + /* Each branch decrements stack depth, but we only take one. */ + TclAdjustStackDepth(1, envPtr); TclEmitOpcode( INST_POP, envPtr); } - PushLiteral(envPtr, "", 0); + PushStringLiteral(envPtr, ""); return TCL_OK; } @@ -489,16 +477,34 @@ TclCompileBreakCmd( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { + ExceptionRange *rangePtr; + ExceptionAux *auxPtr; + if (parsePtr->numWords != 1) { return TCL_ERROR; } /* - * Emit a break instruction. + * Find the innermost exception range that contains this command. */ - TclEmitOpcode(INST_BREAK, envPtr); - PushLiteral(envPtr, "", 0); /* Evil hack! */ + rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxPtr); + if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) { + /* + * Found the target! No need for a nasty INST_BREAK here. + */ + + TclCleanupStackForBreakContinue(envPtr, auxPtr); + TclAddLoopBreakFixup(envPtr, auxPtr); + } else { + /* + * Emit a real break. + */ + + TclEmitOpcode(INST_BREAK, envPtr); + } + TclAdjustStackDepth(1, envPtr); + return TCL_OK; } @@ -531,12 +537,10 @@ TclCompileCatchCmd( { JumpFixup jumpFixup; Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr; - const char *name; - int resultIndex, optsIndex, nameChars, range; - int initStackDepth = envPtr->currStackDepth; - int savedStackDepth; + int resultIndex, optsIndex, range, dropScript = 0; DefineLineInformation; /* TIP #280 */ - + int depth = TclGetStackDepth(envPtr); + /* * If syntax does not match what we expect for [catch], do not compile. * Let runtime checks determine if syntax has changed. @@ -565,17 +569,7 @@ TclCompileCatchCmd( if (parsePtr->numWords >= 3) { resultNameTokenPtr = TokenAfter(cmdTokenPtr); /* DGP */ - if (resultNameTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - - name = resultNameTokenPtr[1].start; - nameChars = resultNameTokenPtr[1].size; - if (!TclIsLocalScalar(name, nameChars)) { - return TCL_ERROR; - } - resultIndex = TclFindCompiledLocal(resultNameTokenPtr[1].start, - resultNameTokenPtr[1].size, /*create*/ 1, envPtr); + resultIndex = LocalScalarFromToken(resultNameTokenPtr, envPtr); if (resultIndex < 0) { return TCL_ERROR; } @@ -583,16 +577,7 @@ TclCompileCatchCmd( /* DKF */ if (parsePtr->numWords == 4) { optsNameTokenPtr = TokenAfter(resultNameTokenPtr); - if (optsNameTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - name = optsNameTokenPtr[1].start; - nameChars = optsNameTokenPtr[1].size; - if (!TclIsLocalScalar(name, nameChars)) { - return TCL_ERROR; - } - optsIndex = TclFindCompiledLocal(optsNameTokenPtr[1].start, - optsNameTokenPtr[1].size, /*create*/ 1, envPtr); + optsIndex = LocalScalarFromToken(optsNameTokenPtr, envPtr); if (optsIndex < 0) { return TCL_ERROR; } @@ -602,11 +587,7 @@ TclCompileCatchCmd( /* * We will compile the catch command. Declare the exception range that it * uses. - */ - - range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); - - /* + * * If the body is a simple word, compile a BEGIN_CATCH instruction, * followed by the instructions to eval the body. * Otherwise, compile instructions to substitute the body text before @@ -619,83 +600,62 @@ TclCompileCatchCmd( * begin by undeflowing the stack below the mark set by BEGIN_CATCH4. */ - SetLineInformation(1); + range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - savedStackDepth = envPtr->currStackDepth; TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr); ExceptionRangeStarts(envPtr, range); - CompileBody(envPtr, cmdTokenPtr, interp); + BODY(cmdTokenPtr, 1); } else { + SetLineInformation(1); CompileTokens(envPtr, cmdTokenPtr, interp); - savedStackDepth = envPtr->currStackDepth; TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr); ExceptionRangeStarts(envPtr, range); TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_EVAL_STK, envPtr); - } - /* Stack at this point: - * nonsimple: script <mark> result - * simple: <mark> result - */ - - if (resultIndex == -1) { - /* - * Special case when neither result nor options are being saved. In - * that case, we can skip quite a bit of the command epilogue; all we - * have to do is drop the result and push the return code (and, of - * course, finish the catch context). - */ - + TclEmitInvoke(envPtr, INST_EVAL_STK); + /* drop the script */ + dropScript = 1; + TclEmitInstInt4( INST_REVERSE, 2, envPtr); TclEmitOpcode( INST_POP, envPtr); - PushLiteral(envPtr, "0", 1); - TclEmitInstInt1( INST_JUMP1, 3, envPtr); - envPtr->currStackDepth = savedStackDepth; - ExceptionRangeTarget(envPtr, range, catchOffset); - TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr); - ExceptionRangeEnds(envPtr, range); - TclEmitOpcode( INST_END_CATCH, envPtr); - - /* - * Stack at this point: - * nonsimple: script <mark> returnCode - * simple: <mark> returnCode - */ - - goto dropScriptAtEnd; } + ExceptionRangeEnds(envPtr, range); + /* * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result, * and jump around the "error case" code. */ - PushLiteral(envPtr, "0", 1); + TclCheckStackDepth(depth+1, envPtr); + PushStringLiteral(envPtr, "0"); TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup); - /* Stack at this point: ?script? <mark> result TCL_OK */ /* * Emit the "error case" epilogue. Push the interpreter result and the * return code. */ - envPtr->currStackDepth = savedStackDepth; ExceptionRangeTarget(envPtr, range, catchOffset); - /* Stack at this point: ?script? */ + TclSetStackDepth(depth + dropScript, envPtr); + + if (dropScript) { + TclEmitOpcode( INST_POP, envPtr); + } + + + /* Stack at this point is empty */ TclEmitOpcode( INST_PUSH_RESULT, envPtr); TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr); - /* - * Update the target of the jump after the "no errors" code. - */ + /* Stack at this point on both branches: result returnCode */ - /* Stack at this point: ?script? result returnCode */ if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { Tcl_Panic("TclCompileCatchCmd: bad jump distance %d", (int)(CurrentOffset(envPtr) - jumpFixup.codeOffset)); } /* - * Push the return options if the caller wants them. + * Push the return options if the caller wants them. This needs to happen + * before INST_END_CATCH */ if (optsIndex != -1) { @@ -706,62 +666,118 @@ TclCompileCatchCmd( * End the catch */ - ExceptionRangeEnds(envPtr, range); TclEmitOpcode( INST_END_CATCH, envPtr); /* - * At this point, the top of the stack is inconveniently ordered: - * ?script? result returnCode ?returnOptions? - * Reverse the stack to bring the result to the top. + * Save the result and return options if the caller wants them. This needs + * to happen after INST_END_CATCH (compile-3.6/7). */ if (optsIndex != -1) { - TclEmitInstInt4( INST_REVERSE, 3, envPtr); - } else { - TclEmitInstInt4( INST_REVERSE, 2, envPtr); + Emit14Inst( INST_STORE_SCALAR, optsIndex, envPtr); + TclEmitOpcode( INST_POP, envPtr); } /* - * Store the result and remove it from the stack. + * At this point, the top of the stack is inconveniently ordered: + * result returnCode + * Reverse the stack to store the result. */ - Emit14Inst( INST_STORE_SCALAR, resultIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); + TclEmitInstInt4( INST_REVERSE, 2, envPtr); + if (resultIndex != -1) { + Emit14Inst( INST_STORE_SCALAR, resultIndex, envPtr); + } + TclEmitOpcode( INST_POP, envPtr); + + TclCheckStackDepth(depth+1, envPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclCompileConcatCmd -- + * + * Procedure called to compile the "concat" command. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "concat" command at + * runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileConcatCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Obj *objPtr, *listObj; + Tcl_Token *tokenPtr; + int i; + + /* TODO: Consider compiling expansion case. */ + if (parsePtr->numWords == 1) { + /* + * [concat] without arguments just pushes an empty object. + */ + + PushStringLiteral(envPtr, ""); + return TCL_OK; + } /* - * Stack is now ?script? ?returnOptions? returnCode. - * If the options dict has been requested, it is buried on the stack under - * the return code. Reverse the stack to bring it to the top, store it and - * remove it from the stack. + * Test if all arguments are compile-time known. If they are, we can + * implement with a simple push. */ - if (optsIndex != -1) { - TclEmitInstInt4( INST_REVERSE, 2, envPtr); - Emit14Inst( INST_STORE_SCALAR, optsIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); + listObj = Tcl_NewObj(); + for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) { + tokenPtr = TokenAfter(tokenPtr); + objPtr = Tcl_NewObj(); + if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) { + Tcl_DecrRefCount(objPtr); + Tcl_DecrRefCount(listObj); + listObj = NULL; + break; + } + (void) Tcl_ListObjAppendElement(NULL, listObj, objPtr); } + if (listObj != NULL) { + Tcl_Obj **objs; + const char *bytes; + int len; - dropScriptAtEnd: + Tcl_ListObjGetElements(NULL, listObj, &len, &objs); + objPtr = Tcl_ConcatObj(len, objs); + Tcl_DecrRefCount(listObj); + bytes = Tcl_GetStringFromObj(objPtr, &len); + PushLiteral(envPtr, bytes, len); + Tcl_DecrRefCount(objPtr); + return TCL_OK; + } /* - * Stack is now ?script? result. Get rid of the subst'ed script if it's - * hanging arond. + * General case: runtime concat. */ - if (cmdTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - TclEmitInstInt4( INST_REVERSE, 2, envPtr); - TclEmitOpcode( INST_POP, envPtr); + for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) { + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, i); } - /* - * Result of all this, on either branch, should have been to leave one - * operand -- the return code -- on the stack. - */ + TclEmitInstInt4( INST_CONCAT_STK, i-1, envPtr); - if (envPtr->currStackDepth != initStackDepth + 1) { - Tcl_Panic("in TclCompileCatchCmd, currStackDepth = %d should be %d", - envPtr->currStackDepth, initStackDepth+1); - } return TCL_OK; } @@ -792,6 +808,9 @@ TclCompileContinueCmd( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { + ExceptionRange *rangePtr; + ExceptionAux *auxPtr; + /* * There should be no argument after the "continue". */ @@ -801,11 +820,27 @@ TclCompileContinueCmd( } /* - * Emit a continue instruction. + * See if we can find a valid continueOffset (i.e., not -1) in the + * innermost containing exception range. */ - TclEmitOpcode(INST_CONTINUE, envPtr); - PushLiteral(envPtr, "", 0); /* Evil hack! */ + rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE, &auxPtr); + if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) { + /* + * Found the target! No need for a nasty INST_CONTINUE here. + */ + + TclCleanupStackForBreakContinue(envPtr, auxPtr); + TclAddLoopContinueFixup(envPtr, auxPtr); + } else { + /* + * Emit a real continue. + */ + + TclEmitOpcode(INST_CONTINUE, envPtr); + } + TclAdjustStackDepth(1, envPtr); + return TCL_OK; } @@ -837,11 +872,9 @@ TclCompileDictSetCmd( CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr; - int numWords, i; + int i, dictVarIndex; DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr; - int dictVarIndex, nameChars; - const char *name; /* * There must be at least one argument after the command. @@ -858,15 +891,7 @@ TclCompileDictSetCmd( */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); - if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - name = varTokenPtr[1].start; - nameChars = varTokenPtr[1].size; - if (!TclIsLocalScalar(name, nameChars)) { - return TCL_ERROR; - } - dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr); + dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr); if (dictVarIndex < 0) { return TCL_ERROR; } @@ -876,8 +901,7 @@ TclCompileDictSetCmd( */ tokenPtr = TokenAfter(varTokenPtr); - numWords = parsePtr->numWords-1; - for (i=1 ; i<numWords ; i++) { + for (i=2 ; i< parsePtr->numWords ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } @@ -886,7 +910,7 @@ TclCompileDictSetCmd( * Now emit the instruction to do the dict manipulation. */ - TclEmitInstInt4( INST_DICT_SET, numWords-2, envPtr); + TclEmitInstInt4( INST_DICT_SET, parsePtr->numWords-3, envPtr); TclEmitInt4( dictVarIndex, envPtr); TclAdjustStackDepth(-1, envPtr); return TCL_OK; @@ -903,8 +927,7 @@ TclCompileDictIncrCmd( { DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr, *keyTokenPtr; - int dictVarIndex, nameChars, incrAmount; - const char *name; + int dictVarIndex, incrAmount; /* * There must be at least two arguments after the command. @@ -928,7 +951,7 @@ TclCompileDictIncrCmd( incrTokenPtr = TokenAfter(keyTokenPtr); if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; + return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr); } word = incrTokenPtr[1].start; numBytes = incrTokenPtr[1].size; @@ -938,7 +961,7 @@ TclCompileDictIncrCmd( code = TclGetIntFromObj(NULL, intObj, &incrAmount); TclDecrRefCount(intObj); if (code != TCL_OK) { - return TCL_ERROR; + return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr); } } else { incrAmount = 1; @@ -950,24 +973,16 @@ TclCompileDictIncrCmd( * discover what the index is. */ - if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - name = varTokenPtr[1].start; - nameChars = varTokenPtr[1].size; - if (!TclIsLocalScalar(name, nameChars)) { - return TCL_ERROR; - } - dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr); + dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr); if (dictVarIndex < 0) { - return TCL_ERROR; + return TclCompileBasic2Or3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* * Emit the key and the code to actually do the increment. */ - CompileWord(envPtr, keyTokenPtr, interp, 3); + CompileWord(envPtr, keyTokenPtr, interp, 2); TclEmitInstInt4( INST_DICT_INCR_IMM, incrAmount, envPtr); TclEmitInt4( dictVarIndex, envPtr); return TCL_OK; @@ -983,7 +998,7 @@ TclCompileDictGetCmd( CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr; - int numWords, i; + int i; DefineLineInformation; /* TIP #280 */ /* @@ -991,21 +1006,21 @@ TclCompileDictGetCmd( * case is legal, but too special and magic for us to deal with here). */ + /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords < 3) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); - numWords = parsePtr->numWords-1; /* * Only compile this because we need INST_DICT_GET anyway. */ - for (i=0 ; i<numWords ; i++) { + for (i=1 ; i<parsePtr->numWords ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } - TclEmitInstInt4(INST_DICT_GET, numWords-1, envPtr); + TclEmitInstInt4(INST_DICT_GET, parsePtr->numWords-2, envPtr); TclAdjustStackDepth(-1, envPtr); return TCL_OK; } @@ -1020,7 +1035,7 @@ TclCompileDictExistsCmd( CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr; - int numWords, i; + int i; DefineLineInformation; /* TIP #280 */ /* @@ -1028,21 +1043,21 @@ TclCompileDictExistsCmd( * case is legal, but too special and magic for us to deal with here). */ + /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords < 3) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); - numWords = parsePtr->numWords-1; /* * Now we do the code generation. */ - for (i=0 ; i<numWords ; i++) { + for (i=1 ; i<parsePtr->numWords ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } - TclEmitInstInt4(INST_DICT_EXISTS, numWords-1, envPtr); + TclEmitInstInt4(INST_DICT_EXISTS, parsePtr->numWords-2, envPtr); TclAdjustStackDepth(-1, envPtr); return TCL_OK; } @@ -1058,14 +1073,14 @@ TclCompileDictUnsetCmd( { Tcl_Token *tokenPtr; DefineLineInformation; /* TIP #280 */ - int i, dictVarIndex, nameChars; - const char *name; + int i, dictVarIndex; /* * There must be at least one argument after the variable name for us to * compile to bytecode. */ + /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords < 3) { return TCL_ERROR; } @@ -1077,17 +1092,9 @@ TclCompileDictUnsetCmd( */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - name = tokenPtr[1].start; - nameChars = tokenPtr[1].size; - if (!TclIsLocalScalar(name, nameChars)) { - return TCL_ERROR; - } - dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr); + dictVarIndex = LocalScalarFromToken(tokenPtr, envPtr); if (dictVarIndex < 0) { - return TCL_ERROR; + return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* @@ -1176,12 +1183,12 @@ TclCompileDictCreateCmd( */ nonConstant: - worker = TclFindCompiledLocal(NULL, 0, 1, envPtr); + worker = AnonymousLocal(envPtr); if (worker < 0) { - return TCL_ERROR; + return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr); } - PushLiteral(envPtr, "", 0); + PushStringLiteral(envPtr, ""); Emit14Inst( INST_STORE_SCALAR, worker, envPtr); TclEmitOpcode( INST_POP, envPtr); tokenPtr = TokenAfter(parsePtr->tokenPtr); @@ -1219,8 +1226,9 @@ TclCompileDictMergeCmd( * argument, the only thing to do is to verify the dict-ness. */ + /* TODO: Consider support for compiling expanded args. (less likely) */ if (parsePtr->numWords < 2) { - PushLiteral(envPtr, "", 0); + PushStringLiteral(envPtr, ""); return TCL_OK; } else if (parsePtr->numWords == 2) { tokenPtr = TokenAfter(parsePtr->tokenPtr); @@ -1237,11 +1245,11 @@ TclCompileDictMergeCmd( * command when there's an LVT present. */ - workerIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr); + workerIndex = AnonymousLocal(envPtr); if (workerIndex < 0) { - return TCL_ERROR; + return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } - infoIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr); + infoIndex = AnonymousLocal(envPtr); /* * Get the first dictionary and verify that it is so. @@ -1258,7 +1266,7 @@ TclCompileDictMergeCmd( * For each of the remaining dictionaries... */ - outLoop = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); + outLoop = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); TclEmitInstInt4( INST_BEGIN_CATCH4, outLoop, envPtr); ExceptionRangeStarts(envPtr, outLoop); for (i=2 ; i<parsePtr->numWords ; i++) { @@ -1300,6 +1308,7 @@ TclCompileDictMergeCmd( * subsequent) dicts. This is strictly not necessary, but it is nice. */ + TclAdjustStackDepth(-1, envPtr); ExceptionRangeTarget(envPtr, outLoop, catchOffset); TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); TclEmitOpcode( INST_PUSH_RESULT, envPtr); @@ -1358,18 +1367,15 @@ CompileDictEachCmd( int numVars, endTargetOffset; int collectVar = -1; /* Index of temp var holding the result * dict. */ - int savedStackDepth = envPtr->currStackDepth; - /* Needed because jumps confuse the stack - * space calculator. */ const char **argv; Tcl_DString buffer; /* - * There must be at least three argument after the command. + * There must be three arguments after the command. */ if (parsePtr->numWords != 4) { - return TCL_ERROR; + return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } varsTokenPtr = TokenAfter(parsePtr->tokenPtr); @@ -1377,7 +1383,7 @@ CompileDictEachCmd( bodyTokenPtr = TokenAfter(dictTokenPtr); if (varsTokenPtr->type != TCL_TOKEN_SIMPLE_WORD || bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; + return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* @@ -1386,10 +1392,9 @@ CompileDictEachCmd( */ if (collect == TCL_EACH_COLLECT) { - collectVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, - envPtr); + collectVar = AnonymousLocal(envPtr); if (collectVar < 0) { - return TCL_ERROR; + return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } } @@ -1403,31 +1408,22 @@ CompileDictEachCmd( if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars, &argv) != TCL_OK) { Tcl_DStringFree(&buffer); - return TCL_ERROR; + return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } Tcl_DStringFree(&buffer); if (numVars != 2) { ckfree(argv); - return TCL_ERROR; + return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } nameChars = strlen(argv[0]); - if (!TclIsLocalScalar(argv[0], nameChars)) { - ckfree(argv); - return TCL_ERROR; - } - keyVarIndex = TclFindCompiledLocal(argv[0], nameChars, 1, envPtr); - + keyVarIndex = LocalScalar(argv[0], nameChars, envPtr); nameChars = strlen(argv[1]); - if (!TclIsLocalScalar(argv[1], nameChars)) { - ckfree(argv); - return TCL_ERROR; - } - valueVarIndex = TclFindCompiledLocal(argv[1], nameChars, 1, envPtr); + valueVarIndex = LocalScalar(argv[1], nameChars, envPtr); ckfree(argv); if ((keyVarIndex < 0) || (valueVarIndex < 0)) { - return TCL_ERROR; + return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* @@ -1437,9 +1433,9 @@ CompileDictEachCmd( * (at which point it should also have been finished with). */ - infoIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr); + infoIndex = AnonymousLocal(envPtr); if (infoIndex < 0) { - return TCL_ERROR; + return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* @@ -1450,7 +1446,7 @@ CompileDictEachCmd( */ if (collect == TCL_EACH_COLLECT) { - PushLiteral(envPtr, "", 0); + PushStringLiteral(envPtr, ""); Emit14Inst( INST_STORE_SCALAR, collectVar, envPtr); TclEmitOpcode( INST_POP, envPtr); } @@ -1460,20 +1456,21 @@ CompileDictEachCmd( * this point. */ - CompileWord(envPtr, dictTokenPtr, interp, 3); - TclEmitInstInt4( INST_DICT_FIRST, infoIndex, envPtr); - emptyTargetOffset = CurrentOffset(envPtr); - TclEmitInstInt4( INST_JUMP_TRUE4, 0, envPtr); + CompileWord(envPtr, dictTokenPtr, interp, 2); /* * Now we catch errors from here on so that we can finalize the search * started by Tcl_DictObjFirst above. */ - catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); + catchRange = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); TclEmitInstInt4( INST_BEGIN_CATCH4, catchRange, envPtr); ExceptionRangeStarts(envPtr, catchRange); + TclEmitInstInt4( INST_DICT_FIRST, infoIndex, envPtr); + emptyTargetOffset = CurrentOffset(envPtr); + TclEmitInstInt4( INST_JUMP_TRUE4, 0, envPtr); + /* * Inside the iteration, write the loop variables. */ @@ -1488,15 +1485,14 @@ CompileDictEachCmd( * Set up the loop exception targets. */ - loopRange = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE); + loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); ExceptionRangeStarts(envPtr, loopRange); /* * Compile the loop body itself. It should be stack-neutral. */ - SetLineInformation(3); - CompileBody(envPtr, bodyTokenPtr, interp); + BODY(bodyTokenPtr, 3); if (collect == TCL_EACH_COLLECT) { Emit14Inst( INST_LOAD_SCALAR, keyVarIndex, envPtr); TclEmitInstInt4(INST_OVER, 1, envPtr); @@ -1524,35 +1520,21 @@ CompileDictEachCmd( TclEmitInstInt4( INST_DICT_NEXT, infoIndex, envPtr); jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr); TclEmitInstInt4( INST_JUMP_FALSE4, jumpDisplacement, envPtr); - TclEmitOpcode( INST_POP, envPtr); - TclEmitOpcode( INST_POP, envPtr); - - /* - * Now do the final cleanup for the no-error case (this is where we break - * out of the loop to) by force-terminating the iteration (if not already - * terminated), ditching the exception info and jumping to the last - * instruction for this command. In theory, this could be done using the - * "finally" clause (next generated) but this is faster. - */ - - ExceptionRangeTarget(envPtr, loopRange, breakOffset); - TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( infoIndex, envPtr); - TclEmitOpcode( INST_END_CATCH, envPtr); endTargetOffset = CurrentOffset(envPtr); - TclEmitInstInt4( INST_JUMP4, 0, envPtr); + TclEmitInstInt1( INST_JUMP1, 0, envPtr); /* * Error handler "finally" clause, which force-terminates the iteration * and rethrows the error. */ + TclAdjustStackDepth(-1, envPtr); ExceptionRangeTarget(envPtr, catchRange, catchOffset); TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); TclEmitOpcode( INST_PUSH_RESULT, envPtr); + TclEmitOpcode( INST_END_CATCH, envPtr); TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( infoIndex, envPtr); - TclEmitOpcode( INST_END_CATCH, envPtr); if (collect == TCL_EACH_COLLECT) { TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( collectVar, envPtr); @@ -1565,14 +1547,17 @@ CompileDictEachCmd( * easy!) Note that we skip the END_CATCH. [Bug 1382528] */ - envPtr->currStackDepth = savedStackDepth + 2; jumpDisplacement = CurrentOffset(envPtr) - emptyTargetOffset; TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement, envPtr->codeStart + emptyTargetOffset); + jumpDisplacement = CurrentOffset(envPtr) - endTargetOffset; + TclUpdateInstInt1AtPc(INST_JUMP1, jumpDisplacement, + envPtr->codeStart + endTargetOffset); TclEmitOpcode( INST_POP, envPtr); TclEmitOpcode( INST_POP, envPtr); - TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( infoIndex, envPtr); + ExceptionRangeTarget(envPtr, loopRange, breakOffset); + TclFinalizeLoopExceptionRange(envPtr, loopRange); + TclEmitOpcode( INST_END_CATCH, envPtr); /* * Final stage of the command (normal case) is that we push an empty @@ -1580,15 +1565,14 @@ CompileDictEachCmd( * last to promote peephole optimization when it's dropped immediately. */ - jumpDisplacement = CurrentOffset(envPtr) - endTargetOffset; - TclUpdateInstInt4AtPc(INST_JUMP4, jumpDisplacement, - envPtr->codeStart + endTargetOffset); + TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); + TclEmitInt4( infoIndex, envPtr); if (collect == TCL_EACH_COLLECT) { Emit14Inst( INST_LOAD_SCALAR, collectVar, envPtr); TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr); TclEmitInt4( collectVar, envPtr); } else { - PushLiteral(envPtr, "", 0); + PushStringLiteral(envPtr, ""); } return TCL_OK; } @@ -1603,10 +1587,8 @@ TclCompileDictUpdateCmd( CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ - const char *name; - int i, nameChars, dictIndex, numVars, range, infoIndex; + int i, dictIndex, numVars, range, infoIndex; Tcl_Token **keyTokenPtrs, *dictVarTokenPtr, *bodyTokenPtr, *tokenPtr; - int savedStackDepth = envPtr->currStackDepth; DictUpdateInfo *duiPtr; JumpFixup jumpFixup; @@ -1635,17 +1617,9 @@ TclCompileDictUpdateCmd( */ dictVarTokenPtr = TokenAfter(parsePtr->tokenPtr); - if (dictVarTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - name = dictVarTokenPtr[1].start; - nameChars = dictVarTokenPtr[1].size; - if (!TclIsLocalScalar(name, nameChars)) { - return TCL_ERROR; - } - dictIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr); + dictIndex = LocalScalarFromToken(dictVarTokenPtr, envPtr); if (dictIndex < 0) { - return TCL_ERROR; + goto issueFallback; } /* @@ -1656,8 +1630,7 @@ TclCompileDictUpdateCmd( duiPtr = ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1)); duiPtr->length = numVars; - keyTokenPtrs = TclStackAlloc(interp, - sizeof(Tcl_Token *) * numVars); + keyTokenPtrs = TclStackAlloc(interp, sizeof(Tcl_Token *) * numVars); tokenPtr = TokenAfter(dictVarTokenPtr); for (i=0 ; i<numVars ; i++) { @@ -1666,37 +1639,21 @@ TclCompileDictUpdateCmd( */ keyTokenPtrs[i] = tokenPtr; - - /* - * Variables first need to be checked for sanity. - */ - tokenPtr = TokenAfter(tokenPtr); - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - goto failedUpdateInfoAssembly; - } - name = tokenPtr[1].start; - nameChars = tokenPtr[1].size; - if (!TclIsLocalScalar(name, nameChars)) { - goto failedUpdateInfoAssembly; - } /* - * Stash the index in the auxiliary data. + * Stash the index in the auxiliary data (if it is indeed a local + * scalar that is resolvable at compile-time). */ - duiPtr->varIndices[i] = - TclFindCompiledLocal(name, nameChars, 1, envPtr); + duiPtr->varIndices[i] = LocalScalarFromToken(tokenPtr, envPtr); if (duiPtr->varIndices[i] < 0) { goto failedUpdateInfoAssembly; } tokenPtr = TokenAfter(tokenPtr); } if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - failedUpdateInfoAssembly: - ckfree(duiPtr); - TclStackFree(interp, keyTokenPtrs); - return TCL_ERROR; + goto failedUpdateInfoAssembly; } bodyTokenPtr = tokenPtr; @@ -1708,20 +1665,17 @@ TclCompileDictUpdateCmd( infoIndex = TclCreateAuxData(duiPtr, &tclDictUpdateInfoType, envPtr); for (i=0 ; i<numVars ; i++) { - CompileWord(envPtr, keyTokenPtrs[i], interp, i); + CompileWord(envPtr, keyTokenPtrs[i], interp, 2*i+2); } TclEmitInstInt4( INST_LIST, numVars, envPtr); TclEmitInstInt4( INST_DICT_UPDATE_START, dictIndex, envPtr); - TclEmitInt4( infoIndex, envPtr); + TclEmitInt4( infoIndex, envPtr); - range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); + range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr); ExceptionRangeStarts(envPtr, range); - envPtr->currStackDepth++; - SetLineInformation(parsePtr->numWords - 1); - CompileBody(envPtr, bodyTokenPtr, interp); - envPtr->currStackDepth = savedStackDepth; + BODY(bodyTokenPtr, parsePtr->numWords - 1); ExceptionRangeEnds(envPtr, range); /* @@ -1732,7 +1686,7 @@ TclCompileDictUpdateCmd( TclEmitOpcode( INST_END_CATCH, envPtr); TclEmitInstInt4( INST_REVERSE, 2, envPtr); TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr); - TclEmitInt4( infoIndex, envPtr); + TclEmitInt4( infoIndex, envPtr); /* * Jump around the exceptional termination code. @@ -1753,16 +1707,25 @@ TclCompileDictUpdateCmd( TclEmitInstInt4( INST_REVERSE, 3, envPtr); TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr); - TclEmitInt4( infoIndex, envPtr); - TclEmitOpcode( INST_RETURN_STK, envPtr); + TclEmitInt4( infoIndex, envPtr); + TclEmitInvoke(envPtr,INST_RETURN_STK); if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d", (int) (CurrentOffset(envPtr) - jumpFixup.codeOffset)); } TclStackFree(interp, keyTokenPtrs); - envPtr->currStackDepth = savedStackDepth + 1; return TCL_OK; + + /* + * Clean up after a failure to create the DictUpdateInfo structure. + */ + + failedUpdateInfoAssembly: + ckfree(duiPtr); + TclStackFree(interp, keyTokenPtrs); + issueFallback: + return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } int @@ -1784,6 +1747,7 @@ TclCompileDictAppendCmd( * speed quite so much. ;-) */ + /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords<4 || parsePtr->numWords>100) { return TCL_ERROR; } @@ -1793,19 +1757,9 @@ TclCompileDictAppendCmd( */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } else { - register const char *name = tokenPtr[1].start; - register int nameChars = tokenPtr[1].size; - - if (!TclIsLocalScalar(name, nameChars)) { - return TCL_ERROR; - } - dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr); - if (dictVarIndex < 0) { - return TCL_ERROR; - } + dictVarIndex = LocalScalarFromToken(tokenPtr, envPtr); + if (dictVarIndex < 0) { + return TclCompileBasicMin2ArgCmd(interp, parsePtr,cmdPtr, envPtr); } /* @@ -1818,7 +1772,7 @@ TclCompileDictAppendCmd( tokenPtr = TokenAfter(tokenPtr); } if (parsePtr->numWords > 4) { - TclEmitInstInt1(INST_CONCAT1, parsePtr->numWords-3, envPtr); + TclEmitInstInt1(INST_STR_CONCAT1, parsePtr->numWords-3, envPtr); } /* @@ -1840,34 +1794,36 @@ TclCompileDictLappendCmd( { DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr, *keyTokenPtr, *valueTokenPtr; - int dictVarIndex, nameChars; - const char *name; + int dictVarIndex; /* * There must be three arguments after the command. */ + /* TODO: Consider support for compiling expanded args. */ + /* Probably not. Why is INST_DICT_LAPPEND limited to one value? */ if (parsePtr->numWords != 4) { return TCL_ERROR; } + /* + * Parse the arguments. + */ + varTokenPtr = TokenAfter(parsePtr->tokenPtr); keyTokenPtr = TokenAfter(varTokenPtr); valueTokenPtr = TokenAfter(keyTokenPtr); - if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - name = varTokenPtr[1].start; - nameChars = varTokenPtr[1].size; - if (!TclIsLocalScalar(name, nameChars)) { - return TCL_ERROR; - } - dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr); + dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr); if (dictVarIndex < 0) { - return TCL_ERROR; + return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } - CompileWord(envPtr, keyTokenPtr, interp, 3); - CompileWord(envPtr, valueTokenPtr, interp, 4); + + /* + * Issue the implementation. + */ + + CompileWord(envPtr, keyTokenPtr, interp, 2); + CompileWord(envPtr, valueTokenPtr, interp, 3); TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr); return TCL_OK; } @@ -1882,10 +1838,9 @@ TclCompileDictWithCmd( CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ - int i, range, varNameTmp, pathTmp, keysTmp, gotPath, dictVar = -1; - int bodyIsEmpty = 1; + int i, range, varNameTmp = -1, pathTmp = -1, keysTmp, gotPath; + int dictVar, bodyIsEmpty = 1; Tcl_Token *varTokenPtr, *tokenPtr; - int savedStackDepth = envPtr->currStackDepth; JumpFixup jumpFixup; const char *ptr, *end; @@ -1893,6 +1848,7 @@ TclCompileDictWithCmd( * There must be at least one argument after the command. */ + /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords < 3) { return TCL_ERROR; } @@ -1908,7 +1864,7 @@ TclCompileDictWithCmd( tokenPtr = TokenAfter(tokenPtr); } if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; + return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* @@ -1920,7 +1876,8 @@ TclCompileDictWithCmd( for (ptr=tokenPtr[1].start,end=ptr+tokenPtr[1].size ; ptr!=end ; ptr++) { if (*ptr!=' ' && *ptr!='\t' && *ptr!='\n' && *ptr!='\r') { if (envPtr->procPtr == NULL) { - return TCL_ERROR; + return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, + envPtr); } bodyIsEmpty = 0; break; @@ -1932,11 +1889,7 @@ TclCompileDictWithCmd( */ gotPath = (parsePtr->numWords > 3); - if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD && - TclIsLocalScalar(varTokenPtr[1].start, varTokenPtr[1].size)) { - dictVar = TclFindCompiledLocal(varTokenPtr[1].start, - varTokenPtr[1].size, 1, envPtr); - } + dictVar = LocalScalarFromToken(varTokenPtr, envPtr); /* * Special case: an empty body means we definitely have no need to issue @@ -1955,7 +1908,7 @@ TclCompileDictWithCmd( tokenPtr = TokenAfter(varTokenPtr); for (i=2 ; i<parsePtr->numWords-1 ; i++) { - CompileWord(envPtr, tokenPtr, interp, i-1); + CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr); @@ -1963,18 +1916,16 @@ TclCompileDictWithCmd( TclEmitInstInt4(INST_OVER, 1, envPtr); TclEmitOpcode( INST_DICT_EXPAND, envPtr); TclEmitInstInt4(INST_DICT_RECOMBINE_IMM, dictVar, envPtr); - PushLiteral(envPtr, "", 0); } else { /* * Case: Direct dict in LVT with empty body. */ - PushLiteral(envPtr, "", 0); + PushStringLiteral(envPtr, ""); Emit14Inst( INST_LOAD_SCALAR, dictVar, envPtr); - PushLiteral(envPtr, "", 0); + PushStringLiteral(envPtr, ""); TclEmitOpcode( INST_DICT_EXPAND, envPtr); TclEmitInstInt4(INST_DICT_RECOMBINE_IMM, dictVar, envPtr); - PushLiteral(envPtr, "", 0); } } else { if (gotPath) { @@ -1984,7 +1935,7 @@ TclCompileDictWithCmd( tokenPtr = varTokenPtr; for (i=1 ; i<parsePtr->numWords-1 ; i++) { - CompileWord(envPtr, tokenPtr, interp, i-1); + CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr); @@ -1993,24 +1944,22 @@ TclCompileDictWithCmd( TclEmitInstInt4(INST_OVER, 1, envPtr); TclEmitOpcode( INST_DICT_EXPAND, envPtr); TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr); - PushLiteral(envPtr, "", 0); } else { /* * Case: Direct dict in non-simple var with empty body. */ - CompileWord(envPtr, varTokenPtr, interp, 0); + CompileWord(envPtr, varTokenPtr, interp, 1); TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_LOAD_STK, envPtr); - PushLiteral(envPtr, "", 0); + PushStringLiteral(envPtr, ""); TclEmitOpcode( INST_DICT_EXPAND, envPtr); - PushLiteral(envPtr, "", 0); + PushStringLiteral(envPtr, ""); TclEmitInstInt4(INST_REVERSE, 2, envPtr); TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr); - PushLiteral(envPtr, "", 0); } } - envPtr->currStackDepth = savedStackDepth + 1; + PushStringLiteral(envPtr, ""); return TCL_OK; } @@ -2023,29 +1972,25 @@ TclCompileDictWithCmd( */ if (dictVar == -1) { - varNameTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr); - } else { - varNameTmp = -1; + varNameTmp = AnonymousLocal(envPtr); } if (gotPath) { - pathTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr); - } else { - pathTmp = -1; + pathTmp = AnonymousLocal(envPtr); } - keysTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr); + keysTmp = AnonymousLocal(envPtr); /* * Issue instructions. First, the part to expand the dictionary. */ - if (varNameTmp > -1) { - CompileWord(envPtr, varTokenPtr, interp, 0); + if (dictVar == -1) { + CompileWord(envPtr, varTokenPtr, interp, 1); Emit14Inst( INST_STORE_SCALAR, varNameTmp, envPtr); } tokenPtr = TokenAfter(varTokenPtr); if (gotPath) { for (i=2 ; i<parsePtr->numWords-1 ; i++) { - CompileWord(envPtr, tokenPtr, interp, i-1); + CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } TclEmitInstInt4( INST_LIST, parsePtr->numWords-3,envPtr); @@ -2060,7 +2005,7 @@ TclCompileDictWithCmd( if (gotPath) { Emit14Inst( INST_LOAD_SCALAR, pathTmp, envPtr); } else { - PushLiteral(envPtr, "", 0); + PushStringLiteral(envPtr, ""); } TclEmitOpcode( INST_DICT_EXPAND, envPtr); Emit14Inst( INST_STORE_SCALAR, keysTmp, envPtr); @@ -2070,14 +2015,11 @@ TclCompileDictWithCmd( * Now the body of the [dict with]. */ - range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); + range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr); ExceptionRangeStarts(envPtr, range); - envPtr->currStackDepth++; - SetLineInformation(parsePtr->numWords-1); - CompileBody(envPtr, tokenPtr, interp); - envPtr->currStackDepth = savedStackDepth; + BODY(tokenPtr, parsePtr->numWords - 1); ExceptionRangeEnds(envPtr, range); /* @@ -2085,13 +2027,13 @@ TclCompileDictWithCmd( */ TclEmitOpcode( INST_END_CATCH, envPtr); - if (varNameTmp > -1) { + if (dictVar == -1) { Emit14Inst( INST_LOAD_SCALAR, varNameTmp, envPtr); } if (gotPath) { Emit14Inst( INST_LOAD_SCALAR, pathTmp, envPtr); } else { - PushLiteral(envPtr, "", 0); + PushStringLiteral(envPtr, ""); } Emit14Inst( INST_LOAD_SCALAR, keysTmp, envPtr); if (dictVar == -1) { @@ -2105,17 +2047,18 @@ TclCompileDictWithCmd( * Now fold the results back into the dictionary in the exception case. */ + TclAdjustStackDepth(-1, envPtr); ExceptionRangeTarget(envPtr, range, catchOffset); TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); TclEmitOpcode( INST_PUSH_RESULT, envPtr); TclEmitOpcode( INST_END_CATCH, envPtr); - if (varNameTmp > -1) { + if (dictVar == -1) { Emit14Inst( INST_LOAD_SCALAR, varNameTmp, envPtr); } if (parsePtr->numWords > 3) { Emit14Inst( INST_LOAD_SCALAR, pathTmp, envPtr); } else { - PushLiteral(envPtr, "", 0); + PushStringLiteral(envPtr, ""); } Emit14Inst( INST_LOAD_SCALAR, keysTmp, envPtr); if (dictVar == -1) { @@ -2123,13 +2066,12 @@ TclCompileDictWithCmd( } else { TclEmitInstInt4( INST_DICT_RECOMBINE_IMM, dictVar, envPtr); } - TclEmitOpcode( INST_RETURN_STK, envPtr); + TclEmitInvoke(envPtr, INST_RETURN_STK); /* * Prepare for the start of the next command. */ - envPtr->currStackDepth = savedStackDepth + 1; if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d", (int) (CurrentOffset(envPtr) - jumpFixup.codeOffset)); @@ -2226,21 +2168,48 @@ TclCompileErrorCmd( { /* * General syntax: [error message ?errorInfo? ?errorCode?] - * However, we only deal with the case where there is just a message. */ - Tcl_Token *messageTokenPtr; - int savedStackDepth = envPtr->currStackDepth; + + Tcl_Token *tokenPtr; DefineLineInformation; /* TIP #280 */ - if (parsePtr->numWords != 2) { + if (parsePtr->numWords < 2 || parsePtr->numWords > 4) { return TCL_ERROR; } - messageTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushLiteral(envPtr, "-code error -level 0", 20); - CompileWord(envPtr, messageTokenPtr, interp, 1); - TclEmitOpcode(INST_RETURN_STK, envPtr); - envPtr->currStackDepth = savedStackDepth + 1; + /* + * Handle the message. + */ + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 1); + + /* + * Construct the options. Note that -code and -level are not here. + */ + + if (parsePtr->numWords == 2) { + PushStringLiteral(envPtr, ""); + } else { + PushStringLiteral(envPtr, "-errorinfo"); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 2); + if (parsePtr->numWords == 3) { + TclEmitInstInt4( INST_LIST, 2, envPtr); + } else { + PushStringLiteral(envPtr, "-errorcode"); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 3); + TclEmitInstInt4( INST_LIST, 4, envPtr); + } + } + + /* + * Issue the error via 'returnImm error 0'. + */ + + TclEmitInstInt4( INST_RETURN_IMM, TCL_ERROR, envPtr); + TclEmitInt4( 0, envPtr); return TCL_OK; } @@ -2318,9 +2287,8 @@ TclCompileForCmd( { Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr; JumpFixup jumpEvalCondFixup; - int testCodeOffset, bodyCodeOffset, nextCodeOffset, jumpDist; + int bodyCodeOffset, nextCodeOffset, jumpDist; int bodyRange, nextRange; - int savedStackDepth = envPtr->currStackDepth; DefineLineInformation; /* TIP #280 */ if (parsePtr->numWords != 5) { @@ -2352,20 +2320,10 @@ TclCompileForCmd( } /* - * Create ExceptionRange records for the body and the "next" command. The - * "next" command's ExceptionRange supports break but not continue (and - * has a -1 continueOffset). - */ - - bodyRange = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE); - nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); - - /* * Inline compile the initial command. */ - SetLineInformation(1); - CompileBody(envPtr, startTokenPtr, interp); + BODY(startTokenPtr, 1); TclEmitOpcode(INST_POP, envPtr); /* @@ -2386,44 +2344,38 @@ TclCompileForCmd( * Compile the loop body. */ + bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange); - SetLineInformation(4); - CompileBody(envPtr, bodyTokenPtr, interp); + BODY(bodyTokenPtr, 4); ExceptionRangeEnds(envPtr, bodyRange); - envPtr->currStackDepth = savedStackDepth + 1; TclEmitOpcode(INST_POP, envPtr); /* - * Compile the "next" subcommand. + * Compile the "next" subcommand. Note that this exception range will not + * have a continueOffset (other than -1) connected to it; it won't trap + * TCL_CONTINUE but rather just TCL_BREAK. */ - envPtr->currStackDepth = savedStackDepth; + nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); + envPtr->exceptAuxArrayPtr[nextRange].supportsContinue = 0; nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange); - SetLineInformation(3); - CompileBody(envPtr, nextTokenPtr, interp); + BODY(nextTokenPtr, 3); ExceptionRangeEnds(envPtr, nextRange); - envPtr->currStackDepth = savedStackDepth + 1; TclEmitOpcode(INST_POP, envPtr); - envPtr->currStackDepth = savedStackDepth; /* * Compile the test expression then emit the conditional jump that * terminates the for. */ - testCodeOffset = CurrentOffset(envPtr); - - jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset; - if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) { + if (TclFixupForwardJumpToHere(envPtr, &jumpEvalCondFixup, 127)) { bodyCodeOffset += 3; nextCodeOffset += 3; - testCodeOffset += 3; } SetLineInformation(2); - envPtr->currStackDepth = savedStackDepth; TclCompileExprWords(interp, testTokenPtr, 1, envPtr); - envPtr->currStackDepth = savedStackDepth + 1; + TclClearNumConversion(envPtr); jumpDist = CurrentOffset(envPtr) - bodyCodeOffset; if (jumpDist > 127) { @@ -2444,13 +2396,14 @@ TclCompileForCmd( ExceptionRangeTarget(envPtr, bodyRange, breakOffset); ExceptionRangeTarget(envPtr, nextRange, breakOffset); + TclFinalizeLoopExceptionRange(envPtr, bodyRange); + TclFinalizeLoopExceptionRange(envPtr, nextRange); /* * The for command's result is an empty string. */ - envPtr->currStackDepth = savedStackDepth; - PushLiteral(envPtr, "", 0); + PushStringLiteral(envPtr, ""); return TCL_OK; } @@ -2489,6 +2442,37 @@ TclCompileForeachCmd( /* *---------------------------------------------------------------------- * + * TclCompileLmapCmd -- + * + * Procedure called to compile the "lmap" command. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "lmap" command at + * runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileLmapCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + return CompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr, + TCL_EACH_COLLECT); +} + +/* + *---------------------------------------------------------------------- + * * CompileEachloopCmd -- * * Procedure called to compile the "foreach" and "lmap" commands. @@ -2519,19 +2503,10 @@ CompileEachloopCmd( ForeachInfo *infoPtr; /* Points to the structure describing this * foreach command. Stored in a AuxData * record in the ByteCode. */ - int firstValueTemp; /* Index of the first temp var in the frame - * used to point to a value list. */ - int loopCtTemp; /* Index of temp var holding the loop's - * iteration count. */ - int collectVar = -1; /* Index of temp var holding the result var - * index. */ - + Tcl_Token *tokenPtr, *bodyTokenPtr; - unsigned char *jumpPc; - JumpFixup jumpFalseFixup; - int jumpBackDist, jumpBackOffset, infoIndex, range, bodyIndex; - int numWords, numLists, numVars, loopIndex, tempVar, i, j, code; - int savedStackDepth = envPtr->currStackDepth; + int jumpBackOffset, infoIndex, range; + int numWords, numLists, numVars, loopIndex, i, j, code; DefineLineInformation; /* TIP #280 */ /* @@ -2570,8 +2545,6 @@ CompileEachloopCmd( return TCL_ERROR; } - bodyIndex = i-1; - /* * Allocate storage for the varcList and varvList arrays if necessary. */ @@ -2610,7 +2583,7 @@ CompileEachloopCmd( Tcl_DStringInit(&varList); TclDStringAppendToken(&varList, &tokenPtr[1]); - code = Tcl_SplitList(interp, Tcl_DStringValue(&varList), + code = Tcl_SplitList(NULL, Tcl_DStringValue(&varList), &varcList[loopIndex], &varvList[loopIndex]); Tcl_DStringFree(&varList); if (code != TCL_OK) { @@ -2641,35 +2614,11 @@ CompileEachloopCmd( loopIndex++; } - if (collect == TCL_EACH_COLLECT) { - collectVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, - envPtr); - if (collectVar < 0) { - return TCL_ERROR; - } - } - /* - * We will compile the foreach command. Reserve (numLists + 1) temporary - * variables: - * - numLists temps to hold each value list - * - 1 temp for the loop counter (index of next element in each list) - * - * At this time we don't try to reuse temporaries; if there are two - * nonoverlapping foreach loops, they don't share any temps. + * We will compile the foreach command. */ code = TCL_OK; - firstValueTemp = -1; - for (loopIndex = 0; loopIndex < numLists; loopIndex++) { - tempVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0, - /*create*/ 1, envPtr); - if (loopIndex == 0) { - firstValueTemp = tempVar; - } - } - loopCtTemp = TclFindCompiledLocal(NULL, /*nameChars*/ 0, - /*create*/ 1, envPtr); /* * Create and initialize the ForeachInfo and ForeachVarList data @@ -2678,16 +2627,14 @@ CompileEachloopCmd( */ infoPtr = ckalloc(sizeof(ForeachInfo) - + numLists * sizeof(ForeachVarList *)); + + (numLists - 1) * sizeof(ForeachVarList *)); infoPtr->numLists = numLists; - infoPtr->firstValueTemp = firstValueTemp; - infoPtr->loopCtTemp = loopCtTemp; for (loopIndex = 0; loopIndex < numLists; loopIndex++) { ForeachVarList *varListPtr; numVars = varcList[loopIndex]; varListPtr = ckalloc(sizeof(ForeachVarList) - + numVars * sizeof(int)); + + (numVars - 1) * sizeof(int)); varListPtr->numVars = numVars; for (j = 0; j < numVars; j++) { const char *varName = varvList[loopIndex][j]; @@ -2698,135 +2645,77 @@ CompileEachloopCmd( } infoPtr->varLists[loopIndex] = varListPtr; } - infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr); + infoIndex = TclCreateAuxData(infoPtr, &tclNewForeachInfoType, envPtr); /* - * Create an exception record to handle [break] and [continue]. + * Create the collecting object, unshared. */ - - range = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE); - + + if (collect == TCL_EACH_COLLECT) { + TclEmitInstInt4(INST_LIST, 0, envPtr); + } + /* - * Evaluate then store each value list in the associated temporary. + * Evaluate each value list and leave it on stack. */ - loopIndex = 0; for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; i++, tokenPtr = TokenAfter(tokenPtr)) { if ((i%2 == 0) && (i > 0)) { - SetLineInformation(i); - CompileTokens(envPtr, tokenPtr, interp); - tempVar = (firstValueTemp + loopIndex); - Emit14Inst( INST_STORE_SCALAR, tempVar, envPtr); - TclEmitOpcode( INST_POP, envPtr); - loopIndex++; + CompileWord(envPtr, tokenPtr, interp, i); } } - /* - * Create temporary variable to capture return values from loop body. - */ - - if (collect == TCL_EACH_COLLECT) { - PushLiteral(envPtr, "", 0); - Emit14Inst( INST_STORE_SCALAR, collectVar, envPtr); - TclEmitOpcode( INST_POP, envPtr); - } - - /* - * Initialize the temporary var that holds the count of loop iterations. - */ - - TclEmitInstInt4( INST_FOREACH_START4, infoIndex, envPtr); - - /* - * Top of loop code: assign each loop variable and check whether - * to terminate the loop. - */ - - ExceptionRangeTarget(envPtr, range, continueOffset); - TclEmitInstInt4( INST_FOREACH_STEP4, infoIndex, envPtr); - TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup); - + TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr); + /* * Inline compile the loop body. */ - SetLineInformation(bodyIndex); + range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); + ExceptionRangeStarts(envPtr, range); - CompileBody(envPtr, bodyTokenPtr, interp); + BODY(bodyTokenPtr, numWords - 1); ExceptionRangeEnds(envPtr, range); - envPtr->currStackDepth = savedStackDepth + 1; - + if (collect == TCL_EACH_COLLECT) { - Emit14Inst( INST_LAPPEND_SCALAR, collectVar,envPtr); - } - TclEmitOpcode( INST_POP, envPtr); - - /* - * Jump back to the test at the top of the loop. Generate a 4 byte jump if - * the distance to the test is > 120 bytes. This is conservative and - * ensures that we won't have to replace this jump if we later need to - * replace the ifFalse jump with a 4 byte jump. - */ - - jumpBackOffset = CurrentOffset(envPtr); - jumpBackDist = jumpBackOffset-envPtr->exceptArrayPtr[range].continueOffset; - if (jumpBackDist > 120) { - TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr); + TclEmitOpcode(INST_LMAP_COLLECT, envPtr); } else { - TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr); + TclEmitOpcode( INST_POP, envPtr); } /* - * Fix the target of the jump after the foreach_step test. + * Bottom of loop code: assign each loop variable and check whether + * to terminate the loop. Set the loop's break target. */ - if (TclFixupForwardJumpToHere(envPtr, &jumpFalseFixup, 127)) { - /* - * Update the loop body's starting PC offset since it moved down. - */ - - envPtr->exceptArrayPtr[range].codeOffset += 3; - - /* - * Update the jump back to the test at the top of the loop since it - * also moved down 3 bytes. - */ - - jumpBackOffset += 3; - jumpPc = (envPtr->codeStart + jumpBackOffset); - jumpBackDist += 3; - if (jumpBackDist > 120) { - TclUpdateInstInt4AtPc(INST_JUMP4, -jumpBackDist, jumpPc); - } else { - TclUpdateInstInt1AtPc(INST_JUMP1, -jumpBackDist, jumpPc); - } - } + ExceptionRangeTarget(envPtr, range, continueOffset); + TclEmitOpcode(INST_FOREACH_STEP, envPtr); + ExceptionRangeTarget(envPtr, range, breakOffset); + TclFinalizeLoopExceptionRange(envPtr, range); + TclEmitOpcode(INST_FOREACH_END, envPtr); + TclAdjustStackDepth(-(numLists+2), envPtr); /* - * Set the loop's break target. + * Set the jumpback distance from INST_FOREACH_STEP to the start of the + * body's code. Misuse loopCtTemp for storing the jump size. */ - - ExceptionRangeTarget(envPtr, range, breakOffset); + + jumpBackOffset = envPtr->exceptArrayPtr[range].continueOffset - + envPtr->exceptArrayPtr[range].codeOffset; + infoPtr->loopCtTemp = -jumpBackOffset; /* - * The command's result is an empty string if not collecting, or the - * list of results from evaluating the loop body. + * The command's result is an empty string if not collecting. If + * collecting, it is automatically left on stack after FOREACH_END. */ - envPtr->currStackDepth = savedStackDepth; - if (collect == TCL_EACH_COLLECT) { - Emit14Inst( INST_LOAD_SCALAR, collectVar, envPtr); - TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( collectVar, envPtr); - } else { - PushLiteral(envPtr, "", 0); + if (collect != TCL_EACH_COLLECT) { + PushStringLiteral(envPtr, ""); } - envPtr->currStackDepth = savedStackDepth + 1; - - done: + + done: for (loopIndex = 0; loopIndex < numLists; loopIndex++) { if (varvList[loopIndex] != NULL) { ckfree(varvList[loopIndex]); @@ -2980,6 +2869,36 @@ PrintForeachInfo( Tcl_AppendToObj(appendObj, "]", -1); } } + +static void +PrintNewForeachInfo( + ClientData clientData, + Tcl_Obj *appendObj, + ByteCode *codePtr, + unsigned int pcOffset) +{ + register ForeachInfo *infoPtr = clientData; + register ForeachVarList *varsPtr; + int i, j; + + Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+d, vars=", + infoPtr->loopCtTemp); + for (i=0 ; i<infoPtr->numLists ; i++) { + if (i) { + Tcl_AppendToObj(appendObj, ",", -1); + } + Tcl_AppendToObj(appendObj, "[", -1); + varsPtr = infoPtr->varLists[i]; + for (j=0 ; j<varsPtr->numVars ; j++) { + if (j) { + Tcl_AppendToObj(appendObj, ",", -1); + } + Tcl_AppendPrintfToObj(appendObj, "%%v%u", + (unsigned) varsPtr->varIndexes[j]); + } + Tcl_AppendToObj(appendObj, "]", -1); + } +} /* *---------------------------------------------------------------------- @@ -3059,7 +2978,8 @@ TclCompileFormatCmd( ckfree(objv); Tcl_DecrRefCount(formatObj); if (tmpObj == NULL) { - return TCL_ERROR; + TclCompileSyntaxError(interp, envPtr); + return TCL_OK; } /* @@ -3082,7 +3002,7 @@ TclCompileFormatCmd( * after our attempt to spot a literal). */ - for (; --i>=0 ;) { + for (; i>=0 ; i--) { Tcl_DecrRefCount(objv[i]); } ckfree(objv); @@ -3185,7 +3105,7 @@ TclCompileFormatCmd( * Do the concatenation, which produces the result. */ - TclEmitInstInt1(INST_CONCAT1, i, envPtr); + TclEmitInstInt1(INST_STR_CONCAT1, i, envPtr); } else { /* * EVIL HACK! Force there to be a string representation in the case @@ -3194,7 +3114,7 @@ TclCompileFormatCmd( */ TclEmitOpcode(INST_DUP, envPtr); - PushLiteral(envPtr, "", 0); + PushStringLiteral(envPtr, ""); TclEmitOpcode(INST_STR_EQ, envPtr); TclEmitOpcode(INST_POP, envPtr); } @@ -3204,2844 +3124,40 @@ TclCompileFormatCmd( /* *---------------------------------------------------------------------- * - * TclCompileGlobalCmd -- - * - * Procedure called to compile the "global" command. - * - * Results: - * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer - * evaluation to runtime. - * - * Side effects: - * Instructions are added to envPtr to execute the "global" command at - * runtime. - * - *---------------------------------------------------------------------- - */ - -int -TclCompileGlobalCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - Tcl_Token *varTokenPtr; - int localIndex, numWords, i; - DefineLineInformation; /* TIP #280 */ - - numWords = parsePtr->numWords; - if (numWords < 2) { - return TCL_ERROR; - } - - /* - * 'global' has no effect outside of proc bodies; handle that at runtime - */ - - if (envPtr->procPtr == NULL) { - return TCL_ERROR; - } - - /* - * Push the namespace - */ - - PushLiteral(envPtr, "::", 2); - - /* - * Loop over the variables. - */ - - varTokenPtr = TokenAfter(parsePtr->tokenPtr); - for (i=2; i<=numWords; varTokenPtr = TokenAfter(varTokenPtr),i++) { - localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr); - - if (localIndex < 0) { - return TCL_ERROR; - } - - CompileWord(envPtr, varTokenPtr, interp, 1); - TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr); - } - - /* - * Pop the namespace, and set the result to empty - */ - - TclEmitOpcode( INST_POP, envPtr); - PushLiteral(envPtr, "", 0); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TclCompileIfCmd -- - * - * Procedure called to compile the "if" command. - * - * Results: - * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer - * evaluation to runtime. - * - * Side effects: - * Instructions are added to envPtr to execute the "if" command at - * runtime. - * - *---------------------------------------------------------------------- - */ - -int -TclCompileIfCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - JumpFixupArray jumpFalseFixupArray; - /* Used to fix the ifFalse jump after each - * test when its target PC is determined. */ - JumpFixupArray jumpEndFixupArray; - /* Used to fix the jump after each "then" body - * to the end of the "if" when that PC is - * determined. */ - Tcl_Token *tokenPtr, *testTokenPtr; - int jumpIndex = 0; /* Avoid compiler warning. */ - int jumpFalseDist, numWords, wordIdx, numBytes, j, code; - const char *word; - int savedStackDepth = envPtr->currStackDepth; - /* Saved stack depth at the start of the first - * test; the envPtr current depth is restored - * to this value at the start of each test. */ - int realCond = 1; /* Set to 0 for static conditions: - * "if 0 {..}" */ - int boolVal; /* Value of static condition. */ - int compileScripts = 1; - DefineLineInformation; /* TIP #280 */ - - /* - * Only compile the "if" command if all arguments are simple words, in - * order to insure correct substitution [Bug 219166] - */ - - tokenPtr = parsePtr->tokenPtr; - wordIdx = 0; - numWords = parsePtr->numWords; - - for (wordIdx = 0; wordIdx < numWords; wordIdx++) { - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - tokenPtr = TokenAfter(tokenPtr); - } - - TclInitJumpFixupArray(&jumpFalseFixupArray); - TclInitJumpFixupArray(&jumpEndFixupArray); - code = TCL_OK; - - /* - * Each iteration of this loop compiles one "if expr ?then? body" or - * "elseif expr ?then? body" clause. - */ - - tokenPtr = parsePtr->tokenPtr; - wordIdx = 0; - while (wordIdx < numWords) { - /* - * Stop looping if the token isn't "if" or "elseif". - */ - - word = tokenPtr[1].start; - numBytes = tokenPtr[1].size; - if ((tokenPtr == parsePtr->tokenPtr) - || ((numBytes == 6) && (strncmp(word, "elseif", 6) == 0))) { - tokenPtr = TokenAfter(tokenPtr); - wordIdx++; - } else { - break; - } - if (wordIdx >= numWords) { - code = TCL_ERROR; - goto done; - } - - /* - * Compile the test expression then emit the conditional jump around - * the "then" part. - */ - - envPtr->currStackDepth = savedStackDepth; - testTokenPtr = tokenPtr; - - if (realCond) { - /* - * Find out if the condition is a constant. - */ - - Tcl_Obj *boolObj = Tcl_NewStringObj(testTokenPtr[1].start, - testTokenPtr[1].size); - - Tcl_IncrRefCount(boolObj); - code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal); - TclDecrRefCount(boolObj); - if (code == TCL_OK) { - /* - * A static condition. - */ - - realCond = 0; - if (!boolVal) { - compileScripts = 0; - } - } else { - SetLineInformation(wordIdx); - Tcl_ResetResult(interp); - TclCompileExprWords(interp, testTokenPtr, 1, envPtr); - if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) { - TclExpandJumpFixupArray(&jumpFalseFixupArray); - } - jumpIndex = jumpFalseFixupArray.next; - jumpFalseFixupArray.next++; - TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, - jumpFalseFixupArray.fixup+jumpIndex); - } - code = TCL_OK; - } - - /* - * Skip over the optional "then" before the then clause. - */ - - tokenPtr = TokenAfter(testTokenPtr); - wordIdx++; - if (wordIdx >= numWords) { - code = TCL_ERROR; - goto done; - } - if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - word = tokenPtr[1].start; - numBytes = tokenPtr[1].size; - if ((numBytes == 4) && (strncmp(word, "then", 4) == 0)) { - tokenPtr = TokenAfter(tokenPtr); - wordIdx++; - if (wordIdx >= numWords) { - code = TCL_ERROR; - goto done; - } - } - } - - /* - * Compile the "then" command body. - */ - - if (compileScripts) { - SetLineInformation(wordIdx); - envPtr->currStackDepth = savedStackDepth; - CompileBody(envPtr, tokenPtr, interp); - } - - if (realCond) { - /* - * Jump to the end of the "if" command. Both jumpFalseFixupArray - * and jumpEndFixupArray are indexed by "jumpIndex". - */ - - if (jumpEndFixupArray.next >= jumpEndFixupArray.end) { - TclExpandJumpFixupArray(&jumpEndFixupArray); - } - jumpEndFixupArray.next++; - TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, - jumpEndFixupArray.fixup+jumpIndex); - - /* - * Fix the target of the jumpFalse after the test. Generate a 4 - * byte jump if the distance is > 120 bytes. This is conservative, - * and ensures that we won't have to replace this jump if we later - * also need to replace the proceeding jump to the end of the "if" - * with a 4 byte jump. - */ - - if (TclFixupForwardJumpToHere(envPtr, - jumpFalseFixupArray.fixup+jumpIndex, 120)) { - /* - * Adjust the code offset for the proceeding jump to the end - * of the "if" command. - */ - - jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3; - } - } else if (boolVal) { - /* - * We were processing an "if 1 {...}"; stop compiling scripts. - */ - - compileScripts = 0; - } else { - /* - * We were processing an "if 0 {...}"; reset so that the rest - * (elseif, else) is compiled correctly. - */ - - realCond = 1; - compileScripts = 1; - } - - tokenPtr = TokenAfter(tokenPtr); - wordIdx++; - } - - /* - * Restore the current stack depth in the environment; the "else" clause - * (or its default) will add 1 to this. - */ - - envPtr->currStackDepth = savedStackDepth; - - /* - * Check for the optional else clause. Do not compile anything if this was - * an "if 1 {...}" case. - */ - - if ((wordIdx < numWords) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) { - /* - * There is an else clause. Skip over the optional "else" word. - */ - - word = tokenPtr[1].start; - numBytes = tokenPtr[1].size; - if ((numBytes == 4) && (strncmp(word, "else", 4) == 0)) { - tokenPtr = TokenAfter(tokenPtr); - wordIdx++; - if (wordIdx >= numWords) { - code = TCL_ERROR; - goto done; - } - } - - if (compileScripts) { - /* - * Compile the else command body. - */ - - SetLineInformation(wordIdx); - CompileBody(envPtr, tokenPtr, interp); - } - - /* - * Make sure there are no words after the else clause. - */ - - wordIdx++; - if (wordIdx < numWords) { - code = TCL_ERROR; - goto done; - } - } else { - /* - * No else clause: the "if" command's result is an empty string. - */ - - if (compileScripts) { - PushLiteral(envPtr, "", 0); - } - } - - /* - * Fix the unconditional jumps to the end of the "if" command. - */ - - for (j = jumpEndFixupArray.next; j > 0; j--) { - jumpIndex = (j - 1); /* i.e. process the closest jump first. */ - if (TclFixupForwardJumpToHere(envPtr, - jumpEndFixupArray.fixup+jumpIndex, 127)) { - /* - * Adjust the immediately preceeding "ifFalse" jump. We moved it's - * target (just after this jump) down three bytes. - */ - - unsigned char *ifFalsePc = envPtr->codeStart - + jumpFalseFixupArray.fixup[jumpIndex].codeOffset; - unsigned char opCode = *ifFalsePc; - - if (opCode == INST_JUMP_FALSE1) { - jumpFalseDist = TclGetInt1AtPtr(ifFalsePc + 1); - jumpFalseDist += 3; - TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1)); - } else if (opCode == INST_JUMP_FALSE4) { - jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1); - jumpFalseDist += 3; - TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1)); - } else { - Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%d\" updating ifFalse jump", (int) opCode); - } - } - } - - /* - * Free the jumpFixupArray array if malloc'ed storage was used. - */ - - done: - envPtr->currStackDepth = savedStackDepth + 1; - TclFreeJumpFixupArray(&jumpFalseFixupArray); - TclFreeJumpFixupArray(&jumpEndFixupArray); - return code; -} - -/* - *---------------------------------------------------------------------- - * - * TclCompileIncrCmd -- - * - * Procedure called to compile the "incr" command. - * - * Results: - * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer - * evaluation to runtime. - * - * Side effects: - * Instructions are added to envPtr to execute the "incr" command at - * runtime. - * - *---------------------------------------------------------------------- - */ - -int -TclCompileIncrCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - Tcl_Token *varTokenPtr, *incrTokenPtr; - int simpleVarName, isScalar, localIndex, haveImmValue, immValue; - DefineLineInformation; /* TIP #280 */ - - if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) { - return TCL_ERROR; - } - - varTokenPtr = TokenAfter(parsePtr->tokenPtr); - - PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX, - &localIndex, &simpleVarName, &isScalar, 1); - - /* - * If an increment is given, push it, but see first if it's a small - * integer. - */ - - haveImmValue = 0; - immValue = 1; - if (parsePtr->numWords == 3) { - incrTokenPtr = TokenAfter(varTokenPtr); - if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - const char *word = incrTokenPtr[1].start; - int numBytes = incrTokenPtr[1].size; - int code; - Tcl_Obj *intObj = Tcl_NewStringObj(word, numBytes); - - Tcl_IncrRefCount(intObj); - code = TclGetIntFromObj(NULL, intObj, &immValue); - TclDecrRefCount(intObj); - if ((code == TCL_OK) && (-127 <= immValue) && (immValue <= 127)) { - haveImmValue = 1; - } - if (!haveImmValue) { - PushLiteral(envPtr, word, numBytes); - } - } else { - SetLineInformation(2); - CompileTokens(envPtr, incrTokenPtr, interp); - } - } else { /* No incr amount given so use 1. */ - haveImmValue = 1; - } - - /* - * Emit the instruction to increment the variable. - */ - - if (!simpleVarName) { - if (haveImmValue) { - TclEmitInstInt1( INST_INCR_STK_IMM, immValue, envPtr); - } else { - TclEmitOpcode( INST_INCR_STK, envPtr); - } - } else if (isScalar) { /* Simple scalar variable. */ - if (localIndex >= 0) { - if (haveImmValue) { - TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr); - TclEmitInt1(immValue, envPtr); - } else { - TclEmitInstInt1(INST_INCR_SCALAR1, localIndex, envPtr); - } - } else { - if (haveImmValue) { - TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immValue, envPtr); - } else { - TclEmitOpcode( INST_INCR_SCALAR_STK, envPtr); - } - } - } else { /* Simple array variable. */ - if (localIndex >= 0) { - if (haveImmValue) { - TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex, envPtr); - TclEmitInt1(immValue, envPtr); - } else { - TclEmitInstInt1(INST_INCR_ARRAY1, localIndex, envPtr); - } - } else { - if (haveImmValue) { - TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr); - } else { - TclEmitOpcode( INST_INCR_ARRAY_STK, envPtr); - } - } - } - - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TclCompileInfo*Cmd -- - * - * Procedures called to compile "info" subcommands. - * - * Results: - * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer - * evaluation to runtime. - * - * Side effects: - * Instructions are added to envPtr to execute the "info" subcommand at - * runtime. - * - *---------------------------------------------------------------------- - */ - -int -TclCompileInfoCommandsCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) -{ - DefineLineInformation; /* TIP #280 */ - Tcl_Token *tokenPtr; - Tcl_Obj *objPtr; - char *bytes; - - /* - * We require one compile-time known argument for the case we can compile. - */ - - if (parsePtr->numWords != 2) { - return TCL_ERROR; - } - tokenPtr = TokenAfter(parsePtr->tokenPtr); - objPtr = Tcl_NewObj(); - Tcl_IncrRefCount(objPtr); - if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) { - goto notCompilable; - } - bytes = Tcl_GetString(objPtr); - - /* - * We require that the argument start with "::" and not have any of "*\[?" - * in it. (Theoretically, we should look in only the final component, but - * the difference is so slight given current naming practices.) - */ - - if (bytes[0] != ':' || bytes[1] != ':' || !TclMatchIsTrivial(bytes)) { - goto notCompilable; - } - Tcl_DecrRefCount(objPtr); - - /* - * Confirmed as a literal that will not frighten the horses. Compile. Note - * that the result needs to be list-ified. - */ - - CompileWord(envPtr, tokenPtr, interp, 1); - TclEmitOpcode( INST_RESOLVE_COMMAND, envPtr); - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_STR_LEN, envPtr); - TclEmitInstInt1( INST_JUMP_FALSE1, 7, envPtr); - TclEmitInstInt4( INST_LIST, 1, envPtr); - return TCL_OK; - - notCompilable: - Tcl_DecrRefCount(objPtr); - return TCL_ERROR; -} - -int -TclCompileInfoCoroutineCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - /* - * Only compile [info coroutine] without arguments. - */ - - if (parsePtr->numWords != 1) { - return TCL_ERROR; - } - - /* - * Not much to do; we compile to a single instruction... - */ - - TclEmitOpcode( INST_COROUTINE_NAME, envPtr); - return TCL_OK; -} - -int -TclCompileInfoExistsCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - Tcl_Token *tokenPtr; - int isScalar, simpleVarName, localIndex; - DefineLineInformation; /* TIP #280 */ - - if (parsePtr->numWords != 2) { - return TCL_ERROR; - } - - /* - * Decide if we can use a frame slot for the var/array name or if we need - * to emit code to compute and push the name at runtime. We use a frame - * slot (entry in the array of local vars) if we are compiling a procedure - * body and if the name is simple text that does not include namespace - * qualifiers. - */ - - tokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex, - &simpleVarName, &isScalar, 1); - - /* - * Emit instruction to check the variable for existence. - */ - - if (!simpleVarName) { - TclEmitOpcode( INST_EXIST_STK, envPtr); - } else if (isScalar) { - if (localIndex < 0) { - TclEmitOpcode( INST_EXIST_STK, envPtr); - } else { - TclEmitInstInt4( INST_EXIST_SCALAR, localIndex, envPtr); - } - } else { - if (localIndex < 0) { - TclEmitOpcode( INST_EXIST_ARRAY_STK, envPtr); - } else { - TclEmitInstInt4( INST_EXIST_ARRAY, localIndex, envPtr); - } - } - - return TCL_OK; -} - -int -TclCompileInfoLevelCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - /* - * Only compile [info level] without arguments or with a single argument. - */ - - if (parsePtr->numWords == 1) { - /* - * Not much to do; we compile to a single instruction... - */ - - TclEmitOpcode( INST_INFO_LEVEL_NUM, envPtr); - } else if (parsePtr->numWords != 2) { - return TCL_ERROR; - } else { - DefineLineInformation; /* TIP #280 */ - - /* - * Compile the argument, then add the instruction to convert it into a - * list of arguments. - */ - - SetLineInformation(1); - CompileTokens(envPtr, TokenAfter(parsePtr->tokenPtr), interp); - TclEmitOpcode( INST_INFO_LEVEL_ARGS, envPtr); - } - return TCL_OK; -} - -int -TclCompileInfoObjectClassCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) -{ - DefineLineInformation; /* TIP #280 */ - Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); - - if (parsePtr->numWords != 2) { - return TCL_ERROR; - } - CompileWord(envPtr, tokenPtr, interp, 1); - TclEmitOpcode( INST_TCLOO_CLASS, envPtr); - return TCL_OK; -} - -int -TclCompileInfoObjectIsACmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) -{ - DefineLineInformation; /* TIP #280 */ - Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); - - /* - * We only handle [info object isa object <somevalue>]. The first three - * words are compressed to a single token by the ensemble compilation - * engine. - */ - - if (parsePtr->numWords != 3) { - return TCL_ERROR; - } - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size < 1 - || strncmp(tokenPtr[1].start, "object", tokenPtr[1].size)) { - return TCL_ERROR; - } - tokenPtr = TokenAfter(tokenPtr); - - /* - * Issue the code. - */ - - CompileWord(envPtr, tokenPtr, interp, 2); - TclEmitOpcode( INST_TCLOO_IS_OBJECT, envPtr); - return TCL_OK; -} - -int -TclCompileInfoObjectNamespaceCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) -{ - DefineLineInformation; /* TIP #280 */ - Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); - - if (parsePtr->numWords != 2) { - return TCL_ERROR; - } - CompileWord(envPtr, tokenPtr, interp, 1); - TclEmitOpcode( INST_TCLOO_NS, envPtr); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TclCompileLappendCmd -- - * - * Procedure called to compile the "lappend" command. - * - * Results: - * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer - * evaluation to runtime. - * - * Side effects: - * Instructions are added to envPtr to execute the "lappend" command at - * runtime. - * - *---------------------------------------------------------------------- - */ - -int -TclCompileLappendCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - Tcl_Token *varTokenPtr; - int simpleVarName, isScalar, localIndex, numWords; - DefineLineInformation; /* TIP #280 */ - - /* - * If we're not in a procedure, don't compile. - */ - - if (envPtr->procPtr == NULL) { - return TCL_ERROR; - } - - numWords = parsePtr->numWords; - if (numWords == 1) { - return TCL_ERROR; - } - if (numWords != 3) { - /* - * LAPPEND instructions currently only handle one value appends. - */ - - return TCL_ERROR; - } - - /* - * Decide if we can use a frame slot for the var/array name or if we - * need to emit code to compute and push the name at runtime. We use a - * frame slot (entry in the array of local vars) if we are compiling a - * procedure body and if the name is simple text that does not include - * namespace qualifiers. - */ - - varTokenPtr = TokenAfter(parsePtr->tokenPtr); - - PushVarNameWord(interp, varTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); - - /* - * If we are doing an assignment, push the new value. In the no values - * case, create an empty object. - */ - - if (numWords > 2) { - Tcl_Token *valueTokenPtr = TokenAfter(varTokenPtr); - - CompileWord(envPtr, valueTokenPtr, interp, 2); - } - - /* - * Emit instructions to set/get the variable. - */ - - /* - * The *_STK opcodes should be refactored to make better use of existing - * LOAD/STORE instructions. - */ - - if (!simpleVarName) { - TclEmitOpcode( INST_LAPPEND_STK, envPtr); - } else if (isScalar) { - if (localIndex < 0) { - TclEmitOpcode( INST_LAPPEND_STK, envPtr); - } else { - Emit14Inst( INST_LAPPEND_SCALAR, localIndex, envPtr); - } - } else { - if (localIndex < 0) { - TclEmitOpcode( INST_LAPPEND_ARRAY_STK, envPtr); - } else { - Emit14Inst( INST_LAPPEND_ARRAY, localIndex, envPtr); - } - } - - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TclCompileLassignCmd -- - * - * Procedure called to compile the "lassign" command. - * - * Results: - * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer - * evaluation to runtime. - * - * Side effects: - * Instructions are added to envPtr to execute the "lassign" command at - * runtime. - * - *---------------------------------------------------------------------- - */ - -int -TclCompileLassignCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - Tcl_Token *tokenPtr; - int simpleVarName, isScalar, localIndex, numWords, idx; - DefineLineInformation; /* TIP #280 */ - - numWords = parsePtr->numWords; - - /* - * Check for command syntax error, but we'll punt that to runtime. - */ - - if (numWords < 3) { - return TCL_ERROR; - } - - /* - * Generate code to push list being taken apart by [lassign]. - */ - - tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 1); - - /* - * Generate code to assign values from the list to variables. - */ - - for (idx=0 ; idx<numWords-2 ; idx++) { - tokenPtr = TokenAfter(tokenPtr); - - /* - * Generate the next variable name. - */ - - PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex, - &simpleVarName, &isScalar, idx+2); - - /* - * Emit instructions to get the idx'th item out of the list value on - * the stack and assign it to the variable. - */ - - if (!simpleVarName) { - TclEmitInstInt4( INST_OVER, 1, envPtr); - TclEmitInstInt4( INST_LIST_INDEX_IMM, idx, envPtr); - TclEmitOpcode( INST_STORE_STK, envPtr); - TclEmitOpcode( INST_POP, envPtr); - } else if (isScalar) { - if (localIndex >= 0) { - TclEmitOpcode( INST_DUP, envPtr); - TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr); - Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); - } else { - TclEmitInstInt4(INST_OVER, 1, envPtr); - TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr); - TclEmitOpcode( INST_STORE_SCALAR_STK, envPtr); - TclEmitOpcode( INST_POP, envPtr); - } - } else { - if (localIndex >= 0) { - TclEmitInstInt4(INST_OVER, 1, envPtr); - TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr); - Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); - } else { - TclEmitInstInt4(INST_OVER, 2, envPtr); - TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr); - TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr); - TclEmitOpcode( INST_POP, envPtr); - } - } - } - - /* - * Generate code to leave the rest of the list on the stack. - */ - - TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr); - TclEmitInt4( -2 /* == "end" */, envPtr); - - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TclCompileLindexCmd -- - * - * Procedure called to compile the "lindex" command. - * - * Results: - * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer - * evaluation to runtime. - * - * Side effects: - * Instructions are added to envPtr to execute the "lindex" command at - * runtime. - * - *---------------------------------------------------------------------- - */ - -int -TclCompileLindexCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - Tcl_Token *idxTokenPtr, *valTokenPtr; - int i, numWords = parsePtr->numWords; - DefineLineInformation; /* TIP #280 */ - - /* - * Quit if too few args. - */ - - if (numWords <= 1) { - return TCL_ERROR; - } - - valTokenPtr = TokenAfter(parsePtr->tokenPtr); - if (numWords != 3) { - goto emitComplexLindex; - } - - idxTokenPtr = TokenAfter(valTokenPtr); - if (idxTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - Tcl_Obj *tmpObj; - int idx, result; - - tmpObj = Tcl_NewStringObj(idxTokenPtr[1].start, idxTokenPtr[1].size); - result = TclGetIntFromObj(NULL, tmpObj, &idx); - if (result == TCL_OK) { - if (idx < 0) { - result = TCL_ERROR; - } - } else { - result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx); - if (result == TCL_OK && idx > -2) { - result = TCL_ERROR; - } - } - TclDecrRefCount(tmpObj); - - if (result == TCL_OK) { - /* - * All checks have been completed, and we have exactly one of - * these constructs: - * lindex <arbitraryValue> <posInt> - * lindex <arbitraryValue> end-<posInt> - * This is best compiled as a push of the arbitrary value followed - * by an "immediate lindex" which is the most efficient variety. - */ - - CompileWord(envPtr, valTokenPtr, interp, 1); - TclEmitInstInt4( INST_LIST_INDEX_IMM, idx, envPtr); - return TCL_OK; - } - - /* - * If the conversion failed or the value was negative, we just keep on - * going with the more complex compilation. - */ - } - - /* - * Push the operands onto the stack. - */ - - emitComplexLindex: - for (i=1 ; i<numWords ; i++) { - CompileWord(envPtr, valTokenPtr, interp, i); - valTokenPtr = TokenAfter(valTokenPtr); - } - - /* - * Emit INST_LIST_INDEX if objc==3, or INST_LIST_INDEX_MULTI if there are - * multiple index args. - */ - - if (numWords == 3) { - TclEmitOpcode( INST_LIST_INDEX, envPtr); - } else { - TclEmitInstInt4( INST_LIST_INDEX_MULTI, numWords-1, envPtr); - } - - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TclCompileListCmd -- - * - * Procedure called to compile the "list" command. - * - * Results: - * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer - * evaluation to runtime. - * - * Side effects: - * Instructions are added to envPtr to execute the "list" command at - * runtime. - * - *---------------------------------------------------------------------- - */ - -int -TclCompileListCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - DefineLineInformation; /* TIP #280 */ - Tcl_Token *valueTokenPtr; - int i, numWords; - - /* - * If we're not in a procedure, don't compile. - */ - - if (envPtr->procPtr == NULL) { - return TCL_ERROR; - } - - if (parsePtr->numWords == 1) { - /* - * [list] without arguments just pushes an empty object. - */ - - PushLiteral(envPtr, "", 0); - } else { - /* - * Push the all values onto the stack. - */ - - numWords = parsePtr->numWords; - valueTokenPtr = TokenAfter(parsePtr->tokenPtr); - for (i = 1; i < numWords; i++) { - CompileWord(envPtr, valueTokenPtr, interp, i); - valueTokenPtr = TokenAfter(valueTokenPtr); - } - TclEmitInstInt4( INST_LIST, numWords - 1, envPtr); - } - - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TclCompileLlengthCmd -- - * - * Procedure called to compile the "llength" command. - * - * Results: - * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer - * evaluation to runtime. - * - * Side effects: - * Instructions are added to envPtr to execute the "llength" command at - * runtime. - * - *---------------------------------------------------------------------- - */ - -int -TclCompileLlengthCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - Tcl_Token *varTokenPtr; - DefineLineInformation; /* TIP #280 */ - - if (parsePtr->numWords != 2) { - return TCL_ERROR; - } - varTokenPtr = TokenAfter(parsePtr->tokenPtr); - - CompileWord(envPtr, varTokenPtr, interp, 1); - TclEmitOpcode( INST_LIST_LENGTH, envPtr); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TclCompileLrangeCmd -- - * - * How to compile the "lrange" command. We only bother because we needed - * the opcode anyway for "lassign". - * - *---------------------------------------------------------------------- - */ - -int -TclCompileLrangeCmd( - Tcl_Interp *interp, /* Tcl interpreter for context. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the - * command. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds the resulting instructions. */ -{ - Tcl_Token *tokenPtr, *listTokenPtr; - DefineLineInformation; /* TIP #280 */ - Tcl_Obj *tmpObj; - int idx1, idx2, result; - - if (parsePtr->numWords != 4) { - return TCL_ERROR; - } - listTokenPtr = TokenAfter(parsePtr->tokenPtr); - - /* - * Parse the first index. Will only compile if it is constant and not an - * _integer_ less than zero (since we reserve negative indices here for - * end-relative indexing). - */ - - tokenPtr = TokenAfter(listTokenPtr); - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size); - result = TclGetIntFromObj(NULL, tmpObj, &idx1); - if (result == TCL_OK) { - if (idx1 < 0) { - result = TCL_ERROR; - } - } else { - result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx1); - if (result == TCL_OK && idx1 > -2) { - result = TCL_ERROR; - } - } - TclDecrRefCount(tmpObj); - if (result != TCL_OK) { - return TCL_ERROR; - } - - /* - * Parse the second index. Will only compile if it is constant and not an - * _integer_ less than zero (since we reserve negative indices here for - * end-relative indexing). - */ - - tokenPtr = TokenAfter(tokenPtr); - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size); - result = TclGetIntFromObj(NULL, tmpObj, &idx2); - if (result == TCL_OK) { - if (idx2 < 0) { - result = TCL_ERROR; - } - } else { - result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx2); - if (result == TCL_OK && idx2 > -2) { - result = TCL_ERROR; - } - } - TclDecrRefCount(tmpObj); - if (result != TCL_OK) { - return TCL_ERROR; - } - - /* - * Issue instructions. It's not safe to skip doing the LIST_RANGE, as - * we've not proved that the 'list' argument is really a list. Not that it - * is worth trying to do that given current knowledge. - */ - - CompileWord(envPtr, listTokenPtr, interp, 1); - TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr); - TclEmitInt4( idx2, envPtr); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TclCompileLreplaceCmd -- - * - * How to compile the "lreplace" command. We only bother with the case - * where there are no elements to insert and where both the 'first' and - * 'last' arguments are constant and one can be deterined to be at the - * end of the list. (This is the case that could also be written with - * "lrange".) - * - *---------------------------------------------------------------------- - */ - -int -TclCompileLreplaceCmd( - Tcl_Interp *interp, /* Tcl interpreter for context. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the - * command. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds the resulting instructions. */ -{ - Tcl_Token *tokenPtr, *listTokenPtr; - DefineLineInformation; /* TIP #280 */ - Tcl_Obj *tmpObj; - int idx1, idx2, result, guaranteedDropAll = 0; - - if (parsePtr->numWords != 4) { - return TCL_ERROR; - } - listTokenPtr = TokenAfter(parsePtr->tokenPtr); - - /* - * Parse the first index. Will only compile if it is constant and not an - * _integer_ less than zero (since we reserve negative indices here for - * end-relative indexing). - */ - - tokenPtr = TokenAfter(listTokenPtr); - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size); - result = TclGetIntFromObj(NULL, tmpObj, &idx1); - if (result == TCL_OK) { - if (idx1 < 0) { - result = TCL_ERROR; - } - } else { - result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx1); - if (result == TCL_OK && idx1 > -2) { - result = TCL_ERROR; - } - } - TclDecrRefCount(tmpObj); - if (result != TCL_OK) { - return TCL_ERROR; - } - - /* - * Parse the second index. Will only compile if it is constant and not an - * _integer_ less than zero (since we reserve negative indices here for - * end-relative indexing). - */ - - tokenPtr = TokenAfter(tokenPtr); - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size); - result = TclGetIntFromObj(NULL, tmpObj, &idx2); - if (result == TCL_OK) { - if (idx2 < 0) { - result = TCL_ERROR; - } - } else { - result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx2); - if (result == TCL_OK && idx2 > -2) { - result = TCL_ERROR; - } - } - TclDecrRefCount(tmpObj); - if (result != TCL_OK) { - return TCL_ERROR; - } - - /* - * Sanity check: can only issue when we're removing a range at one or - * other end of the list. If we're at one end or the other, convert the - * indices into the equivalent for an [lrange]. - */ - - if (idx1 == 0) { - if (idx2 == -2) { - guaranteedDropAll = 1; - } - idx1 = idx2 + 1; - idx2 = -2; - } else if (idx2 == -2) { - idx2 = idx1 - 1; - idx1 = 0; - } else { - return TCL_ERROR; - } - - /* - * Issue instructions. It's not safe to skip doing the LIST_RANGE, as - * we've not proved that the 'list' argument is really a list. Not that it - * is worth trying to do that given current knowledge. - */ - - CompileWord(envPtr, listTokenPtr, interp, 1); - if (guaranteedDropAll) { - TclEmitOpcode( INST_LIST_LENGTH, envPtr); - TclEmitOpcode( INST_POP, envPtr); - PushLiteral(envPtr, "", 0); - } else { - TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr); - TclEmitInt4( idx2, envPtr); - } - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TclCompileLsetCmd -- - * - * Procedure called to compile the "lset" command. - * - * Results: - * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer - * evaluation to runtime. - * - * Side effects: - * Instructions are added to envPtr to execute the "lset" command at - * runtime. - * - * The general template for execution of the "lset" command is: - * (1) Instructions to push the variable name, unless the variable is - * local to the stack frame. - * (2) If the variable is an array element, instructions to push the - * array element name. - * (3) Instructions to push each of zero or more "index" arguments to the - * stack, followed with the "newValue" element. - * (4) Instructions to duplicate the variable name and/or array element - * name onto the top of the stack, if either was pushed at steps (1) - * and (2). - * (5) The appropriate INST_LOAD_* instruction to place the original - * value of the list variable at top of stack. - * (6) At this point, the stack contains: - * varName? arrayElementName? index1 index2 ... newValue oldList - * The compiler emits one of INST_LSET_FLAT or INST_LSET_LIST - * according as whether there is exactly one index element (LIST) or - * either zero or else two or more (FLAT). This instruction removes - * everything from the stack except for the two names and pushes the - * new value of the variable. - * (7) Finally, INST_STORE_* stores the new value in the variable and - * cleans up the stack. - * - *---------------------------------------------------------------------- - */ - -int -TclCompileLsetCmd( - Tcl_Interp *interp, /* Tcl interpreter for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the - * command. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds the resulting instructions. */ -{ - int tempDepth; /* Depth used for emitting one part of the - * code burst. */ - Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the - * parse of the variable name. */ - int localIndex; /* Index of var in local var table. */ - int simpleVarName; /* Flag == 1 if var name is simple. */ - int isScalar; /* Flag == 1 if scalar, 0 if array. */ - int i; - DefineLineInformation; /* TIP #280 */ - - /* - * Check argument count. - */ - - if (parsePtr->numWords < 3) { - /* - * Fail at run time, not in compilation. - */ - - return TCL_ERROR; - } - - /* - * Decide if we can use a frame slot for the var/array name or if we need - * to emit code to compute and push the name at runtime. We use a frame - * slot (entry in the array of local vars) if we are compiling a procedure - * body and if the name is simple text that does not include namespace - * qualifiers. - */ - - varTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(interp, varTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); - - /* - * Push the "index" args and the new element value. - */ - - for (i=2 ; i<parsePtr->numWords ; ++i) { - varTokenPtr = TokenAfter(varTokenPtr); - CompileWord(envPtr, varTokenPtr, interp, i); - } - - /* - * Duplicate the variable name if it's been pushed. - */ - - if (!simpleVarName || localIndex < 0) { - if (!simpleVarName || isScalar) { - tempDepth = parsePtr->numWords - 2; - } else { - tempDepth = parsePtr->numWords - 1; - } - TclEmitInstInt4( INST_OVER, tempDepth, envPtr); - } - - /* - * Duplicate an array index if one's been pushed. - */ - - if (simpleVarName && !isScalar) { - if (localIndex < 0) { - tempDepth = parsePtr->numWords - 1; - } else { - tempDepth = parsePtr->numWords - 2; - } - TclEmitInstInt4( INST_OVER, tempDepth, envPtr); - } - - /* - * Emit code to load the variable's value. - */ - - if (!simpleVarName) { - TclEmitOpcode( INST_LOAD_STK, envPtr); - } else if (isScalar) { - if (localIndex < 0) { - TclEmitOpcode( INST_LOAD_SCALAR_STK, envPtr); - } else { - Emit14Inst( INST_LOAD_SCALAR, localIndex, envPtr); - } - } else { - if (localIndex < 0) { - TclEmitOpcode( INST_LOAD_ARRAY_STK, envPtr); - } else { - Emit14Inst( INST_LOAD_ARRAY, localIndex, envPtr); - } - } - - /* - * Emit the correct variety of 'lset' instruction. - */ - - if (parsePtr->numWords == 4) { - TclEmitOpcode( INST_LSET_LIST, envPtr); - } else { - TclEmitInstInt4( INST_LSET_FLAT, parsePtr->numWords-1, envPtr); - } - - /* - * Emit code to put the value back in the variable. - */ - - if (!simpleVarName) { - TclEmitOpcode( INST_STORE_STK, envPtr); - } else if (isScalar) { - if (localIndex < 0) { - TclEmitOpcode( INST_STORE_SCALAR_STK, envPtr); - } else { - Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr); - } - } else { - if (localIndex < 0) { - TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr); - } else { - Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr); - } - } - - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TclCompileLmapCmd -- - * - * Procedure called to compile the "lmap" command. - * - * Results: - * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer - * evaluation to runtime. - * - * Side effects: - * Instructions are added to envPtr to execute the "lmap" command at - * runtime. - * - *---------------------------------------------------------------------- - */ - -int -TclCompileLmapCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - return CompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr, - TCL_EACH_COLLECT); -} - -/* - *---------------------------------------------------------------------- - * - * TclCompileNamespace*Cmd -- - * - * Procedures called to compile the "namespace" command; currently, only - * the subcommands "namespace current" and "namespace upvar" are compiled - * to bytecodes, and the latter only inside a procedure(-like) context. - * - * Results: - * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer - * evaluation to runtime. - * - * Side effects: - * Instructions are added to envPtr to execute the "namespace upvar" - * command at runtime. - * - *---------------------------------------------------------------------- - */ - -int -TclCompileNamespaceCurrentCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - /* - * Only compile [namespace current] without arguments. - */ - - if (parsePtr->numWords != 1) { - return TCL_ERROR; - } - - /* - * Not much to do; we compile to a single instruction... - */ - - TclEmitOpcode( INST_NS_CURRENT, envPtr); - return TCL_OK; -} - -int -TclCompileNamespaceCodeCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - Tcl_Token *tokenPtr; - DefineLineInformation; /* TIP #280 */ - - if (parsePtr->numWords != 2) { - return TCL_ERROR; - } - tokenPtr = TokenAfter(parsePtr->tokenPtr); - - /* - * The specification of [namespace code] is rather shocking, in that it is - * supposed to check if the argument is itself the result of [namespace - * code] and not apply itself in that case. Which is excessively cautious, - * but what the test suite checks for. - */ - - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || (tokenPtr[1].size > 20 - && strncmp(tokenPtr[1].start, "::namespace inscope ", 20) == 0)) { - /* - * Technically, we could just pass a literal '::namespace inscope ' - * term through, but that's something which really shouldn't be - * occurring as something that the user writes so we'll just punt it. - */ - - return TCL_ERROR; - } - - /* - * Now we can compile using the same strategy as [namespace code]'s normal - * implementation does internally. Note that we can't bind the namespace - * name directly here, because TclOO plays complex games with namespaces; - * the value needs to be determined at runtime for safety. - */ - - PushLiteral(envPtr, "::namespace", 11); - PushLiteral(envPtr, "inscope", 7); - TclEmitOpcode( INST_NS_CURRENT, envPtr); - CompileWord(envPtr, tokenPtr, interp, 1); - TclEmitInstInt4( INST_LIST, 4, envPtr); - return TCL_OK; -} - -int -TclCompileNamespaceQualifiersCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); - DefineLineInformation; /* TIP #280 */ - int off; - - if (parsePtr->numWords != 2) { - return TCL_ERROR; - } - - CompileWord(envPtr, tokenPtr, interp, 1); - PushLiteral(envPtr, "0", 1); - PushLiteral(envPtr, "::", 2); - TclEmitInstInt4( INST_OVER, 2, envPtr); - TclEmitOpcode( INST_STR_FIND_LAST, envPtr); - off = CurrentOffset(envPtr); - PushLiteral(envPtr, "1", 1); - TclEmitOpcode( INST_SUB, envPtr); - TclEmitInstInt4( INST_OVER, 2, envPtr); - TclEmitInstInt4( INST_OVER, 1, envPtr); - TclEmitOpcode( INST_STR_INDEX, envPtr); - PushLiteral(envPtr, ":", 1); - TclEmitOpcode( INST_STR_EQ, envPtr); - off = off - CurrentOffset(envPtr); - TclEmitInstInt1( INST_JUMP_TRUE1, off, envPtr); - TclEmitOpcode( INST_STR_RANGE, envPtr); - return TCL_OK; -} - -int -TclCompileNamespaceTailCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); - DefineLineInformation; /* TIP #280 */ - JumpFixup jumpFixup; - - if (parsePtr->numWords != 2) { - return TCL_ERROR; - } - - /* - * Take care; only add 2 to found index if the string was actually found. - */ - - CompileWord(envPtr, tokenPtr, interp, 1); - PushLiteral(envPtr, "::", 2); - TclEmitInstInt4( INST_OVER, 1, envPtr); - TclEmitOpcode( INST_STR_FIND_LAST, envPtr); - TclEmitOpcode( INST_DUP, envPtr); - PushLiteral(envPtr, "0", 1); - TclEmitOpcode( INST_GE, envPtr); - TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFixup); - PushLiteral(envPtr, "2", 1); - TclEmitOpcode( INST_ADD, envPtr); - TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127); - PushLiteral(envPtr, "end", 3); - TclEmitOpcode( INST_STR_RANGE, envPtr); - return TCL_OK; -} - -int -TclCompileNamespaceUpvarCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr; - int simpleVarName, isScalar, localIndex, numWords, i; - DefineLineInformation; /* TIP #280 */ - - if (envPtr->procPtr == NULL) { - return TCL_ERROR; - } - - /* - * Only compile [namespace upvar ...]: needs an even number of args, >=4 - */ - - numWords = parsePtr->numWords; - if ((numWords % 2) || (numWords < 4)) { - return TCL_ERROR; - } - - /* - * Push the namespace - */ - - tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 1); - - /* - * Loop over the (otherVar, thisVar) pairs. If any of the thisVar is not a - * local variable, return an error so that the non-compiled command will - * be called at runtime. - */ - - localTokenPtr = tokenPtr; - for (i=3; i<=numWords; i+=2) { - otherTokenPtr = TokenAfter(localTokenPtr); - localTokenPtr = TokenAfter(otherTokenPtr); - - CompileWord(envPtr, otherTokenPtr, interp, 1); - PushVarNameWord(interp, localTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); - - if ((localIndex < 0) || !isScalar) { - return TCL_ERROR; - } - TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr); - } - - /* - * Pop the namespace, and set the result to empty - */ - - TclEmitOpcode( INST_POP, envPtr); - PushLiteral(envPtr, "", 0); - return TCL_OK; -} - -int -TclCompileNamespaceWhichCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - DefineLineInformation; /* TIP #280 */ - Tcl_Token *tokenPtr, *opt; - int idx; - - if (parsePtr->numWords < 2 || parsePtr->numWords > 3) { - return TCL_ERROR; - } - tokenPtr = TokenAfter(parsePtr->tokenPtr); - idx = 1; - - /* - * If there's an option, check that it's "-command". We don't handle - * "-variable" (currently) and anything else is an error. - */ - - if (parsePtr->numWords == 3) { - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - opt = tokenPtr + 1; - if (opt->size < 2 || opt->size > 8 - || strncmp(opt->start, "-command", opt->size) != 0) { - return TCL_ERROR; - } - tokenPtr = TokenAfter(tokenPtr); - idx++; - } - - /* - * Issue the bytecode. - */ - - CompileWord(envPtr, tokenPtr, interp, idx); - TclEmitOpcode( INST_RESOLVE_COMMAND, envPtr); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TclCompileRegexpCmd -- - * - * Procedure called to compile the "regexp" command. - * - * Results: - * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer - * evaluation to runtime. - * - * Side effects: - * Instructions are added to envPtr to execute the "regexp" command at - * runtime. - * - *---------------------------------------------------------------------- - */ - -int -TclCompileRegexpCmd( - Tcl_Interp *interp, /* Tcl interpreter for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the - * command. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds the resulting instructions. */ -{ - Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the - * parse of the RE or string. */ - int i, len, nocase, exact, sawLast, simple; - const char *str; - DefineLineInformation; /* TIP #280 */ - - /* - * We are only interested in compiling simple regexp cases. Currently - * supported compile cases are: - * regexp ?-nocase? ?--? staticString $var - * regexp ?-nocase? ?--? {^staticString$} $var - */ - - if (parsePtr->numWords < 3) { - return TCL_ERROR; - } - - simple = 0; - nocase = 0; - sawLast = 0; - varTokenPtr = parsePtr->tokenPtr; - - /* - * We only look for -nocase and -- as options. Everything else gets pushed - * to runtime execution. This is different than regexp's runtime option - * handling, but satisfies our stricter needs. - */ - - for (i = 1; i < parsePtr->numWords - 2; i++) { - varTokenPtr = TokenAfter(varTokenPtr); - if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - /* - * Not a simple string, so punt to runtime. - */ - - return TCL_ERROR; - } - str = varTokenPtr[1].start; - len = varTokenPtr[1].size; - if ((len == 2) && (str[0] == '-') && (str[1] == '-')) { - sawLast++; - i++; - break; - } else if ((len > 1) && (strncmp(str,"-nocase",(unsigned)len) == 0)) { - nocase = 1; - } else { - /* - * Not an option we recognize. - */ - - return TCL_ERROR; - } - } - - if ((parsePtr->numWords - i) != 2) { - /* - * We don't support capturing to variables. - */ - - return TCL_ERROR; - } - - /* - * Get the regexp string. If it is not a simple string or can't be - * converted to a glob pattern, push the word for the INST_REGEXP. - * Keep changes here in sync with TclCompileSwitchCmd Switch_Regexp. - */ - - varTokenPtr = TokenAfter(varTokenPtr); - - if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - Tcl_DString ds; - - str = varTokenPtr[1].start; - len = varTokenPtr[1].size; - - /* - * If it has a '-', it could be an incorrectly formed regexp command. - */ - - if ((*str == '-') && !sawLast) { - return TCL_ERROR; - } - - if (len == 0) { - /* - * The semantics of regexp are always match on re == "". - */ - - PushLiteral(envPtr, "1", 1); - return TCL_OK; - } - - /* - * Attempt to convert pattern to glob. If successful, push the - * converted pattern as a literal. - */ - - if (TclReToGlob(NULL, varTokenPtr[1].start, len, &ds, &exact) - == TCL_OK) { - simple = 1; - PushLiteral(envPtr, Tcl_DStringValue(&ds),Tcl_DStringLength(&ds)); - Tcl_DStringFree(&ds); - } - } - - if (!simple) { - CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-2); - } - - /* - * Push the string arg. - */ - - varTokenPtr = TokenAfter(varTokenPtr); - CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-1); - - if (simple) { - if (exact && !nocase) { - TclEmitOpcode( INST_STR_EQ, envPtr); - } else { - TclEmitInstInt1( INST_STR_MATCH, nocase, envPtr); - } - } else { - /* - * Pass correct RE compile flags. We use only Int1 (8-bit), but - * that handles all the flags we want to pass. - * Don't use TCL_REG_NOSUB as we may have backrefs. - */ - - int cflags = TCL_REG_ADVANCED | (nocase ? TCL_REG_NOCASE : 0); - - TclEmitInstInt1( INST_REGEXP, cflags, envPtr); - } - - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TclCompileRegsubCmd -- - * - * Procedure called to compile the "regsub" command. - * - * Results: - * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer - * evaluation to runtime. - * - * Side effects: - * Instructions are added to envPtr to execute the "regsub" command at - * runtime. - * - *---------------------------------------------------------------------- - */ - -int -TclCompileRegsubCmd( - Tcl_Interp *interp, /* Tcl interpreter for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the - * command. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds the resulting instructions. */ -{ - /* - * We only compile the case with [regsub -all] where the pattern is both - * known at compile time and simple (i.e., no RE metacharacters). That is, - * the pattern must be translatable into a glob like "*foo*" with no other - * glob metacharacters inside it; there must be some "foo" in there too. - * The substitution string must also be known at compile time and free of - * metacharacters ("\digit" and "&"). Finally, there must not be a - * variable mentioned in the [regsub] to write the result back to (because - * we can't get the count of substitutions that would be the result in - * that case). The key is that these are the conditions under which a - * [string map] could be used instead, in particular a [string map] of the - * form we can compile to bytecode. - * - * In short, we look for: - * - * regsub -all [--] simpleRE string simpleReplacement - * - * The only optional part is the "--", and no other options are handled. - */ - - DefineLineInformation; /* TIP #280 */ - Tcl_Token *tokenPtr, *stringTokenPtr; - Tcl_Obj *patternObj = NULL, *replacementObj = NULL; - Tcl_DString pattern; - const char *bytes; - int len, exact, result = TCL_ERROR; - - if (parsePtr->numWords < 5 || parsePtr->numWords > 6) { - return TCL_ERROR; - } - - /* - * Parse the "-all", which must be the first argument (other options not - * supported, non-"-all" substitution we can't compile). - */ - - tokenPtr = TokenAfter(parsePtr->tokenPtr); - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size != 4 - || strncmp(tokenPtr[1].start, "-all", 4)) { - return TCL_ERROR; - } - - /* - * Get the pattern into patternObj, checking for "--" in the process. - */ - - Tcl_DStringInit(&pattern); - tokenPtr = TokenAfter(tokenPtr); - patternObj = Tcl_NewObj(); - if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) { - goto done; - } - if (Tcl_GetString(patternObj)[0] == '-') { - if (strcmp(Tcl_GetString(patternObj), "--") != 0 - || parsePtr->numWords == 5) { - goto done; - } - tokenPtr = TokenAfter(tokenPtr); - Tcl_DecrRefCount(patternObj); - patternObj = Tcl_NewObj(); - if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) { - goto done; - } - } else if (parsePtr->numWords == 6) { - goto done; - } - - /* - * Identify the code which produces the string to apply the substitution - * to (stringTokenPtr), and the replacement string (into replacementObj). - */ - - stringTokenPtr = TokenAfter(tokenPtr); - tokenPtr = TokenAfter(stringTokenPtr); - replacementObj = Tcl_NewObj(); - if (!TclWordKnownAtCompileTime(tokenPtr, replacementObj)) { - goto done; - } - - /* - * Next, higher-level checks. Is the RE a very simple glob? Is the - * replacement "simple"? - */ - - bytes = Tcl_GetStringFromObj(patternObj, &len); - if (TclReToGlob(NULL, bytes, len, &pattern, &exact) != TCL_OK || exact) { - goto done; - } - bytes = Tcl_DStringValue(&pattern); - if (*bytes++ != '*') { - goto done; - } - while (1) { - switch (*bytes) { - case '*': - if (bytes[1] == '\0') { - /* - * OK, we've proved there are no metacharacters except for the - * '*' at each end. - */ - - len = Tcl_DStringLength(&pattern) - 2; - if (len > 0) { - goto isSimpleGlob; - } - - /* - * The pattern is "**"! I believe that should be impossible, - * but we definitely can't handle that at all. - */ - } - case '\0': case '?': case '[': case '\\': - goto done; - } - bytes++; - } - isSimpleGlob: - for (bytes = Tcl_GetString(replacementObj); *bytes; bytes++) { - switch (*bytes) { - case '\\': case '&': - goto done; - } - } - - /* - * Proved the simplicity constraints! Time to issue the code. - */ - - result = TCL_OK; - bytes = Tcl_DStringValue(&pattern) + 1; - PushLiteral(envPtr, bytes, len); - bytes = Tcl_GetStringFromObj(replacementObj, &len); - PushLiteral(envPtr, bytes, len); - CompileWord(envPtr, stringTokenPtr, interp, parsePtr->numWords-2); - TclEmitOpcode( INST_STR_MAP, envPtr); - - done: - Tcl_DStringFree(&pattern); - if (patternObj) { - Tcl_DecrRefCount(patternObj); - } - if (replacementObj) { - Tcl_DecrRefCount(replacementObj); - } - return result; -} - -/* - *---------------------------------------------------------------------- - * - * TclCompileReturnCmd -- - * - * Procedure called to compile the "return" command. - * - * Results: - * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer - * evaluation to runtime. - * - * Side effects: - * Instructions are added to envPtr to execute the "return" command at - * runtime. - * - *---------------------------------------------------------------------- - */ - -int -TclCompileReturnCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - /* - * General syntax: [return ?-option value ...? ?result?] - * An even number of words means an explicit result argument is present. - */ - int level, code, objc, size, status = TCL_OK; - int numWords = parsePtr->numWords; - int explicitResult = (0 == (numWords % 2)); - int numOptionWords = numWords - 1 - explicitResult; - int savedStackDepth = envPtr->currStackDepth; - Tcl_Obj *returnOpts, **objv; - Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr); - DefineLineInformation; /* TIP #280 */ - - /* - * Check for special case which can always be compiled: - * return -options <opts> <msg> - * Unlike the normal [return] compilation, this version does everything at - * runtime so it can handle arbitrary words and not just literals. Note - * that if INST_RETURN_STK wasn't already needed for something else - * ('finally' clause processing) this piece of code would not be present. - */ - - if ((numWords == 4) && (wordTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) - && (wordTokenPtr[1].size == 8) - && (strncmp(wordTokenPtr[1].start, "-options", 8) == 0)) { - Tcl_Token *optsTokenPtr = TokenAfter(wordTokenPtr); - Tcl_Token *msgTokenPtr = TokenAfter(optsTokenPtr); - - CompileWord(envPtr, optsTokenPtr, interp, 2); - CompileWord(envPtr, msgTokenPtr, interp, 3); - TclEmitOpcode(INST_RETURN_STK, envPtr); - envPtr->currStackDepth = savedStackDepth + 1; - return TCL_OK; - } - - /* - * Allocate some working space. - */ - - objv = TclStackAlloc(interp, numOptionWords * sizeof(Tcl_Obj *)); - - /* - * Scan through the return options. If any are unknown at compile time, - * there is no value in bytecompiling. Save the option values known in an - * objv array for merging into a return options dictionary. - */ - - for (objc = 0; objc < numOptionWords; objc++) { - objv[objc] = Tcl_NewObj(); - Tcl_IncrRefCount(objv[objc]); - if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) { - objc++; - status = TCL_ERROR; - goto cleanup; - } - wordTokenPtr = TokenAfter(wordTokenPtr); - } - status = TclMergeReturnOptions(interp, objc, objv, - &returnOpts, &code, &level); - cleanup: - while (--objc >= 0) { - TclDecrRefCount(objv[objc]); - } - TclStackFree(interp, objv); - if (TCL_ERROR == status) { - /* - * Something was bogus in the return options. Clear the error message, - * and report back to the compiler that this must be interpreted at - * runtime. - */ - - Tcl_ResetResult(interp); - return TCL_ERROR; - } - - /* - * All options are known at compile time, so we're going to bytecompile. - * Emit instructions to push the result on the stack. - */ - - if (explicitResult) { - CompileWord(envPtr, wordTokenPtr, interp, numWords-1); - } else { - /* - * No explict result argument, so default result is empty string. - */ - - PushLiteral(envPtr, "", 0); - } - - /* - * Check for optimization: When [return] is in a proc, and there's no - * enclosing [catch], and there are no return options, then the INST_DONE - * instruction is equivalent, and may be more efficient. - */ - - if (numOptionWords == 0 && envPtr->procPtr != NULL) { - /* - * We have default return options and we're in a proc ... - */ - - int index = envPtr->exceptArrayNext - 1; - int enclosingCatch = 0; - - while (index >= 0) { - ExceptionRange range = envPtr->exceptArrayPtr[index]; - - if ((range.type == CATCH_EXCEPTION_RANGE) - && (range.catchOffset == -1)) { - enclosingCatch = 1; - break; - } - index--; - } - if (!enclosingCatch) { - /* - * ... and there is no enclosing catch. Issue the maximally - * efficient exit instruction. - */ - - Tcl_DecrRefCount(returnOpts); - TclEmitOpcode(INST_DONE, envPtr); - return TCL_OK; - } - } - - /* Optimize [return -level 0 $x]. */ - Tcl_DictObjSize(NULL, returnOpts, &size); - if (size == 0 && level == 0 && code == TCL_OK) { - Tcl_DecrRefCount(returnOpts); - return TCL_OK; - } - - /* - * Could not use the optimization, so we push the return options dict, and - * 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(op, code, envPtr); - TclEmitInt4(level, envPtr); -} - -void -TclCompileSyntaxError( - Tcl_Interp *interp, - CompileEnv *envPtr) -{ - Tcl_Obj *msg = Tcl_GetObjResult(interp); - int numBytes; - const char *bytes = TclGetStringFromObj(msg, &numBytes); - - TclErrorStackResetIf(interp, bytes, numBytes); - TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, numBytes), envPtr); - CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0, - TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR))); -} - -/* - *---------------------------------------------------------------------- - * - * TclCompileUpvarCmd -- - * - * Procedure called to compile the "upvar" command. - * - * Results: - * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer - * evaluation to runtime. - * - * Side effects: - * Instructions are added to envPtr to execute the "upvar" command at - * runtime. - * - *---------------------------------------------------------------------- - */ - -int -TclCompileUpvarCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr; - int simpleVarName, isScalar, localIndex, numWords, i; - DefineLineInformation; /* TIP #280 */ - Tcl_Obj *objPtr = Tcl_NewObj(); - - if (envPtr->procPtr == NULL) { - Tcl_DecrRefCount(objPtr); - return TCL_ERROR; - } - - numWords = parsePtr->numWords; - if (numWords < 3) { - Tcl_DecrRefCount(objPtr); - return TCL_ERROR; - } - - /* - * Push the frame index if it is known at compile time - */ - - tokenPtr = TokenAfter(parsePtr->tokenPtr); - if (TclWordKnownAtCompileTime(tokenPtr, objPtr)) { - CallFrame *framePtr; - const Tcl_ObjType *newTypePtr, *typePtr = objPtr->typePtr; - - /* - * Attempt to convert to a level reference. Note that TclObjGetFrame - * only changes the obj type when a conversion was successful. - */ - - TclObjGetFrame(interp, objPtr, &framePtr); - newTypePtr = objPtr->typePtr; - Tcl_DecrRefCount(objPtr); - - if (newTypePtr != typePtr) { - if (numWords%2) { - return TCL_ERROR; - } - CompileWord(envPtr, tokenPtr, interp, 1); - otherTokenPtr = TokenAfter(tokenPtr); - i = 4; - } else { - if (!(numWords%2)) { - return TCL_ERROR; - } - PushLiteral(envPtr, "1", 1); - otherTokenPtr = tokenPtr; - i = 3; - } - } else { - Tcl_DecrRefCount(objPtr); - return TCL_ERROR; - } - - /* - * Loop over the (otherVar, thisVar) pairs. If any of the thisVar is not a - * local variable, return an error so that the non-compiled command will - * be called at runtime. - */ - - for (; i<=numWords; i+=2, otherTokenPtr = TokenAfter(localTokenPtr)) { - localTokenPtr = TokenAfter(otherTokenPtr); - - CompileWord(envPtr, otherTokenPtr, interp, 1); - PushVarNameWord(interp, localTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); - - if ((localIndex < 0) || !isScalar) { - return TCL_ERROR; - } - TclEmitInstInt4( INST_UPVAR, localIndex, envPtr); - } - - /* - * Pop the frame index, and set the result to empty - */ - - TclEmitOpcode( INST_POP, envPtr); - PushLiteral(envPtr, "", 0); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TclCompileVariableCmd -- - * - * Procedure called to compile the "variable" command. - * - * Results: - * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer - * evaluation to runtime. - * - * Side effects: - * Instructions are added to envPtr to execute the "variable" command at - * runtime. - * - *---------------------------------------------------------------------- - */ - -int -TclCompileVariableCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - Tcl_Token *varTokenPtr, *valueTokenPtr; - int localIndex, numWords, i; - DefineLineInformation; /* TIP #280 */ - - numWords = parsePtr->numWords; - if (numWords < 2) { - return TCL_ERROR; - } - - /* - * Bail out if not compiling a proc body - */ - - if (envPtr->procPtr == NULL) { - return TCL_ERROR; - } - - /* - * Loop over the (var, value) pairs. - */ - - valueTokenPtr = parsePtr->tokenPtr; - for (i=1; i<numWords; i+=2) { - varTokenPtr = TokenAfter(valueTokenPtr); - valueTokenPtr = TokenAfter(varTokenPtr); - - localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr); - - if (localIndex < 0) { - return TCL_ERROR; - } - - CompileWord(envPtr, varTokenPtr, interp, i); - TclEmitInstInt4( INST_VARIABLE, localIndex, envPtr); - - if (i+1 < numWords) { - /* - * A value has been given: set the variable, pop the value - */ - - CompileWord(envPtr, valueTokenPtr, interp, i+1); - Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); - } - } - - /* - * Set the result to empty - */ - - PushLiteral(envPtr, "", 0); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * IndexTailVarIfKnown -- - * - * Procedure used in compiling [global] and [variable] commands. It - * inspects the variable name described by varTokenPtr and, if the tail - * is known at compile time, defines a corresponding local variable. - * - * Results: - * Returns the variable's index in the table of compiled locals if the - * tail is known at compile time, or -1 otherwise. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -IndexTailVarIfKnown( - Tcl_Interp *interp, - Tcl_Token *varTokenPtr, /* Token representing the variable name */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - Tcl_Obj *tailPtr; - const char *tailName, *p; - int len, n = varTokenPtr->numComponents; - Tcl_Token *lastTokenPtr; - int full, localIndex; - - /* - * Determine if the tail is (a) known at compile time, and (b) not an - * array element. Should any of these fail, return an error so that the - * non-compiled command will be called at runtime. - * - * In order for the tail to be known at compile time, the last token in - * the word has to be constant and contain "::" if it is not the only one. - */ - - if (!EnvHasLVT(envPtr)) { - return -1; - } - - TclNewObj(tailPtr); - if (TclWordKnownAtCompileTime(varTokenPtr, tailPtr)) { - full = 1; - lastTokenPtr = varTokenPtr; - } else { - full = 0; - lastTokenPtr = varTokenPtr + n; - if (!TclWordKnownAtCompileTime(lastTokenPtr, tailPtr)) { - Tcl_DecrRefCount(tailPtr); - return -1; - } - } - - tailName = TclGetStringFromObj(tailPtr, &len); - - if (len) { - if (*(tailName+len-1) == ')') { - /* - * Possible array: bail out - */ - - Tcl_DecrRefCount(tailPtr); - return -1; - } - - /* - * Get the tail: immediately after the last '::' - */ - - for (p = tailName + len -1; p > tailName; p--) { - if ((*p == ':') && (*(p-1) == ':')) { - p++; - break; - } - } - if (!full && (p == tailName)) { - /* - * No :: in the last component. - */ - - Tcl_DecrRefCount(tailPtr); - return -1; - } - len -= p - tailName; - tailName = p; - } - - localIndex = TclFindCompiledLocal(tailName, len, 1, envPtr); - Tcl_DecrRefCount(tailPtr); - return localIndex; -} - -/* - * Compilations of commands relating to TclOO. - */ - -int -TclCompileObjectNextCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - DefineLineInformation; /* TIP #280 */ - Tcl_Token *tokenPtr = parsePtr->tokenPtr; - int i; - - if (parsePtr->numWords > 255) { - return TCL_ERROR; - } - - for (i=0 ; i<parsePtr->numWords ; i++) { - CompileWord(envPtr, tokenPtr, interp, i); - tokenPtr = TokenAfter(tokenPtr); - } - TclEmitInstInt1( INST_TCLOO_NEXT, i, envPtr); - return TCL_OK; -} - -int -TclCompileObjectSelfCmd( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - /* - * We only handle [self] and [self object] (which is the same operation). - * These are the only very common operations on [self] for which - * bytecoding is at all reasonable. - */ - - if (parsePtr->numWords == 1) { - goto compileSelfObject; - } else if (parsePtr->numWords == 2) { - Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr), *subcmd; - - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size==0) { - return TCL_ERROR; - } - - subcmd = tokenPtr + 1; - if (strncmp(subcmd->start, "object", subcmd->size) == 0) { - goto compileSelfObject; - } else if (strncmp(subcmd->start, "namespace", subcmd->size) == 0) { - goto compileSelfNamespace; - } - } - - /* - * Can't compile; handle with runtime call. - */ - - return TCL_ERROR; - - compileSelfObject: - - /* - * This delegates the entire problem to a single opcode. - */ - - TclEmitOpcode( INST_TCLOO_SELF, envPtr); - return TCL_OK; - - compileSelfNamespace: - - /* - * This is formally only correct with TclOO methods as they are currently - * implemented; it assumes that the current namespace is invariably when a - * TclOO context is present is the object's namespace, and that's - * technically only something that's a matter of current policy. But it - * avoids creating another opcode, so that's all good! - */ - - TclEmitOpcode( INST_TCLOO_SELF, envPtr); - TclEmitOpcode( INST_POP, envPtr); - TclEmitOpcode( INST_NS_CURRENT, envPtr); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * PushVarName -- + * TclPushVarName -- * * Procedure used in the compiling where pushing a variable name is * necessary (append, lappend, set). * * Results: - * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer - * evaluation to runtime. + * The values written to *localIndexPtr and *isScalarPtr signal to + * the caller what the instructions emitted by this routine will do: + * + * *isScalarPtr (*localIndexPtr < 0) + * 1 1 Push the varname on the stack. (Stack +1) + * 1 0 *localIndexPtr is the index of the compiled + * local for this varname. No instructions + * emitted. (Stack +0) + * 0 1 Push part1 and part2 names of array element + * on the stack. (Stack +2) + * 0 0 *localIndexPtr is the index of the compiled + * local for this array. Element name is pushed + * on the stack. (Stack +1) * * Side effects: - * Instructions are added to envPtr to execute the "set" command at - * runtime. + * Instructions are added to envPtr. * *---------------------------------------------------------------------- */ -static int -PushVarName( +void +TclPushVarName( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Token *varTokenPtr, /* Points to a variable token. */ CompileEnv *envPtr, /* Holds resulting instructions. */ - int flags, /* TCL_NO_LARGE_INDEX. */ + int flags, /* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */ int *localIndexPtr, /* Must not be NULL. */ - int *simpleVarNamePtr, /* Must not be NULL. */ - int *isScalarPtr, /* Must not be NULL. */ - int line, /* Line the token starts on. */ - int *clNext) /* Reference to offset of next hidden cont. - * line. */ + int *isScalarPtr) /* Must not be NULL. */ { register const char *p; const char *name, *elName; @@ -6201,8 +3317,7 @@ PushVarName( */ if (!hasNsQualifiers) { - localIndex = TclFindCompiledLocal(name, nameChars, - 1, envPtr); + localIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr); if ((flags & TCL_NO_LARGE_INDEX) && (localIndex > 255)) { /* * We'll push the name. @@ -6216,17 +3331,16 @@ PushVarName( } /* - * Compile the element script, if any. + * Compile the element script, if any, and only if not inhibited. [Bug + * 3600328] */ - if (elName != NULL) { + if (elName != NULL && !(flags & TCL_NO_ELEMENT)) { if (elNameChars) { - envPtr->line = line; - envPtr->clNext = clNext; TclCompileTokens(interp, elemTokenPtr, elemTokenCount, envPtr); } else { - PushLiteral(envPtr, "", 0); + PushStringLiteral(envPtr, ""); } } } else { @@ -6234,8 +3348,6 @@ PushVarName( * The var name isn't simple: compile and push it. */ - envPtr->line = line; - envPtr->clNext = clNext; CompileTokens(envPtr, varTokenPtr, interp); } @@ -6246,9 +3358,7 @@ PushVarName( TclStackFree(interp, elemTokenPtr); } *localIndexPtr = localIndex; - *simpleVarNamePtr = simpleVarName; *isScalarPtr = (elName == NULL); - return TCL_OK; } /* diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c new file mode 100644 index 0000000..b8a7e0f --- /dev/null +++ b/generic/tclCompCmdsGR.c @@ -0,0 +1,3146 @@ +/* + * tclCompCmdsGR.c -- + * + * This file contains compilation procedures that compile various Tcl + * commands (beginning with the letters 'g' through 'r') into a sequence + * of instructions ("bytecodes"). + * + * Copyright (c) 1997-1998 Sun Microsystems, Inc. + * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. + * Copyright (c) 2002 ActiveState Corporation. + * Copyright (c) 2004-2013 by Donal K. Fellows. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "tclInt.h" +#include "tclCompile.h" +#include <assert.h> + +/* + * Prototypes for procedures defined later in this file: + */ + +static void CompileReturnInternal(CompileEnv *envPtr, + unsigned char op, int code, int level, + Tcl_Obj *returnOpts); +static int IndexTailVarIfKnown(Tcl_Interp *interp, + Tcl_Token *varTokenPtr, CompileEnv *envPtr); + +#define INDEX_END (-2) + +/* + *---------------------------------------------------------------------- + * + * GetIndexFromToken -- + * + * Parse a token and get the encoded version of the index (as understood + * by TEBC), assuming it is at all knowable at compile time. Only handles + * indices that are integers or 'end' or 'end-integer'. + * + * Returns: + * TCL_OK if parsing succeeded, and TCL_ERROR if it failed. + * + * Side effects: + * Sets *index to the index value if successful. + * + *---------------------------------------------------------------------- + */ + +static inline int +GetIndexFromToken( + Tcl_Token *tokenPtr, + int *index) +{ + Tcl_Obj *tmpObj = Tcl_NewObj(); + int result, idx; + + if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) { + Tcl_DecrRefCount(tmpObj); + return TCL_ERROR; + } + + result = TclGetIntFromObj(NULL, tmpObj, &idx); + if (result == TCL_OK) { + if (idx < 0) { + result = TCL_ERROR; + } + } else { + result = TclGetIntForIndexM(NULL, tmpObj, INDEX_END, &idx); + if (result == TCL_OK && idx > INDEX_END) { + result = TCL_ERROR; + } + } + Tcl_DecrRefCount(tmpObj); + + if (result == TCL_OK) { + *index = idx; + } + + return result; +} + +/* + *---------------------------------------------------------------------- + * + * TclCompileGlobalCmd -- + * + * Procedure called to compile the "global" command. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "global" command at + * runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileGlobalCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + Tcl_Token *varTokenPtr; + int localIndex, numWords, i; + DefineLineInformation; /* TIP #280 */ + + /* TODO: Consider support for compiling expanded args. */ + numWords = parsePtr->numWords; + if (numWords < 2) { + return TCL_ERROR; + } + + /* + * 'global' has no effect outside of proc bodies; handle that at runtime + */ + + if (envPtr->procPtr == NULL) { + return TCL_ERROR; + } + + /* + * Push the namespace + */ + + PushStringLiteral(envPtr, "::"); + + /* + * Loop over the variables. + */ + + varTokenPtr = TokenAfter(parsePtr->tokenPtr); + for (i=1; i<numWords; varTokenPtr = TokenAfter(varTokenPtr),i++) { + localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr); + + if (localIndex < 0) { + return TCL_ERROR; + } + + /* TODO: Consider what value can pass throug the + * IndexTailVarIfKnown() screen. Full CompileWord() + * likely does not apply here. Push known value instead. */ + CompileWord(envPtr, varTokenPtr, interp, i); + TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr); + } + + /* + * Pop the namespace, and set the result to empty + */ + + TclEmitOpcode( INST_POP, envPtr); + PushStringLiteral(envPtr, ""); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclCompileIfCmd -- + * + * Procedure called to compile the "if" command. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "if" command at + * runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileIfCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + JumpFixupArray jumpFalseFixupArray; + /* Used to fix the ifFalse jump after each + * test when its target PC is determined. */ + JumpFixupArray jumpEndFixupArray; + /* Used to fix the jump after each "then" body + * to the end of the "if" when that PC is + * determined. */ + Tcl_Token *tokenPtr, *testTokenPtr; + int jumpIndex = 0; /* Avoid compiler warning. */ + int jumpFalseDist, numWords, wordIdx, numBytes, j, code; + const char *word; + int realCond = 1; /* Set to 0 for static conditions: + * "if 0 {..}" */ + int boolVal; /* Value of static condition. */ + int compileScripts = 1; + DefineLineInformation; /* TIP #280 */ + + /* + * Only compile the "if" command if all arguments are simple words, in + * order to insure correct substitution [Bug 219166] + */ + + tokenPtr = parsePtr->tokenPtr; + wordIdx = 0; + numWords = parsePtr->numWords; + + for (wordIdx = 0; wordIdx < numWords; wordIdx++) { + if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + return TCL_ERROR; + } + tokenPtr = TokenAfter(tokenPtr); + } + + TclInitJumpFixupArray(&jumpFalseFixupArray); + TclInitJumpFixupArray(&jumpEndFixupArray); + code = TCL_OK; + + /* + * Each iteration of this loop compiles one "if expr ?then? body" or + * "elseif expr ?then? body" clause. + */ + + tokenPtr = parsePtr->tokenPtr; + wordIdx = 0; + while (wordIdx < numWords) { + /* + * Stop looping if the token isn't "if" or "elseif". + */ + + word = tokenPtr[1].start; + numBytes = tokenPtr[1].size; + if ((tokenPtr == parsePtr->tokenPtr) + || ((numBytes == 6) && (strncmp(word, "elseif", 6) == 0))) { + tokenPtr = TokenAfter(tokenPtr); + wordIdx++; + } else { + break; + } + if (wordIdx >= numWords) { + code = TCL_ERROR; + goto done; + } + + /* + * Compile the test expression then emit the conditional jump around + * the "then" part. + */ + + testTokenPtr = tokenPtr; + + if (realCond) { + /* + * Find out if the condition is a constant. + */ + + Tcl_Obj *boolObj = Tcl_NewStringObj(testTokenPtr[1].start, + testTokenPtr[1].size); + + Tcl_IncrRefCount(boolObj); + code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal); + TclDecrRefCount(boolObj); + if (code == TCL_OK) { + /* + * A static condition. + */ + + realCond = 0; + if (!boolVal) { + compileScripts = 0; + } + } else { + SetLineInformation(wordIdx); + Tcl_ResetResult(interp); + TclCompileExprWords(interp, testTokenPtr, 1, envPtr); + TclClearNumConversion(envPtr); + if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) { + TclExpandJumpFixupArray(&jumpFalseFixupArray); + } + jumpIndex = jumpFalseFixupArray.next; + jumpFalseFixupArray.next++; + TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, + jumpFalseFixupArray.fixup+jumpIndex); + } + code = TCL_OK; + } + + /* + * Skip over the optional "then" before the then clause. + */ + + tokenPtr = TokenAfter(testTokenPtr); + wordIdx++; + if (wordIdx >= numWords) { + code = TCL_ERROR; + goto done; + } + if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { + word = tokenPtr[1].start; + numBytes = tokenPtr[1].size; + if ((numBytes == 4) && (strncmp(word, "then", 4) == 0)) { + tokenPtr = TokenAfter(tokenPtr); + wordIdx++; + if (wordIdx >= numWords) { + code = TCL_ERROR; + goto done; + } + } + } + + /* + * Compile the "then" command body. + */ + + if (compileScripts) { + BODY(tokenPtr, wordIdx); + } + + if (realCond) { + /* + * Jump to the end of the "if" command. Both jumpFalseFixupArray + * and jumpEndFixupArray are indexed by "jumpIndex". + */ + + if (jumpEndFixupArray.next >= jumpEndFixupArray.end) { + TclExpandJumpFixupArray(&jumpEndFixupArray); + } + jumpEndFixupArray.next++; + TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, + jumpEndFixupArray.fixup+jumpIndex); + + /* + * Fix the target of the jumpFalse after the test. Generate a 4 + * byte jump if the distance is > 120 bytes. This is conservative, + * and ensures that we won't have to replace this jump if we later + * also need to replace the proceeding jump to the end of the "if" + * with a 4 byte jump. + */ + + TclAdjustStackDepth(-1, envPtr); + if (TclFixupForwardJumpToHere(envPtr, + jumpFalseFixupArray.fixup+jumpIndex, 120)) { + /* + * Adjust the code offset for the proceeding jump to the end + * of the "if" command. + */ + + jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3; + } + } else if (boolVal) { + /* + * We were processing an "if 1 {...}"; stop compiling scripts. + */ + + compileScripts = 0; + } else { + /* + * We were processing an "if 0 {...}"; reset so that the rest + * (elseif, else) is compiled correctly. + */ + + realCond = 1; + compileScripts = 1; + } + + tokenPtr = TokenAfter(tokenPtr); + wordIdx++; + } + + /* + * Check for the optional else clause. Do not compile anything if this was + * an "if 1 {...}" case. + */ + + if ((wordIdx < numWords) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) { + /* + * There is an else clause. Skip over the optional "else" word. + */ + + word = tokenPtr[1].start; + numBytes = tokenPtr[1].size; + if ((numBytes == 4) && (strncmp(word, "else", 4) == 0)) { + tokenPtr = TokenAfter(tokenPtr); + wordIdx++; + if (wordIdx >= numWords) { + code = TCL_ERROR; + goto done; + } + } + + if (compileScripts) { + /* + * Compile the else command body. + */ + + BODY(tokenPtr, wordIdx); + } + + /* + * Make sure there are no words after the else clause. + */ + + wordIdx++; + if (wordIdx < numWords) { + code = TCL_ERROR; + goto done; + } + } else { + /* + * No else clause: the "if" command's result is an empty string. + */ + + if (compileScripts) { + PushStringLiteral(envPtr, ""); + } + } + + /* + * Fix the unconditional jumps to the end of the "if" command. + */ + + for (j = jumpEndFixupArray.next; j > 0; j--) { + jumpIndex = (j - 1); /* i.e. process the closest jump first. */ + if (TclFixupForwardJumpToHere(envPtr, + jumpEndFixupArray.fixup+jumpIndex, 127)) { + /* + * Adjust the immediately preceeding "ifFalse" jump. We moved it's + * target (just after this jump) down three bytes. + */ + + unsigned char *ifFalsePc = envPtr->codeStart + + jumpFalseFixupArray.fixup[jumpIndex].codeOffset; + unsigned char opCode = *ifFalsePc; + + if (opCode == INST_JUMP_FALSE1) { + jumpFalseDist = TclGetInt1AtPtr(ifFalsePc + 1); + jumpFalseDist += 3; + TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1)); + } else if (opCode == INST_JUMP_FALSE4) { + jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1); + jumpFalseDist += 3; + TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1)); + } else { + Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%d\" updating ifFalse jump", (int) opCode); + } + } + } + + /* + * Free the jumpFixupArray array if malloc'ed storage was used. + */ + + done: + TclFreeJumpFixupArray(&jumpFalseFixupArray); + TclFreeJumpFixupArray(&jumpEndFixupArray); + return code; +} + +/* + *---------------------------------------------------------------------- + * + * TclCompileIncrCmd -- + * + * Procedure called to compile the "incr" command. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "incr" command at + * runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileIncrCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + Tcl_Token *varTokenPtr, *incrTokenPtr; + int isScalar, localIndex, haveImmValue, immValue; + DefineLineInformation; /* TIP #280 */ + + if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) { + return TCL_ERROR; + } + + varTokenPtr = TokenAfter(parsePtr->tokenPtr); + + PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX, + &localIndex, &isScalar, 1); + + /* + * If an increment is given, push it, but see first if it's a small + * integer. + */ + + haveImmValue = 0; + immValue = 1; + if (parsePtr->numWords == 3) { + incrTokenPtr = TokenAfter(varTokenPtr); + if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { + const char *word = incrTokenPtr[1].start; + int numBytes = incrTokenPtr[1].size; + int code; + Tcl_Obj *intObj = Tcl_NewStringObj(word, numBytes); + + Tcl_IncrRefCount(intObj); + code = TclGetIntFromObj(NULL, intObj, &immValue); + TclDecrRefCount(intObj); + if ((code == TCL_OK) && (-127 <= immValue) && (immValue <= 127)) { + haveImmValue = 1; + } + if (!haveImmValue) { + PushLiteral(envPtr, word, numBytes); + } + } else { + SetLineInformation(2); + CompileTokens(envPtr, incrTokenPtr, interp); + TclClearNumConversion(envPtr); + } + } else { /* No incr amount given so use 1. */ + haveImmValue = 1; + } + + /* + * Emit the instruction to increment the variable. + */ + + if (isScalar) { /* Simple scalar variable. */ + if (localIndex >= 0) { + if (haveImmValue) { + TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr); + TclEmitInt1(immValue, envPtr); + } else { + TclEmitInstInt1(INST_INCR_SCALAR1, localIndex, envPtr); + } + } else { + if (haveImmValue) { + TclEmitInstInt1(INST_INCR_STK_IMM, immValue, envPtr); + } else { + TclEmitOpcode( INST_INCR_STK, envPtr); + } + } + } else { /* Simple array variable. */ + if (localIndex >= 0) { + if (haveImmValue) { + TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex, envPtr); + TclEmitInt1(immValue, envPtr); + } else { + TclEmitInstInt1(INST_INCR_ARRAY1, localIndex, envPtr); + } + } else { + if (haveImmValue) { + TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr); + } else { + TclEmitOpcode( INST_INCR_ARRAY_STK, envPtr); + } + } + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclCompileInfo*Cmd -- + * + * Procedures called to compile "info" subcommands. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "info" subcommand at + * runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileInfoCommandsCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr; + Tcl_Obj *objPtr; + char *bytes; + + /* + * We require one compile-time known argument for the case we can compile. + */ + + if (parsePtr->numWords == 1) { + return TclCompileBasic0ArgCmd(interp, parsePtr, cmdPtr, envPtr); + } else if (parsePtr->numWords != 2) { + return TCL_ERROR; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + objPtr = Tcl_NewObj(); + Tcl_IncrRefCount(objPtr); + if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) { + goto notCompilable; + } + bytes = Tcl_GetString(objPtr); + + /* + * We require that the argument start with "::" and not have any of "*\[?" + * in it. (Theoretically, we should look in only the final component, but + * the difference is so slight given current naming practices.) + */ + + if (bytes[0] != ':' || bytes[1] != ':' || !TclMatchIsTrivial(bytes)) { + goto notCompilable; + } + Tcl_DecrRefCount(objPtr); + + /* + * Confirmed as a literal that will not frighten the horses. Compile. Note + * that the result needs to be list-ified. + */ + + /* TODO: Just push the known value */ + CompileWord(envPtr, tokenPtr, interp, 1); + TclEmitOpcode( INST_RESOLVE_COMMAND, envPtr); + TclEmitOpcode( INST_DUP, envPtr); + TclEmitOpcode( INST_STR_LEN, envPtr); + TclEmitInstInt1( INST_JUMP_FALSE1, 7, envPtr); + TclEmitInstInt4( INST_LIST, 1, envPtr); + return TCL_OK; + + notCompilable: + Tcl_DecrRefCount(objPtr); + return TclCompileBasic1ArgCmd(interp, parsePtr, cmdPtr, envPtr); +} + +int +TclCompileInfoCoroutineCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + /* + * Only compile [info coroutine] without arguments. + */ + + if (parsePtr->numWords != 1) { + return TCL_ERROR; + } + + /* + * Not much to do; we compile to a single instruction... + */ + + TclEmitOpcode( INST_COROUTINE_NAME, envPtr); + return TCL_OK; +} + +int +TclCompileInfoExistsCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + Tcl_Token *tokenPtr; + int isScalar, localIndex; + DefineLineInformation; /* TIP #280 */ + + if (parsePtr->numWords != 2) { + return TCL_ERROR; + } + + /* + * Decide if we can use a frame slot for the var/array name or if we need + * to emit code to compute and push the name at runtime. We use a frame + * slot (entry in the array of local vars) if we are compiling a procedure + * body and if the name is simple text that does not include namespace + * qualifiers. + */ + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex, &isScalar, 1); + + /* + * Emit instruction to check the variable for existence. + */ + + if (isScalar) { + if (localIndex < 0) { + TclEmitOpcode( INST_EXIST_STK, envPtr); + } else { + TclEmitInstInt4( INST_EXIST_SCALAR, localIndex, envPtr); + } + } else { + if (localIndex < 0) { + TclEmitOpcode( INST_EXIST_ARRAY_STK, envPtr); + } else { + TclEmitInstInt4( INST_EXIST_ARRAY, localIndex, envPtr); + } + } + + return TCL_OK; +} + +int +TclCompileInfoLevelCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + /* + * Only compile [info level] without arguments or with a single argument. + */ + + if (parsePtr->numWords == 1) { + /* + * Not much to do; we compile to a single instruction... + */ + + TclEmitOpcode( INST_INFO_LEVEL_NUM, envPtr); + } else if (parsePtr->numWords != 2) { + return TCL_ERROR; + } else { + DefineLineInformation; /* TIP #280 */ + + /* + * Compile the argument, then add the instruction to convert it into a + * list of arguments. + */ + + CompileWord(envPtr, TokenAfter(parsePtr->tokenPtr), interp, 1); + TclEmitOpcode( INST_INFO_LEVEL_ARGS, envPtr); + } + return TCL_OK; +} + +int +TclCompileInfoObjectClassCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); + + if (parsePtr->numWords != 2) { + return TCL_ERROR; + } + CompileWord(envPtr, tokenPtr, interp, 1); + TclEmitOpcode( INST_TCLOO_CLASS, envPtr); + return TCL_OK; +} + +int +TclCompileInfoObjectIsACmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); + + /* + * We only handle [info object isa object <somevalue>]. The first three + * words are compressed to a single token by the ensemble compilation + * engine. + */ + + if (parsePtr->numWords != 3) { + return TCL_ERROR; + } + if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size < 1 + || strncmp(tokenPtr[1].start, "object", tokenPtr[1].size)) { + return TCL_ERROR; + } + tokenPtr = TokenAfter(tokenPtr); + + /* + * Issue the code. + */ + + CompileWord(envPtr, tokenPtr, interp, 2); + TclEmitOpcode( INST_TCLOO_IS_OBJECT, envPtr); + return TCL_OK; +} + +int +TclCompileInfoObjectNamespaceCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); + + if (parsePtr->numWords != 2) { + return TCL_ERROR; + } + CompileWord(envPtr, tokenPtr, interp, 1); + TclEmitOpcode( INST_TCLOO_NS, envPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclCompileLappendCmd -- + * + * Procedure called to compile the "lappend" command. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "lappend" command at + * runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileLappendCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + Tcl_Token *varTokenPtr, *valueTokenPtr; + int isScalar, localIndex, numWords, i, fwd, offsetFwd; + DefineLineInformation; /* TIP #280 */ + + /* + * If we're not in a procedure, don't compile. + */ + + if (envPtr->procPtr == NULL) { + return TCL_ERROR; + } + + /* TODO: Consider support for compiling expanded args. */ + numWords = parsePtr->numWords; + if (numWords == 1) { + return TCL_ERROR; + } + if (numWords != 3) { + /* + * LAPPEND instructions currently only handle one value, but we can + * handle some multi-value cases by stringing them together. + */ + + goto lappendMultiple; + } + + /* + * Decide if we can use a frame slot for the var/array name or if we + * need to emit code to compute and push the name at runtime. We use a + * frame slot (entry in the array of local vars) if we are compiling a + * procedure body and if the name is simple text that does not include + * namespace qualifiers. + */ + + varTokenPtr = TokenAfter(parsePtr->tokenPtr); + + PushVarNameWord(interp, varTokenPtr, envPtr, 0, + &localIndex, &isScalar, 1); + + /* + * If we are doing an assignment, push the new value. In the no values + * case, create an empty object. + */ + + if (numWords > 2) { + Tcl_Token *valueTokenPtr = TokenAfter(varTokenPtr); + + CompileWord(envPtr, valueTokenPtr, interp, 2); + } + + /* + * Emit instructions to set/get the variable. + */ + + /* + * The *_STK opcodes should be refactored to make better use of existing + * LOAD/STORE instructions. + */ + + if (isScalar) { + if (localIndex < 0) { + TclEmitOpcode( INST_LAPPEND_STK, envPtr); + } else { + Emit14Inst( INST_LAPPEND_SCALAR, localIndex, envPtr); + } + } else { + if (localIndex < 0) { + TclEmitOpcode( INST_LAPPEND_ARRAY_STK, envPtr); + } else { + Emit14Inst( INST_LAPPEND_ARRAY, localIndex, envPtr); + } + } + + return TCL_OK; + + lappendMultiple: + /* + * Can only handle the case where we are appending to a local scalar when + * there are multiple values to append. Fortunately, this is common. + */ + + if (envPtr->procPtr == NULL) { + return TCL_ERROR; + } + varTokenPtr = TokenAfter(parsePtr->tokenPtr); + PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT, + &localIndex, &isScalar, 1); + if (!isScalar || localIndex < 0) { + return TCL_ERROR; + } + + /* + * Definitely appending to a local scalar; generate the words and append + * them. + */ + + valueTokenPtr = TokenAfter(varTokenPtr); + for (i = 2 ; i < numWords ; i++) { + CompileWord(envPtr, valueTokenPtr, interp, i); + valueTokenPtr = TokenAfter(valueTokenPtr); + } + TclEmitInstInt4( INST_LIST, numWords-2, envPtr); + TclEmitInstInt4( INST_EXIST_SCALAR, localIndex, envPtr); + offsetFwd = CurrentOffset(envPtr); + TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr); + Emit14Inst( INST_LOAD_SCALAR, localIndex, envPtr); + TclEmitInstInt4( INST_REVERSE, 2, envPtr); + TclEmitOpcode( INST_LIST_CONCAT, envPtr); + fwd = CurrentOffset(envPtr) - offsetFwd; + TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1); + Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclCompileLassignCmd -- + * + * Procedure called to compile the "lassign" command. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "lassign" command at + * runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileLassignCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + Tcl_Token *tokenPtr; + int isScalar, localIndex, numWords, idx; + DefineLineInformation; /* TIP #280 */ + + numWords = parsePtr->numWords; + + /* + * Check for command syntax error, but we'll punt that to runtime. + */ + + if (numWords < 3) { + return TCL_ERROR; + } + + /* + * Generate code to push list being taken apart by [lassign]. + */ + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 1); + + /* + * Generate code to assign values from the list to variables. + */ + + for (idx=0 ; idx<numWords-2 ; idx++) { + tokenPtr = TokenAfter(tokenPtr); + + /* + * Generate the next variable name. + */ + + PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex, + &isScalar, idx+2); + + /* + * Emit instructions to get the idx'th item out of the list value on + * the stack and assign it to the variable. + */ + + if (isScalar) { + if (localIndex >= 0) { + TclEmitOpcode( INST_DUP, envPtr); + TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr); + Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr); + TclEmitOpcode( INST_POP, envPtr); + } else { + TclEmitInstInt4(INST_OVER, 1, envPtr); + TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr); + TclEmitOpcode( INST_STORE_STK, envPtr); + TclEmitOpcode( INST_POP, envPtr); + } + } else { + if (localIndex >= 0) { + TclEmitInstInt4(INST_OVER, 1, envPtr); + TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr); + Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr); + TclEmitOpcode( INST_POP, envPtr); + } else { + TclEmitInstInt4(INST_OVER, 2, envPtr); + TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr); + TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr); + TclEmitOpcode( INST_POP, envPtr); + } + } + } + + /* + * Generate code to leave the rest of the list on the stack. + */ + + TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr); + TclEmitInt4( INDEX_END, envPtr); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclCompileLindexCmd -- + * + * Procedure called to compile the "lindex" command. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "lindex" command at + * runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileLindexCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + Tcl_Token *idxTokenPtr, *valTokenPtr; + int i, idx, numWords = parsePtr->numWords; + DefineLineInformation; /* TIP #280 */ + + /* + * Quit if too few args. + */ + + /* TODO: Consider support for compiling expanded args. */ + if (numWords <= 1) { + return TCL_ERROR; + } + + valTokenPtr = TokenAfter(parsePtr->tokenPtr); + if (numWords != 3) { + goto emitComplexLindex; + } + + idxTokenPtr = TokenAfter(valTokenPtr); + if (GetIndexFromToken(idxTokenPtr, &idx) == TCL_OK) { + /* + * All checks have been completed, and we have exactly one of these + * constructs: + * lindex <arbitraryValue> <posInt> + * lindex <arbitraryValue> end-<posInt> + * This is best compiled as a push of the arbitrary value followed by + * an "immediate lindex" which is the most efficient variety. + */ + + CompileWord(envPtr, valTokenPtr, interp, 1); + TclEmitInstInt4( INST_LIST_INDEX_IMM, idx, envPtr); + return TCL_OK; + } + + /* + * If the value was not known at compile time, the conversion failed or + * the value was negative, we just keep on going with the more complex + * compilation. + */ + + /* + * Push the operands onto the stack. + */ + + emitComplexLindex: + for (i=1 ; i<numWords ; i++) { + CompileWord(envPtr, valTokenPtr, interp, i); + valTokenPtr = TokenAfter(valTokenPtr); + } + + /* + * Emit INST_LIST_INDEX if objc==3, or INST_LIST_INDEX_MULTI if there are + * multiple index args. + */ + + if (numWords == 3) { + TclEmitOpcode( INST_LIST_INDEX, envPtr); + } else { + TclEmitInstInt4( INST_LIST_INDEX_MULTI, numWords-1, envPtr); + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclCompileListCmd -- + * + * Procedure called to compile the "list" command. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "list" command at + * runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileListCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Token *valueTokenPtr; + int i, numWords, concat, build; + Tcl_Obj *listObj, *objPtr; + + if (parsePtr->numWords == 1) { + /* + * [list] without arguments just pushes an empty object. + */ + + PushStringLiteral(envPtr, ""); + return TCL_OK; + } + + /* + * Test if all arguments are compile-time known. If they are, we can + * implement with a simple push. + */ + + numWords = parsePtr->numWords; + valueTokenPtr = TokenAfter(parsePtr->tokenPtr); + listObj = Tcl_NewObj(); + for (i = 1; i < numWords && listObj != NULL; i++) { + objPtr = Tcl_NewObj(); + if (TclWordKnownAtCompileTime(valueTokenPtr, objPtr)) { + (void) Tcl_ListObjAppendElement(NULL, listObj, objPtr); + } else { + Tcl_DecrRefCount(objPtr); + Tcl_DecrRefCount(listObj); + listObj = NULL; + } + valueTokenPtr = TokenAfter(valueTokenPtr); + } + if (listObj != NULL) { + int len; + const char *bytes = Tcl_GetStringFromObj(listObj, &len); + + PushLiteral(envPtr, bytes, len); + Tcl_DecrRefCount(listObj); + if (len > 0) { + /* + * Force list interpretation! + */ + + TclEmitOpcode( INST_DUP, envPtr); + TclEmitOpcode( INST_LIST_LENGTH, envPtr); + TclEmitOpcode( INST_POP, envPtr); + } + return TCL_OK; + } + + /* + * Push the all values onto the stack. + */ + + numWords = parsePtr->numWords; + valueTokenPtr = TokenAfter(parsePtr->tokenPtr); + concat = build = 0; + for (i = 1; i < numWords; i++) { + if (valueTokenPtr->type == TCL_TOKEN_EXPAND_WORD && build > 0) { + TclEmitInstInt4( INST_LIST, build, envPtr); + if (concat) { + TclEmitOpcode( INST_LIST_CONCAT, envPtr); + } + build = 0; + concat = 1; + } + CompileWord(envPtr, valueTokenPtr, interp, i); + if (valueTokenPtr->type == TCL_TOKEN_EXPAND_WORD) { + if (concat) { + TclEmitOpcode( INST_LIST_CONCAT, envPtr); + } else { + concat = 1; + } + } else { + build++; + } + valueTokenPtr = TokenAfter(valueTokenPtr); + } + if (build > 0) { + TclEmitInstInt4( INST_LIST, build, envPtr); + if (concat) { + TclEmitOpcode( INST_LIST_CONCAT, envPtr); + } + } + + /* + * If there was just one expanded word, we must ensure that it is a list + * at this point. We use an [lrange ... 0 end] for this (instead of + * [llength], as with literals) as we must drop any string representation + * that might be hanging around. + */ + + if (concat && numWords == 2) { + TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr); + TclEmitInt4( INDEX_END, envPtr); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclCompileLlengthCmd -- + * + * Procedure called to compile the "llength" command. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "llength" command at + * runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileLlengthCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + Tcl_Token *varTokenPtr; + DefineLineInformation; /* TIP #280 */ + + if (parsePtr->numWords != 2) { + return TCL_ERROR; + } + varTokenPtr = TokenAfter(parsePtr->tokenPtr); + + CompileWord(envPtr, varTokenPtr, interp, 1); + TclEmitOpcode( INST_LIST_LENGTH, envPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclCompileLrangeCmd -- + * + * How to compile the "lrange" command. We only bother because we needed + * the opcode anyway for "lassign". + * + *---------------------------------------------------------------------- + */ + +int +TclCompileLrangeCmd( + Tcl_Interp *interp, /* Tcl interpreter for context. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the + * command. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds the resulting instructions. */ +{ + Tcl_Token *tokenPtr, *listTokenPtr; + DefineLineInformation; /* TIP #280 */ + int idx1, idx2; + + if (parsePtr->numWords != 4) { + return TCL_ERROR; + } + listTokenPtr = TokenAfter(parsePtr->tokenPtr); + + /* + * Parse the indices. Will only compile if both are constants and not an + * _integer_ less than zero (since we reserve negative indices here for + * end-relative indexing) or an end-based index greater than 'end' itself. + */ + + tokenPtr = TokenAfter(listTokenPtr); + if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) { + return TCL_ERROR; + } + + tokenPtr = TokenAfter(tokenPtr); + if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) { + return TCL_ERROR; + } + + /* + * Issue instructions. It's not safe to skip doing the LIST_RANGE, as + * we've not proved that the 'list' argument is really a list. Not that it + * is worth trying to do that given current knowledge. + */ + + CompileWord(envPtr, listTokenPtr, interp, 1); + TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr); + TclEmitInt4( idx2, envPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclCompileLinsertCmd -- + * + * How to compile the "linsert" command. We only bother with the case + * where the index is constant. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileLinsertCmd( + Tcl_Interp *interp, /* Tcl interpreter for context. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the + * command. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds the resulting instructions. */ +{ + Tcl_Token *tokenPtr, *listTokenPtr; + DefineLineInformation; /* TIP #280 */ + int idx, i; + + if (parsePtr->numWords < 3) { + return TCL_ERROR; + } + listTokenPtr = TokenAfter(parsePtr->tokenPtr); + + /* + * Parse the index. Will only compile if it is constant and not an + * _integer_ less than zero (since we reserve negative indices here for + * end-relative indexing) or an end-based index greater than 'end' itself. + */ + + tokenPtr = TokenAfter(listTokenPtr); + if (GetIndexFromToken(tokenPtr, &idx) != TCL_OK) { + return TCL_ERROR; + } + + /* + * There are four main cases. If there are no values to insert, this is + * just a confirm-listiness check. If the index is '0', this is a prepend. + * If the index is 'end' (== INDEX_END), this is an append. Otherwise, + * this is a splice (== split, insert values as list, concat-3). + */ + + CompileWord(envPtr, listTokenPtr, interp, 1); + if (parsePtr->numWords == 3) { + TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr); + TclEmitInt4( INDEX_END, envPtr); + return TCL_OK; + } + + for (i=3 ; i<parsePtr->numWords ; i++) { + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, i); + } + TclEmitInstInt4( INST_LIST, i-3, envPtr); + + if (idx == 0 /*start*/) { + TclEmitInstInt4( INST_REVERSE, 2, envPtr); + TclEmitOpcode( INST_LIST_CONCAT, envPtr); + } else if (idx == INDEX_END /*end*/) { + TclEmitOpcode( INST_LIST_CONCAT, envPtr); + } else { + if (idx < 0) { + idx++; + } + TclEmitInstInt4( INST_OVER, 1, envPtr); + TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr); + TclEmitInt4( idx-1, envPtr); + TclEmitInstInt4( INST_REVERSE, 3, envPtr); + TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr); + TclEmitInt4( INDEX_END, envPtr); + TclEmitOpcode( INST_LIST_CONCAT, envPtr); + TclEmitOpcode( INST_LIST_CONCAT, envPtr); + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclCompileLreplaceCmd -- + * + * How to compile the "lreplace" command. We only bother with the case + * where the indices are constant. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileLreplaceCmd( + Tcl_Interp *interp, /* Tcl interpreter for context. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the + * command. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds the resulting instructions. */ +{ + Tcl_Token *tokenPtr, *listTokenPtr; + DefineLineInformation; /* TIP #280 */ + Tcl_Obj *tmpObj; + int idx1, idx2, i, offset; + + if (parsePtr->numWords < 4) { + return TCL_ERROR; + } + listTokenPtr = TokenAfter(parsePtr->tokenPtr); + + /* + * Parse the indices. Will only compile if both are constants and not an + * _integer_ less than zero (since we reserve negative indices here for + * end-relative indexing) or an end-based index greater than 'end' itself. + */ + + tokenPtr = TokenAfter(listTokenPtr); + if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) { + return TCL_ERROR; + } + + tokenPtr = TokenAfter(tokenPtr); + if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) { + return TCL_ERROR; + } + + /* + * Work out what this [lreplace] is actually doing. + */ + + tmpObj = NULL; + CompileWord(envPtr, listTokenPtr, interp, 1); + if (parsePtr->numWords == 4) { + if (idx1 == 0) { + if (idx2 == INDEX_END) { + goto dropAll; + } + idx1 = idx2 + 1; + idx2 = INDEX_END; + goto dropEnd; + } else if (idx2 == INDEX_END) { + idx2 = idx1 - 1; + idx1 = 0; + goto dropEnd; + } else { + if (idx1 > 0) { + tmpObj = Tcl_NewIntObj(idx1); + Tcl_IncrRefCount(tmpObj); + } + goto dropRange; + } + } + + tokenPtr = TokenAfter(tokenPtr); + for (i=4 ; i<parsePtr->numWords ; i++) { + CompileWord(envPtr, tokenPtr, interp, i); + tokenPtr = TokenAfter(tokenPtr); + } + TclEmitInstInt4( INST_LIST, i - 4, envPtr); + TclEmitInstInt4( INST_REVERSE, 2, envPtr); + if (idx1 == 0) { + if (idx2 == INDEX_END) { + goto replaceAll; + } + idx1 = idx2 + 1; + idx2 = INDEX_END; + goto replaceHead; + } else if (idx2 == INDEX_END) { + idx2 = idx1 - 1; + idx1 = 0; + goto replaceTail; + } else { + if (idx1 > 0 && idx2 > 0 && idx2 < idx1) { + idx2 = idx1 - 1; + } else if (idx1 < 0 && idx2 < 0 && idx2 < idx1) { + idx2 = idx1 - 1; + } + if (idx1 > 0) { + tmpObj = Tcl_NewIntObj(idx1); + Tcl_IncrRefCount(tmpObj); + } + goto replaceRange; + } + + /* + * Issue instructions to perform the operations relating to configurations + * that just drop. The only argument pushed on the stack is the list to + * operate on. + */ + + dropAll: + TclEmitOpcode( INST_LIST_LENGTH, envPtr); + TclEmitOpcode( INST_POP, envPtr); + PushStringLiteral(envPtr, ""); + goto done; + + dropEnd: + TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr); + TclEmitInt4( idx2, envPtr); + goto done; + + dropRange: + if (tmpObj != NULL) { + TclEmitOpcode( INST_DUP, envPtr); + TclEmitOpcode( INST_LIST_LENGTH, envPtr); + TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL), envPtr); + TclEmitOpcode( INST_GT, envPtr); + offset = CurrentOffset(envPtr); + TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr); + TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf( + "list doesn't contain element %d", idx1), NULL), envPtr); + CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0, + Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}")); + TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset, + envPtr->codeStart + offset + 1); + TclAdjustStackDepth(-1, envPtr); + } + TclEmitOpcode( INST_DUP, envPtr); + TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr); + TclEmitInt4( idx1 - 1, envPtr); + TclEmitInstInt4( INST_REVERSE, 2, envPtr); + TclEmitInstInt4( INST_LIST_RANGE_IMM, idx2 + 1, envPtr); + TclEmitInt4( INDEX_END, envPtr); + TclEmitOpcode( INST_LIST_CONCAT, envPtr); + goto done; + + /* + * Issue instructions to perform the operations relating to configurations + * that do real replacement. All arguments are pushed and assembled into a + * pair: the list of values to replace with, and the list to do the + * surgery on. + */ + + replaceAll: + TclEmitOpcode( INST_LIST_LENGTH, envPtr); + TclEmitOpcode( INST_POP, envPtr); + goto done; + + replaceHead: + TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr); + TclEmitInt4( idx2, envPtr); + TclEmitOpcode( INST_LIST_CONCAT, envPtr); + goto done; + + replaceTail: + TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr); + TclEmitInt4( idx2, envPtr); + TclEmitInstInt4( INST_REVERSE, 2, envPtr); + TclEmitOpcode( INST_LIST_CONCAT, envPtr); + goto done; + + replaceRange: + if (tmpObj != NULL) { + TclEmitOpcode( INST_DUP, envPtr); + TclEmitOpcode( INST_LIST_LENGTH, envPtr); + TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL), envPtr); + TclEmitOpcode( INST_GT, envPtr); + offset = CurrentOffset(envPtr); + TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr); + TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf( + "list doesn't contain element %d", idx1), NULL), envPtr); + CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0, + Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}")); + TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset, + envPtr->codeStart + offset + 1); + TclAdjustStackDepth(-1, envPtr); + } + TclEmitOpcode( INST_DUP, envPtr); + TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr); + TclEmitInt4( idx1 - 1, envPtr); + TclEmitInstInt4( INST_REVERSE, 2, envPtr); + TclEmitInstInt4( INST_LIST_RANGE_IMM, idx2 + 1, envPtr); + TclEmitInt4( INDEX_END, envPtr); + TclEmitInstInt4( INST_REVERSE, 3, envPtr); + TclEmitOpcode( INST_LIST_CONCAT, envPtr); + TclEmitInstInt4( INST_REVERSE, 2, envPtr); + TclEmitOpcode( INST_LIST_CONCAT, envPtr); + goto done; + + /* + * Clean up the allocated memory. + */ + + done: + if (tmpObj != NULL) { + Tcl_DecrRefCount(tmpObj); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclCompileLsetCmd -- + * + * Procedure called to compile the "lset" command. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "lset" command at + * runtime. + * + * The general template for execution of the "lset" command is: + * (1) Instructions to push the variable name, unless the variable is + * local to the stack frame. + * (2) If the variable is an array element, instructions to push the + * array element name. + * (3) Instructions to push each of zero or more "index" arguments to the + * stack, followed with the "newValue" element. + * (4) Instructions to duplicate the variable name and/or array element + * name onto the top of the stack, if either was pushed at steps (1) + * and (2). + * (5) The appropriate INST_LOAD_* instruction to place the original + * value of the list variable at top of stack. + * (6) At this point, the stack contains: + * varName? arrayElementName? index1 index2 ... newValue oldList + * The compiler emits one of INST_LSET_FLAT or INST_LSET_LIST + * according as whether there is exactly one index element (LIST) or + * either zero or else two or more (FLAT). This instruction removes + * everything from the stack except for the two names and pushes the + * new value of the variable. + * (7) Finally, INST_STORE_* stores the new value in the variable and + * cleans up the stack. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileLsetCmd( + Tcl_Interp *interp, /* Tcl interpreter for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the + * command. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds the resulting instructions. */ +{ + int tempDepth; /* Depth used for emitting one part of the + * code burst. */ + Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the + * parse of the variable name. */ + int localIndex; /* Index of var in local var table. */ + int isScalar; /* Flag == 1 if scalar, 0 if array. */ + int i; + DefineLineInformation; /* TIP #280 */ + + /* + * Check argument count. + */ + + /* TODO: Consider support for compiling expanded args. */ + if (parsePtr->numWords < 3) { + /* + * Fail at run time, not in compilation. + */ + + return TCL_ERROR; + } + + /* + * Decide if we can use a frame slot for the var/array name or if we need + * to emit code to compute and push the name at runtime. We use a frame + * slot (entry in the array of local vars) if we are compiling a procedure + * body and if the name is simple text that does not include namespace + * qualifiers. + */ + + varTokenPtr = TokenAfter(parsePtr->tokenPtr); + PushVarNameWord(interp, varTokenPtr, envPtr, 0, + &localIndex, &isScalar, 1); + + /* + * Push the "index" args and the new element value. + */ + + for (i=2 ; i<parsePtr->numWords ; ++i) { + varTokenPtr = TokenAfter(varTokenPtr); + CompileWord(envPtr, varTokenPtr, interp, i); + } + + /* + * Duplicate the variable name if it's been pushed. + */ + + if (localIndex < 0) { + if (isScalar) { + tempDepth = parsePtr->numWords - 2; + } else { + tempDepth = parsePtr->numWords - 1; + } + TclEmitInstInt4( INST_OVER, tempDepth, envPtr); + } + + /* + * Duplicate an array index if one's been pushed. + */ + + if (!isScalar) { + if (localIndex < 0) { + tempDepth = parsePtr->numWords - 1; + } else { + tempDepth = parsePtr->numWords - 2; + } + TclEmitInstInt4( INST_OVER, tempDepth, envPtr); + } + + /* + * Emit code to load the variable's value. + */ + + if (isScalar) { + if (localIndex < 0) { + TclEmitOpcode( INST_LOAD_STK, envPtr); + } else { + Emit14Inst( INST_LOAD_SCALAR, localIndex, envPtr); + } + } else { + if (localIndex < 0) { + TclEmitOpcode( INST_LOAD_ARRAY_STK, envPtr); + } else { + Emit14Inst( INST_LOAD_ARRAY, localIndex, envPtr); + } + } + + /* + * Emit the correct variety of 'lset' instruction. + */ + + if (parsePtr->numWords == 4) { + TclEmitOpcode( INST_LSET_LIST, envPtr); + } else { + TclEmitInstInt4( INST_LSET_FLAT, parsePtr->numWords-1, envPtr); + } + + /* + * Emit code to put the value back in the variable. + */ + + if (isScalar) { + if (localIndex < 0) { + TclEmitOpcode( INST_STORE_STK, envPtr); + } else { + Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr); + } + } else { + if (localIndex < 0) { + TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr); + } else { + Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr); + } + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclCompileNamespace*Cmd -- + * + * Procedures called to compile the "namespace" command; currently, only + * the subcommands "namespace current" and "namespace upvar" are compiled + * to bytecodes, and the latter only inside a procedure(-like) context. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "namespace upvar" + * command at runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileNamespaceCurrentCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + /* + * Only compile [namespace current] without arguments. + */ + + if (parsePtr->numWords != 1) { + return TCL_ERROR; + } + + /* + * Not much to do; we compile to a single instruction... + */ + + TclEmitOpcode( INST_NS_CURRENT, envPtr); + return TCL_OK; +} + +int +TclCompileNamespaceCodeCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + Tcl_Token *tokenPtr; + DefineLineInformation; /* TIP #280 */ + + if (parsePtr->numWords != 2) { + return TCL_ERROR; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + + /* + * The specification of [namespace code] is rather shocking, in that it is + * supposed to check if the argument is itself the result of [namespace + * code] and not apply itself in that case. Which is excessively cautious, + * but what the test suite checks for. + */ + + if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || (tokenPtr[1].size > 20 + && strncmp(tokenPtr[1].start, "::namespace inscope ", 20) == 0)) { + /* + * Technically, we could just pass a literal '::namespace inscope ' + * term through, but that's something which really shouldn't be + * occurring as something that the user writes so we'll just punt it. + */ + + return TCL_ERROR; + } + + /* + * Now we can compile using the same strategy as [namespace code]'s normal + * implementation does internally. Note that we can't bind the namespace + * name directly here, because TclOO plays complex games with namespaces; + * the value needs to be determined at runtime for safety. + */ + + PushStringLiteral(envPtr, "::namespace"); + PushStringLiteral(envPtr, "inscope"); + TclEmitOpcode( INST_NS_CURRENT, envPtr); + CompileWord(envPtr, tokenPtr, interp, 1); + TclEmitInstInt4( INST_LIST, 4, envPtr); + return TCL_OK; +} + +int +TclCompileNamespaceOriginCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + Tcl_Token *tokenPtr; + DefineLineInformation; /* TIP #280 */ + + if (parsePtr->numWords != 2) { + return TCL_ERROR; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + + CompileWord(envPtr, tokenPtr, interp, 1); + TclEmitOpcode( INST_ORIGIN_COMMAND, envPtr); + return TCL_OK; +} + +int +TclCompileNamespaceQualifiersCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); + DefineLineInformation; /* TIP #280 */ + int off; + + if (parsePtr->numWords != 2) { + return TCL_ERROR; + } + + CompileWord(envPtr, tokenPtr, interp, 1); + PushStringLiteral(envPtr, "0"); + PushStringLiteral(envPtr, "::"); + TclEmitInstInt4( INST_OVER, 2, envPtr); + TclEmitOpcode( INST_STR_FIND_LAST, envPtr); + off = CurrentOffset(envPtr); + PushStringLiteral(envPtr, "1"); + TclEmitOpcode( INST_SUB, envPtr); + TclEmitInstInt4( INST_OVER, 2, envPtr); + TclEmitInstInt4( INST_OVER, 1, envPtr); + TclEmitOpcode( INST_STR_INDEX, envPtr); + PushStringLiteral(envPtr, ":"); + TclEmitOpcode( INST_STR_EQ, envPtr); + off = off - CurrentOffset(envPtr); + TclEmitInstInt1( INST_JUMP_TRUE1, off, envPtr); + TclEmitOpcode( INST_STR_RANGE, envPtr); + return TCL_OK; +} + +int +TclCompileNamespaceTailCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); + DefineLineInformation; /* TIP #280 */ + JumpFixup jumpFixup; + + if (parsePtr->numWords != 2) { + return TCL_ERROR; + } + + /* + * Take care; only add 2 to found index if the string was actually found. + */ + + CompileWord(envPtr, tokenPtr, interp, 1); + PushStringLiteral(envPtr, "::"); + TclEmitInstInt4( INST_OVER, 1, envPtr); + TclEmitOpcode( INST_STR_FIND_LAST, envPtr); + TclEmitOpcode( INST_DUP, envPtr); + PushStringLiteral(envPtr, "0"); + TclEmitOpcode( INST_GE, envPtr); + TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFixup); + PushStringLiteral(envPtr, "2"); + TclEmitOpcode( INST_ADD, envPtr); + TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127); + PushStringLiteral(envPtr, "end"); + TclEmitOpcode( INST_STR_RANGE, envPtr); + return TCL_OK; +} + +int +TclCompileNamespaceUpvarCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr; + int isScalar, localIndex, numWords, i; + DefineLineInformation; /* TIP #280 */ + + if (envPtr->procPtr == NULL) { + return TCL_ERROR; + } + + /* + * Only compile [namespace upvar ...]: needs an even number of args, >=4 + */ + + numWords = parsePtr->numWords; + if ((numWords % 2) || (numWords < 4)) { + return TCL_ERROR; + } + + /* + * Push the namespace + */ + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 1); + + /* + * Loop over the (otherVar, thisVar) pairs. If any of the thisVar is not a + * local variable, return an error so that the non-compiled command will + * be called at runtime. + */ + + localTokenPtr = tokenPtr; + for (i=2; i<numWords; i+=2) { + otherTokenPtr = TokenAfter(localTokenPtr); + localTokenPtr = TokenAfter(otherTokenPtr); + + CompileWord(envPtr, otherTokenPtr, interp, i); + PushVarNameWord(interp, localTokenPtr, envPtr, 0, + &localIndex, &isScalar, i+1); + + if ((localIndex < 0) || !isScalar) { + return TCL_ERROR; + } + TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr); + } + + /* + * Pop the namespace, and set the result to empty + */ + + TclEmitOpcode( INST_POP, envPtr); + PushStringLiteral(envPtr, ""); + return TCL_OK; +} + +int +TclCompileNamespaceWhichCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr, *opt; + int idx; + + if (parsePtr->numWords < 2 || parsePtr->numWords > 3) { + return TCL_ERROR; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + idx = 1; + + /* + * If there's an option, check that it's "-command". We don't handle + * "-variable" (currently) and anything else is an error. + */ + + if (parsePtr->numWords == 3) { + if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + return TCL_ERROR; + } + opt = tokenPtr + 1; + if (opt->size < 2 || opt->size > 8 + || strncmp(opt->start, "-command", opt->size) != 0) { + return TCL_ERROR; + } + tokenPtr = TokenAfter(tokenPtr); + idx++; + } + + /* + * Issue the bytecode. + */ + + CompileWord(envPtr, tokenPtr, interp, idx); + TclEmitOpcode( INST_RESOLVE_COMMAND, envPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclCompileRegexpCmd -- + * + * Procedure called to compile the "regexp" command. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "regexp" command at + * runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileRegexpCmd( + Tcl_Interp *interp, /* Tcl interpreter for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the + * command. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds the resulting instructions. */ +{ + Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the + * parse of the RE or string. */ + int i, len, nocase, exact, sawLast, simple; + const char *str; + DefineLineInformation; /* TIP #280 */ + + /* + * We are only interested in compiling simple regexp cases. Currently + * supported compile cases are: + * regexp ?-nocase? ?--? staticString $var + * regexp ?-nocase? ?--? {^staticString$} $var + */ + + if (parsePtr->numWords < 3) { + return TCL_ERROR; + } + + simple = 0; + nocase = 0; + sawLast = 0; + varTokenPtr = parsePtr->tokenPtr; + + /* + * We only look for -nocase and -- as options. Everything else gets pushed + * to runtime execution. This is different than regexp's runtime option + * handling, but satisfies our stricter needs. + */ + + for (i = 1; i < parsePtr->numWords - 2; i++) { + varTokenPtr = TokenAfter(varTokenPtr); + if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + /* + * Not a simple string, so punt to runtime. + */ + + return TCL_ERROR; + } + str = varTokenPtr[1].start; + len = varTokenPtr[1].size; + if ((len == 2) && (str[0] == '-') && (str[1] == '-')) { + sawLast++; + i++; + break; + } else if ((len > 1) && (strncmp(str,"-nocase",(unsigned)len) == 0)) { + nocase = 1; + } else { + /* + * Not an option we recognize. + */ + + return TCL_ERROR; + } + } + + if ((parsePtr->numWords - i) != 2) { + /* + * We don't support capturing to variables. + */ + + return TCL_ERROR; + } + + /* + * Get the regexp string. If it is not a simple string or can't be + * converted to a glob pattern, push the word for the INST_REGEXP. + * Keep changes here in sync with TclCompileSwitchCmd Switch_Regexp. + */ + + varTokenPtr = TokenAfter(varTokenPtr); + + if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { + Tcl_DString ds; + + str = varTokenPtr[1].start; + len = varTokenPtr[1].size; + + /* + * If it has a '-', it could be an incorrectly formed regexp command. + */ + + if ((*str == '-') && !sawLast) { + return TCL_ERROR; + } + + if (len == 0) { + /* + * The semantics of regexp are always match on re == "". + */ + + PushStringLiteral(envPtr, "1"); + return TCL_OK; + } + + /* + * Attempt to convert pattern to glob. If successful, push the + * converted pattern as a literal. + */ + + if (TclReToGlob(NULL, varTokenPtr[1].start, len, &ds, &exact) + == TCL_OK) { + simple = 1; + PushLiteral(envPtr, Tcl_DStringValue(&ds),Tcl_DStringLength(&ds)); + Tcl_DStringFree(&ds); + } + } + + if (!simple) { + CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-2); + } + + /* + * Push the string arg. + */ + + varTokenPtr = TokenAfter(varTokenPtr); + CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-1); + + if (simple) { + if (exact && !nocase) { + TclEmitOpcode( INST_STR_EQ, envPtr); + } else { + TclEmitInstInt1( INST_STR_MATCH, nocase, envPtr); + } + } else { + /* + * Pass correct RE compile flags. We use only Int1 (8-bit), but + * that handles all the flags we want to pass. + * Don't use TCL_REG_NOSUB as we may have backrefs. + */ + + int cflags = TCL_REG_ADVANCED | (nocase ? TCL_REG_NOCASE : 0); + + TclEmitInstInt1( INST_REGEXP, cflags, envPtr); + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclCompileRegsubCmd -- + * + * Procedure called to compile the "regsub" command. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "regsub" command at + * runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileRegsubCmd( + Tcl_Interp *interp, /* Tcl interpreter for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the + * command. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds the resulting instructions. */ +{ + /* + * We only compile the case with [regsub -all] where the pattern is both + * known at compile time and simple (i.e., no RE metacharacters). That is, + * the pattern must be translatable into a glob like "*foo*" with no other + * glob metacharacters inside it; there must be some "foo" in there too. + * The substitution string must also be known at compile time and free of + * metacharacters ("\digit" and "&"). Finally, there must not be a + * variable mentioned in the [regsub] to write the result back to (because + * we can't get the count of substitutions that would be the result in + * that case). The key is that these are the conditions under which a + * [string map] could be used instead, in particular a [string map] of the + * form we can compile to bytecode. + * + * In short, we look for: + * + * regsub -all [--] simpleRE string simpleReplacement + * + * The only optional part is the "--", and no other options are handled. + */ + + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr, *stringTokenPtr; + Tcl_Obj *patternObj = NULL, *replacementObj = NULL; + Tcl_DString pattern; + const char *bytes; + int len, exact, result = TCL_ERROR; + + if (parsePtr->numWords < 5 || parsePtr->numWords > 6) { + return TCL_ERROR; + } + + /* + * Parse the "-all", which must be the first argument (other options not + * supported, non-"-all" substitution we can't compile). + */ + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size != 4 + || strncmp(tokenPtr[1].start, "-all", 4)) { + return TCL_ERROR; + } + + /* + * Get the pattern into patternObj, checking for "--" in the process. + */ + + Tcl_DStringInit(&pattern); + tokenPtr = TokenAfter(tokenPtr); + patternObj = Tcl_NewObj(); + if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) { + goto done; + } + if (Tcl_GetString(patternObj)[0] == '-') { + if (strcmp(Tcl_GetString(patternObj), "--") != 0 + || parsePtr->numWords == 5) { + goto done; + } + tokenPtr = TokenAfter(tokenPtr); + Tcl_DecrRefCount(patternObj); + patternObj = Tcl_NewObj(); + if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) { + goto done; + } + } else if (parsePtr->numWords == 6) { + goto done; + } + + /* + * Identify the code which produces the string to apply the substitution + * to (stringTokenPtr), and the replacement string (into replacementObj). + */ + + stringTokenPtr = TokenAfter(tokenPtr); + tokenPtr = TokenAfter(stringTokenPtr); + replacementObj = Tcl_NewObj(); + if (!TclWordKnownAtCompileTime(tokenPtr, replacementObj)) { + goto done; + } + + /* + * Next, higher-level checks. Is the RE a very simple glob? Is the + * replacement "simple"? + */ + + bytes = Tcl_GetStringFromObj(patternObj, &len); + if (TclReToGlob(NULL, bytes, len, &pattern, &exact) != TCL_OK || exact) { + goto done; + } + bytes = Tcl_DStringValue(&pattern); + if (*bytes++ != '*') { + goto done; + } + while (1) { + switch (*bytes) { + case '*': + if (bytes[1] == '\0') { + /* + * OK, we've proved there are no metacharacters except for the + * '*' at each end. + */ + + len = Tcl_DStringLength(&pattern) - 2; + if (len > 0) { + goto isSimpleGlob; + } + + /* + * The pattern is "**"! I believe that should be impossible, + * but we definitely can't handle that at all. + */ + } + case '\0': case '?': case '[': case '\\': + goto done; + } + bytes++; + } + isSimpleGlob: + for (bytes = Tcl_GetString(replacementObj); *bytes; bytes++) { + switch (*bytes) { + case '\\': case '&': + goto done; + } + } + + /* + * Proved the simplicity constraints! Time to issue the code. + */ + + result = TCL_OK; + bytes = Tcl_DStringValue(&pattern) + 1; + PushLiteral(envPtr, bytes, len); + bytes = Tcl_GetStringFromObj(replacementObj, &len); + PushLiteral(envPtr, bytes, len); + CompileWord(envPtr, stringTokenPtr, interp, parsePtr->numWords-2); + TclEmitOpcode( INST_STR_MAP, envPtr); + + done: + Tcl_DStringFree(&pattern); + if (patternObj) { + Tcl_DecrRefCount(patternObj); + } + if (replacementObj) { + Tcl_DecrRefCount(replacementObj); + } + return result; +} + +/* + *---------------------------------------------------------------------- + * + * TclCompileReturnCmd -- + * + * Procedure called to compile the "return" command. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "return" command at + * runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileReturnCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + /* + * General syntax: [return ?-option value ...? ?result?] + * An even number of words means an explicit result argument is present. + */ + int level, code, objc, size, status = TCL_OK; + int numWords = parsePtr->numWords; + int explicitResult = (0 == (numWords % 2)); + int numOptionWords = numWords - 1 - explicitResult; + Tcl_Obj *returnOpts, **objv; + Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr); + DefineLineInformation; /* TIP #280 */ + + /* + * Check for special case which can always be compiled: + * return -options <opts> <msg> + * Unlike the normal [return] compilation, this version does everything at + * runtime so it can handle arbitrary words and not just literals. Note + * that if INST_RETURN_STK wasn't already needed for something else + * ('finally' clause processing) this piece of code would not be present. + */ + + if ((numWords == 4) && (wordTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) + && (wordTokenPtr[1].size == 8) + && (strncmp(wordTokenPtr[1].start, "-options", 8) == 0)) { + Tcl_Token *optsTokenPtr = TokenAfter(wordTokenPtr); + Tcl_Token *msgTokenPtr = TokenAfter(optsTokenPtr); + + CompileWord(envPtr, optsTokenPtr, interp, 2); + CompileWord(envPtr, msgTokenPtr, interp, 3); + TclEmitInvoke(envPtr, INST_RETURN_STK); + return TCL_OK; + } + + /* + * Allocate some working space. + */ + + objv = TclStackAlloc(interp, numOptionWords * sizeof(Tcl_Obj *)); + + /* + * Scan through the return options. If any are unknown at compile time, + * there is no value in bytecompiling. Save the option values known in an + * objv array for merging into a return options dictionary. + * + * TODO: There is potential for improvement if all option keys are known + * at compile time and all option values relating to '-code' and '-level' + * are known at compile time. + */ + + for (objc = 0; objc < numOptionWords; objc++) { + objv[objc] = Tcl_NewObj(); + Tcl_IncrRefCount(objv[objc]); + if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) { + /* + * Non-literal, so punt to run-time assembly of the dictionary. + */ + + for (; objc>=0 ; objc--) { + TclDecrRefCount(objv[objc]); + } + TclStackFree(interp, objv); + goto issueRuntimeReturn; + } + wordTokenPtr = TokenAfter(wordTokenPtr); + } + status = TclMergeReturnOptions(interp, objc, objv, + &returnOpts, &code, &level); + while (--objc >= 0) { + TclDecrRefCount(objv[objc]); + } + TclStackFree(interp, objv); + if (TCL_ERROR == status) { + /* + * Something was bogus in the return options. Clear the error message, + * and report back to the compiler that this must be interpreted at + * runtime. + */ + + Tcl_ResetResult(interp); + return TCL_ERROR; + } + + /* + * All options are known at compile time, so we're going to bytecompile. + * Emit instructions to push the result on the stack. + */ + + if (explicitResult) { + CompileWord(envPtr, wordTokenPtr, interp, numWords-1); + } else { + /* + * No explict result argument, so default result is empty string. + */ + + PushStringLiteral(envPtr, ""); + } + + /* + * Check for optimization: When [return] is in a proc, and there's no + * enclosing [catch], and there are no return options, then the INST_DONE + * instruction is equivalent, and may be more efficient. + */ + + if (numOptionWords == 0 && envPtr->procPtr != NULL) { + /* + * We have default return options and we're in a proc ... + */ + + int index = envPtr->exceptArrayNext - 1; + int enclosingCatch = 0; + + while (index >= 0) { + ExceptionRange range = envPtr->exceptArrayPtr[index]; + + if ((range.type == CATCH_EXCEPTION_RANGE) + && (range.catchOffset == -1)) { + enclosingCatch = 1; + break; + } + index--; + } + if (!enclosingCatch) { + /* + * ... and there is no enclosing catch. Issue the maximally + * efficient exit instruction. + */ + + Tcl_DecrRefCount(returnOpts); + TclEmitOpcode(INST_DONE, envPtr); + TclAdjustStackDepth(1, envPtr); + return TCL_OK; + } + } + + /* Optimize [return -level 0 $x]. */ + Tcl_DictObjSize(NULL, returnOpts, &size); + if (size == 0 && level == 0 && code == TCL_OK) { + Tcl_DecrRefCount(returnOpts); + return TCL_OK; + } + + /* + * Could not use the optimization, so we push the return options dict, and + * emit the INST_RETURN_IMM instruction with code and level as operands. + */ + + CompileReturnInternal(envPtr, INST_RETURN_IMM, code, level, returnOpts); + return TCL_OK; + + issueRuntimeReturn: + /* + * Assemble the option dictionary (as a list as that's good enough). + */ + + wordTokenPtr = TokenAfter(parsePtr->tokenPtr); + for (objc=1 ; objc<=numOptionWords ; objc++) { + CompileWord(envPtr, wordTokenPtr, interp, objc); + wordTokenPtr = TokenAfter(wordTokenPtr); + } + TclEmitInstInt4(INST_LIST, numOptionWords, envPtr); + + /* + * Push the result. + */ + + if (explicitResult) { + CompileWord(envPtr, wordTokenPtr, interp, numWords-1); + } else { + PushStringLiteral(envPtr, ""); + } + + /* + * Issue the RETURN itself. + */ + + TclEmitInvoke(envPtr, INST_RETURN_STK); + return TCL_OK; +} + +static void +CompileReturnInternal( + CompileEnv *envPtr, + unsigned char op, + int code, + int level, + Tcl_Obj *returnOpts) +{ + if (level == 0 && (code == TCL_BREAK || code == TCL_CONTINUE)) { + ExceptionRange *rangePtr; + ExceptionAux *exceptAux; + + rangePtr = TclGetInnermostExceptionRange(envPtr, code, &exceptAux); + if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) { + TclCleanupStackForBreakContinue(envPtr, exceptAux); + if (code == TCL_BREAK) { + TclAddLoopBreakFixup(envPtr, exceptAux); + } else { + TclAddLoopContinueFixup(envPtr, exceptAux); + } + Tcl_DecrRefCount(returnOpts); + return; + } + } + + TclEmitPush(TclAddLiteralObj(envPtr, returnOpts, NULL), envPtr); + TclEmitInstInt4(op, code, envPtr); + TclEmitInt4(level, envPtr); +} + +void +TclCompileSyntaxError( + Tcl_Interp *interp, + CompileEnv *envPtr) +{ + Tcl_Obj *msg = Tcl_GetObjResult(interp); + int numBytes; + const char *bytes = TclGetStringFromObj(msg, &numBytes); + + TclErrorStackResetIf(interp, bytes, numBytes); + TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, numBytes), envPtr); + CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0, + TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR))); + Tcl_ResetResult(interp); +} + +/* + *---------------------------------------------------------------------- + * + * TclCompileUpvarCmd -- + * + * Procedure called to compile the "upvar" command. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "upvar" command at + * runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileUpvarCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr; + int isScalar, localIndex, numWords, i; + DefineLineInformation; /* TIP #280 */ + Tcl_Obj *objPtr; + + if (envPtr->procPtr == NULL) { + return TCL_ERROR; + } + + numWords = parsePtr->numWords; + if (numWords < 3) { + return TCL_ERROR; + } + + /* + * Push the frame index if it is known at compile time + */ + + objPtr = Tcl_NewObj(); + tokenPtr = TokenAfter(parsePtr->tokenPtr); + if (TclWordKnownAtCompileTime(tokenPtr, objPtr)) { + CallFrame *framePtr; + const Tcl_ObjType *newTypePtr, *typePtr = objPtr->typePtr; + + /* + * Attempt to convert to a level reference. Note that TclObjGetFrame + * only changes the obj type when a conversion was successful. + */ + + TclObjGetFrame(interp, objPtr, &framePtr); + newTypePtr = objPtr->typePtr; + Tcl_DecrRefCount(objPtr); + + if (newTypePtr != typePtr) { + if (numWords%2) { + return TCL_ERROR; + } + /* TODO: Push the known value instead? */ + CompileWord(envPtr, tokenPtr, interp, 1); + otherTokenPtr = TokenAfter(tokenPtr); + i = 2; + } else { + if (!(numWords%2)) { + return TCL_ERROR; + } + PushStringLiteral(envPtr, "1"); + otherTokenPtr = tokenPtr; + i = 1; + } + } else { + Tcl_DecrRefCount(objPtr); + return TCL_ERROR; + } + + /* + * Loop over the (otherVar, thisVar) pairs. If any of the thisVar is not a + * local variable, return an error so that the non-compiled command will + * be called at runtime. + */ + + for (; i<numWords; i+=2, otherTokenPtr = TokenAfter(localTokenPtr)) { + localTokenPtr = TokenAfter(otherTokenPtr); + + CompileWord(envPtr, otherTokenPtr, interp, i); + PushVarNameWord(interp, localTokenPtr, envPtr, 0, + &localIndex, &isScalar, i+1); + + if ((localIndex < 0) || !isScalar) { + return TCL_ERROR; + } + TclEmitInstInt4( INST_UPVAR, localIndex, envPtr); + } + + /* + * Pop the frame index, and set the result to empty + */ + + TclEmitOpcode( INST_POP, envPtr); + PushStringLiteral(envPtr, ""); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclCompileVariableCmd -- + * + * Procedure called to compile the "variable" command. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "variable" command at + * runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileVariableCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + Tcl_Token *varTokenPtr, *valueTokenPtr; + int localIndex, numWords, i; + DefineLineInformation; /* TIP #280 */ + + numWords = parsePtr->numWords; + if (numWords < 2) { + return TCL_ERROR; + } + + /* + * Bail out if not compiling a proc body + */ + + if (envPtr->procPtr == NULL) { + return TCL_ERROR; + } + + /* + * Loop over the (var, value) pairs. + */ + + valueTokenPtr = parsePtr->tokenPtr; + for (i=1; i<numWords; i+=2) { + varTokenPtr = TokenAfter(valueTokenPtr); + valueTokenPtr = TokenAfter(varTokenPtr); + + localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr); + + if (localIndex < 0) { + return TCL_ERROR; + } + + /* TODO: Consider what value can pass throug the + * IndexTailVarIfKnown() screen. Full CompileWord() + * likely does not apply here. Push known value instead. */ + CompileWord(envPtr, varTokenPtr, interp, i); + TclEmitInstInt4( INST_VARIABLE, localIndex, envPtr); + + if (i+1 < numWords) { + /* + * A value has been given: set the variable, pop the value + */ + + CompileWord(envPtr, valueTokenPtr, interp, i+1); + Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr); + TclEmitOpcode( INST_POP, envPtr); + } + } + + /* + * Set the result to empty + */ + + PushStringLiteral(envPtr, ""); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * IndexTailVarIfKnown -- + * + * Procedure used in compiling [global] and [variable] commands. It + * inspects the variable name described by varTokenPtr and, if the tail + * is known at compile time, defines a corresponding local variable. + * + * Results: + * Returns the variable's index in the table of compiled locals if the + * tail is known at compile time, or -1 otherwise. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +IndexTailVarIfKnown( + Tcl_Interp *interp, + Tcl_Token *varTokenPtr, /* Token representing the variable name */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + Tcl_Obj *tailPtr; + const char *tailName, *p; + int len, n = varTokenPtr->numComponents; + Tcl_Token *lastTokenPtr; + int full, localIndex; + + /* + * Determine if the tail is (a) known at compile time, and (b) not an + * array element. Should any of these fail, return an error so that the + * non-compiled command will be called at runtime. + * + * In order for the tail to be known at compile time, the last token in + * the word has to be constant and contain "::" if it is not the only one. + */ + + if (!EnvHasLVT(envPtr)) { + return -1; + } + + TclNewObj(tailPtr); + if (TclWordKnownAtCompileTime(varTokenPtr, tailPtr)) { + full = 1; + lastTokenPtr = varTokenPtr; + } else { + full = 0; + lastTokenPtr = varTokenPtr + n; + if (!TclWordKnownAtCompileTime(lastTokenPtr, tailPtr)) { + Tcl_DecrRefCount(tailPtr); + return -1; + } + } + + tailName = TclGetStringFromObj(tailPtr, &len); + + if (len) { + if (*(tailName+len-1) == ')') { + /* + * Possible array: bail out + */ + + Tcl_DecrRefCount(tailPtr); + return -1; + } + + /* + * Get the tail: immediately after the last '::' + */ + + for (p = tailName + len -1; p > tailName; p--) { + if ((*p == ':') && (*(p-1) == ':')) { + p++; + break; + } + } + if (!full && (p == tailName)) { + /* + * No :: in the last component. + */ + + Tcl_DecrRefCount(tailPtr); + return -1; + } + len -= p - tailName; + tailName = p; + } + + localIndex = TclFindCompiledLocal(tailName, len, 1, envPtr); + Tcl_DecrRefCount(tailPtr); + return localIndex; +} + +/* + * ---------------------------------------------------------------------- + * + * TclCompileObjectNextCmd, TclCompileObjectSelfCmd -- + * + * Compilations of the TclOO utility commands [next] and [self]. + * + * ---------------------------------------------------------------------- + */ + +int +TclCompileObjectNextCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr = parsePtr->tokenPtr; + int i; + + if (parsePtr->numWords > 255) { + return TCL_ERROR; + } + + for (i=0 ; i<parsePtr->numWords ; i++) { + CompileWord(envPtr, tokenPtr, interp, i); + tokenPtr = TokenAfter(tokenPtr); + } + TclEmitInstInt1( INST_TCLOO_NEXT, i, envPtr); + return TCL_OK; +} + +int +TclCompileObjectSelfCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + /* + * We only handle [self] and [self object] (which is the same operation). + * These are the only very common operations on [self] for which + * bytecoding is at all reasonable. + */ + + if (parsePtr->numWords == 1) { + goto compileSelfObject; + } else if (parsePtr->numWords == 2) { + Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr), *subcmd; + + if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size==0) { + return TCL_ERROR; + } + + subcmd = tokenPtr + 1; + if (strncmp(subcmd->start, "object", subcmd->size) == 0) { + goto compileSelfObject; + } else if (strncmp(subcmd->start, "namespace", subcmd->size) == 0) { + goto compileSelfNamespace; + } + } + + /* + * Can't compile; handle with runtime call. + */ + + return TCL_ERROR; + + compileSelfObject: + + /* + * This delegates the entire problem to a single opcode. + */ + + TclEmitOpcode( INST_TCLOO_SELF, envPtr); + return TCL_OK; + + compileSelfNamespace: + + /* + * This is formally only correct with TclOO methods as they are currently + * implemented; it assumes that the current namespace is invariably when a + * TclOO context is present is the object's namespace, and that's + * technically only something that's a matter of current policy. But it + * avoids creating another opcode, so that's all good! + */ + + TclEmitOpcode( INST_TCLOO_SELF, envPtr); + TclEmitOpcode( INST_POP, envPtr); + TclEmitOpcode( INST_NS_CURRENT, envPtr); + return TCL_OK; +} + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 7bead0d..c4af5ce 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -27,11 +27,6 @@ static void FreeJumptableInfo(ClientData clientData); static void PrintJumptableInfo(ClientData clientData, Tcl_Obj *appendObj, ByteCode *codePtr, unsigned int pcOffset); -static int PushVarName(Tcl_Interp *interp, - Tcl_Token *varTokenPtr, CompileEnv *envPtr, - int flags, int *localIndexPtr, - int *simpleVarNamePtr, int *isScalarPtr, - int line, int *clNext); static int CompileAssociativeBinaryOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, const char *identity, int instruction, CompileEnv *envPtr); @@ -45,75 +40,28 @@ static int CompileUnaryOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, int instruction, CompileEnv *envPtr); static void IssueSwitchChainedTests(Tcl_Interp *interp, - CompileEnv *envPtr, ExtCmdLoc *mapPtr, - int eclIndex, int mode, int noCase, - int valueIndex, Tcl_Token *valueTokenPtr, - int numWords, Tcl_Token **bodyToken, - int *bodyLines, int **bodyNext); -static void IssueSwitchJumpTable(Tcl_Interp *interp, - CompileEnv *envPtr, ExtCmdLoc *mapPtr, - int eclIndex, int valueIndex, - Tcl_Token *valueTokenPtr, int numWords, + CompileEnv *envPtr, int mode, int noCase, + int valueIndex, int numWords, Tcl_Token **bodyToken, int *bodyLines, - int **bodyContLines); -static int IssueTryFinallyInstructions(Tcl_Interp *interp, + int **bodyNext); +static void IssueSwitchJumpTable(Tcl_Interp *interp, + CompileEnv *envPtr, int valueIndex, + int numWords, Tcl_Token **bodyToken, + int *bodyLines, int **bodyContLines); +static int IssueTryClausesInstructions(Tcl_Interp *interp, CompileEnv *envPtr, Tcl_Token *bodyToken, int numHandlers, int *matchCodes, Tcl_Obj **matchClauses, int *resultVarIndices, - int *optionVarIndices, Tcl_Token **handlerTokens, - Tcl_Token *finallyToken); -static int IssueTryInstructions(Tcl_Interp *interp, + int *optionVarIndices, Tcl_Token **handlerTokens); +static int IssueTryClausesFinallyInstructions(Tcl_Interp *interp, CompileEnv *envPtr, Tcl_Token *bodyToken, int numHandlers, int *matchCodes, Tcl_Obj **matchClauses, int *resultVarIndices, - int *optionVarIndices, Tcl_Token **handlerTokens); - -/* - * Macro that encapsulates an efficiency trick that avoids a function call for - * the simplest of compiles. The ANSI C "prototype" for this macro is: - * - * static void CompileWord(CompileEnv *envPtr, Tcl_Token *tokenPtr, - * Tcl_Interp *interp, int word); - */ - -#define CompileWord(envPtr, tokenPtr, interp, word) \ - if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) { \ - TclEmitPush(TclRegisterNewLiteral((envPtr), (tokenPtr)[1].start, \ - (tokenPtr)[1].size), (envPtr)); \ - } else { \ - envPtr->line = mapPtr->loc[eclIndex].line[word]; \ - envPtr->clNext = mapPtr->loc[eclIndex].next[word]; \ - TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \ - (envPtr)); \ - } - -/* - * TIP #280: Remember the per-word line information of the current command. An - * index is used instead of a pointer as recursive compilation may reallocate, - * i.e. move, the array. This is also the reason to save the nuloc now, it may - * change during the course of the function. - * - * Macro to encapsulate the variable definition and setup. - */ - -#define DefineLineInformation \ - ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \ - int eclIndex = mapPtr->nuloc - 1 - -#define SetLineInformation(word) \ - envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \ - envPtr->clNext = mapPtr->loc[eclIndex].next[(word)] - -#define PushVarNameWord(i,v,e,f,l,s,sc,word) \ - PushVarName(i,v,e,f,l,s,sc, \ - mapPtr->loc[eclIndex].line[(word)], \ - mapPtr->loc[eclIndex].next[(word)]) - -/* - * Flags bits used by PushVarName. - */ - -#define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */ + int *optionVarIndices, Tcl_Token **handlerTokens, + Tcl_Token *finallyToken); +static int IssueTryFinallyInstructions(Tcl_Interp *interp, + CompileEnv *envPtr, Tcl_Token *bodyToken, + Tcl_Token *finallyToken); /* * The structures below define the AuxData types defined in this file. @@ -137,18 +85,75 @@ const AuxDataType tclJumptableInfoType = { TclEmitInstInt1(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr) #define OP44(name,val1,val2) \ TclEmitInstInt4(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr) -#define BODY(token,index) \ - SetLineInformation((index));CompileBody(envPtr,(token),interp) #define PUSH(str) \ - PushLiteral(envPtr,(str),strlen(str)) -#define JUMP(var,name) \ - (var) = CurrentOffset(envPtr);TclEmitInstInt4(INST_##name,0,envPtr) -#define FIXJUMP(var) \ + PushStringLiteral(envPtr, str) +#define JUMP4(name,var) \ + (var) = CurrentOffset(envPtr);TclEmitInstInt4(INST_##name##4,0,envPtr) +#define FIXJUMP4(var) \ TclStoreInt4AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1) +#define JUMP1(name,var) \ + (var) = CurrentOffset(envPtr);TclEmitInstInt1(INST_##name##1,0,envPtr) +#define FIXJUMP1(var) \ + TclStoreInt1AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1) #define LOAD(idx) \ if ((idx)<256) {OP1(LOAD_SCALAR1,(idx));} else {OP4(LOAD_SCALAR4,(idx));} #define STORE(idx) \ if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));} +#define INVOKE(name) \ + TclEmitInvoke(envPtr,INST_##name) + +#define INDEX_END (-2) + +/* + *---------------------------------------------------------------------- + * + * GetIndexFromToken -- + * + * Parse a token and get the encoded version of the index (as understood + * by TEBC), assuming it is at all knowable at compile time. Only handles + * indices that are integers or 'end' or 'end-integer'. + * + * Returns: + * TCL_OK if parsing succeeded, and TCL_ERROR if it failed. + * + * Side effects: + * Sets *index to the index value if successful. + * + *---------------------------------------------------------------------- + */ + +static inline int +GetIndexFromToken( + Tcl_Token *tokenPtr, + int *index) +{ + Tcl_Obj *tmpObj = Tcl_NewObj(); + int result, idx; + + if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) { + Tcl_DecrRefCount(tmpObj); + return TCL_ERROR; + } + + result = TclGetIntFromObj(NULL, tmpObj, &idx); + if (result == TCL_OK) { + if (idx < 0) { + result = TCL_ERROR; + } + } else { + result = TclGetIntForIndexM(NULL, tmpObj, INDEX_END, &idx); + if (result == TCL_OK && idx > INDEX_END) { + result = TCL_ERROR; + } + } + Tcl_DecrRefCount(tmpObj); + + if (result == TCL_OK) { + *index = idx; + } + + return result; +} /* *---------------------------------------------------------------------- @@ -178,7 +183,7 @@ TclCompileSetCmd( CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr, *valueTokenPtr; - int isAssignment, isScalar, simpleVarName, localIndex, numWords; + int isAssignment, isScalar, localIndex, numWords; DefineLineInformation; /* TIP #280 */ numWords = parsePtr->numWords; @@ -197,7 +202,7 @@ TclCompileSetCmd( varTokenPtr = TokenAfter(parsePtr->tokenPtr); PushVarNameWord(interp, varTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + &localIndex, &isScalar, 1); /* * If we are doing an assignment, push the new value. @@ -212,12 +217,10 @@ TclCompileSetCmd( * Emit instructions to set/get the variable. */ - if (simpleVarName) { if (isScalar) { if (localIndex < 0) { TclEmitOpcode((isAssignment? - INST_STORE_SCALAR_STK : INST_LOAD_SCALAR_STK), - envPtr); + INST_STORE_STK : INST_LOAD_STK), envPtr); } else if (localIndex <= 255) { TclEmitInstInt1((isAssignment? INST_STORE_SCALAR1 : INST_LOAD_SCALAR1), @@ -241,9 +244,6 @@ TclCompileSetCmd( localIndex, envPtr); } } - } else { - TclEmitOpcode((isAssignment? INST_STORE_STK : INST_LOAD_STK), envPtr); - } return TCL_OK; } @@ -448,7 +448,7 @@ TclCompileStringMatchCmd( if (parsePtr->numWords == 4) { if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; + return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } str = tokenPtr[1].start; length = tokenPtr[1].size; @@ -457,7 +457,7 @@ TclCompileStringMatchCmd( * Fail at run time, not in compilation. */ - return TCL_ERROR; + return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } nocase = 1; tokenPtr = TokenAfter(tokenPtr); @@ -578,13 +578,13 @@ TclCompileStringMapCmd( Tcl_IncrRefCount(mapObj); if (!TclWordKnownAtCompileTime(mapTokenPtr, mapObj)) { Tcl_DecrRefCount(mapObj); - return TCL_ERROR; + return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } else if (Tcl_ListObjGetElements(NULL, mapObj, &len, &objv) != TCL_OK) { Tcl_DecrRefCount(mapObj); - return TCL_ERROR; + return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } else if (len != 2) { Tcl_DecrRefCount(mapObj); - return TCL_ERROR; + return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* @@ -618,8 +618,7 @@ TclCompileStringRangeCmd( { DefineLineInformation; /* TIP #280 */ Tcl_Token *stringTokenPtr, *fromTokenPtr, *toTokenPtr; - Tcl_Obj *tmpObj; - int idx1, idx2, result; + int idx1, idx2; if (parsePtr->numWords != 4) { return TCL_ERROR; @@ -629,50 +628,13 @@ TclCompileStringRangeCmd( toTokenPtr = TokenAfter(fromTokenPtr); /* - * Parse the first index. Will only compile if it is constant and not an - * _integer_ less than zero (since we reserve negative indices here for - * end-relative indexing). + * Parse the two indices. */ - tmpObj = Tcl_NewObj(); - result = TCL_ERROR; - if (TclWordKnownAtCompileTime(fromTokenPtr, tmpObj)) { - if (TclGetIntFromObj(NULL, tmpObj, &idx1) == TCL_OK) { - if (idx1 >= 0) { - result = TCL_OK; - } - } else if (TclGetIntForIndexM(NULL, tmpObj, -2, &idx1) == TCL_OK) { - if (idx1 <= -2) { - result = TCL_OK; - } - } - } - TclDecrRefCount(tmpObj); - if (result != TCL_OK) { + if (GetIndexFromToken(fromTokenPtr, &idx1) != TCL_OK) { goto nonConstantIndices; } - - /* - * Parse the second index. Will only compile if it is constant and not an - * _integer_ less than zero (since we reserve negative indices here for - * end-relative indexing). - */ - - tmpObj = Tcl_NewObj(); - result = TCL_ERROR; - if (TclWordKnownAtCompileTime(toTokenPtr, tmpObj)) { - if (TclGetIntFromObj(NULL, tmpObj, &idx2) == TCL_OK) { - if (idx2 >= 0) { - result = TCL_OK; - } - } else if (TclGetIntForIndexM(NULL, tmpObj, -2, &idx2) == TCL_OK) { - if (idx2 <= -2) { - result = TCL_OK; - } - } - } - TclDecrRefCount(tmpObj); - if (result != TCL_OK) { + if (GetIndexFromToken(toTokenPtr, &idx2) != TCL_OK) { goto nonConstantIndices; } @@ -695,6 +657,316 @@ TclCompileStringRangeCmd( OP( STR_RANGE); return TCL_OK; } + +int +TclCompileStringReplaceCmd( + Tcl_Interp *interp, /* Tcl interpreter for context. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the + * command. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds the resulting instructions. */ +{ + Tcl_Token *tokenPtr, *valueTokenPtr, *replacementTokenPtr = NULL; + DefineLineInformation; /* TIP #280 */ + int idx1, idx2; + + if (parsePtr->numWords < 4 || parsePtr->numWords > 5) { + return TCL_ERROR; + } + valueTokenPtr = TokenAfter(parsePtr->tokenPtr); + if (parsePtr->numWords == 5) { + tokenPtr = TokenAfter(valueTokenPtr); + tokenPtr = TokenAfter(tokenPtr); + replacementTokenPtr = TokenAfter(tokenPtr); + } + + /* + * Parse the indices. Will only compile special cases if both are + * constants and not an _integer_ less than zero (since we reserve + * negative indices here for end-relative indexing) or an end-based index + * greater than 'end' itself. + */ + + tokenPtr = TokenAfter(valueTokenPtr); + if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) { + goto genericReplace; + } + + tokenPtr = TokenAfter(tokenPtr); + if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) { + goto genericReplace; + } + + /* + * We handle these replacements specially: first character (where + * idx1=idx2=0) and last character (where idx1=idx2=INDEX_END). Anything + * else and the semantics get rather screwy. + */ + + if (idx1 == 0 && idx2 == 0) { + int notEq, end; + + /* + * Just working with the first character. + */ + + CompileWord(envPtr, valueTokenPtr, interp, 1); + if (replacementTokenPtr == NULL) { + /* Drop first */ + OP44( STR_RANGE_IMM, 1, INDEX_END); + return TCL_OK; + } + /* Replace first */ + CompileWord(envPtr, replacementTokenPtr, interp, 4); + OP4( OVER, 1); + PUSH( ""); + OP( STR_EQ); + JUMP1( JUMP_FALSE, notEq); + OP( POP); + JUMP1( JUMP, end); + FIXJUMP1(notEq); + TclAdjustStackDepth(1, envPtr); + OP4( REVERSE, 2); + OP44( STR_RANGE_IMM, 1, INDEX_END); + OP1( STR_CONCAT1, 2); + FIXJUMP1(end); + return TCL_OK; + + } else if (idx1 == INDEX_END && idx2 == INDEX_END) { + int notEq, end; + + /* + * Just working with the last character. + */ + + CompileWord(envPtr, valueTokenPtr, interp, 1); + if (replacementTokenPtr == NULL) { + /* Drop last */ + OP44( STR_RANGE_IMM, 0, INDEX_END-1); + return TCL_OK; + } + /* Replace last */ + CompileWord(envPtr, replacementTokenPtr, interp, 4); + OP4( OVER, 1); + PUSH( ""); + OP( STR_EQ); + JUMP1( JUMP_FALSE, notEq); + OP( POP); + JUMP1( JUMP, end); + FIXJUMP1(notEq); + TclAdjustStackDepth(1, envPtr); + OP4( REVERSE, 2); + OP44( STR_RANGE_IMM, 0, INDEX_END-1); + OP4( REVERSE, 2); + OP1( STR_CONCAT1, 2); + FIXJUMP1(end); + return TCL_OK; + + } else { + /* + * Need to process indices at runtime. This could be because the + * indices are not constants, or because we need to resolve them to + * absolute indices to work out if a replacement is going to happen. + * In any case, to runtime it is. + */ + + genericReplace: + CompileWord(envPtr, valueTokenPtr, interp, 1); + tokenPtr = TokenAfter(valueTokenPtr); + CompileWord(envPtr, tokenPtr, interp, 2); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 3); + if (replacementTokenPtr != NULL) { + CompileWord(envPtr, replacementTokenPtr, interp, 4); + } else { + PUSH( ""); + } + OP( STR_REPLACE); + return TCL_OK; + } +} + +/* + * Synch with tclCmdMZ.c + */ + +#define DEFAULT_TRIM_SET \ + "\x09\x0a\x0b\x0c\x0d " /* ASCII */\ + "\xc0\x80" /* nul (U+0000) */\ + "\xc2\x85" /* next line (U+0085) */\ + "\xc2\xa0" /* non-breaking space (U+00a0) */\ + "\xe1\x9a\x80" /* ogham space mark (U+1680) */ \ + "\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */\ + "\xe2\x80\x80" /* en quad (U+2000) */\ + "\xe2\x80\x81" /* em quad (U+2001) */\ + "\xe2\x80\x82" /* en space (U+2002) */\ + "\xe2\x80\x83" /* em space (U+2003) */\ + "\xe2\x80\x84" /* three-per-em space (U+2004) */\ + "\xe2\x80\x85" /* four-per-em space (U+2005) */\ + "\xe2\x80\x86" /* six-per-em space (U+2006) */\ + "\xe2\x80\x87" /* figure space (U+2007) */\ + "\xe2\x80\x88" /* punctuation space (U+2008) */\ + "\xe2\x80\x89" /* thin space (U+2009) */\ + "\xe2\x80\x8a" /* hair space (U+200a) */\ + "\xe2\x80\x8b" /* zero width space (U+200b) */\ + "\xe2\x80\xa8" /* line separator (U+2028) */\ + "\xe2\x80\xa9" /* paragraph separator (U+2029) */\ + "\xe2\x80\xaf" /* narrow no-break space (U+202f) */\ + "\xe2\x81\x9f" /* medium mathematical space (U+205f) */\ + "\xe2\x81\xa0" /* word joiner (U+2060) */\ + "\xe3\x80\x80" /* ideographic space (U+3000) */\ + "\xef\xbb\xbf" /* zero width no-break space (U+feff) */ + +int +TclCompileStringTrimLCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords != 2 && parsePtr->numWords != 3) { + return TCL_ERROR; + } + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 1); + if (parsePtr->numWords == 3) { + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 2); + } else { + PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET)); + } + OP( STR_TRIM_LEFT); + return TCL_OK; +} + +int +TclCompileStringTrimRCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords != 2 && parsePtr->numWords != 3) { + return TCL_ERROR; + } + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 1); + if (parsePtr->numWords == 3) { + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 2); + } else { + PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET)); + } + OP( STR_TRIM_RIGHT); + return TCL_OK; +} + +int +TclCompileStringTrimCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords != 2 && parsePtr->numWords != 3) { + return TCL_ERROR; + } + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 1); + if (parsePtr->numWords == 3) { + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 2); + } else { + PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET)); + } + OP( STR_TRIM); + return TCL_OK; +} + +int +TclCompileStringToUpperCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords != 2) { + return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr); + } + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 1); + OP( STR_UPPER); + return TCL_OK; +} + +int +TclCompileStringToLowerCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords != 2) { + return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr); + } + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 1); + OP( STR_LOWER); + return TCL_OK; +} + +int +TclCompileStringToTitleCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords != 2) { + return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr); + } + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 1); + OP( STR_TITLE); + return TCL_OK; +} /* *---------------------------------------------------------------------- @@ -798,18 +1070,21 @@ TclSubstCompile( Tcl_InterpState state = NULL; TclSubstParse(interp, bytes, numBytes, flags, &parse, &state); + if (state != NULL) { + Tcl_ResetResult(interp); + } /* * Tricky point! If the first token does not result in a *guaranteed* push * of a Tcl_Obj on the stack, we must push an empty object. Otherwise it - * is possible to get to an INST_CONCAT1 or INST_DONE without enough + * is possible to get to an INST_STR_CONCAT1 or INST_DONE without enough * values on the stack, resulting in a crash. Thanks to Joe Mistachkin for * identifying a script that could trigger this case. */ tokenPtr = parse.tokenPtr; if (tokenPtr->type != TCL_TOKEN_TEXT && tokenPtr->type != TCL_TOKEN_BS) { - PushLiteral(envPtr, "", 0); + PUSH(""); count++; } @@ -867,11 +1142,11 @@ TclSubstCompile( } while (count > 255) { - OP1( CONCAT1, 255); + OP1( STR_CONCAT1, 255); count -= 254; } if (count > 1) { - OP1( CONCAT1, count); + OP1( STR_CONCAT1, count); count = 1; } @@ -891,7 +1166,7 @@ TclSubstCompile( } envPtr->line = bline; - catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); + catchRange = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); OP4( BEGIN_CATCH4, catchRange); ExceptionRangeStarts(envPtr, catchRange); @@ -915,6 +1190,7 @@ TclSubstCompile( /* Substitution produced TCL_OK */ OP( END_CATCH); TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &okFixup); + TclAdjustStackDepth(-1, envPtr); /* Exceptional return codes processed here */ ExceptionRangeTarget(envPtr, catchRange, catchOffset); @@ -924,7 +1200,7 @@ TclSubstCompile( OP( END_CATCH); OP( RETURN_CODE_BRANCH); - /* ERROR -> reraise it */ + /* ERROR -> reraise it; NB: can't require BREAK/CONTINUE handling */ OP( RETURN_STK); OP( NOP); @@ -940,6 +1216,7 @@ TclSubstCompile( /* OTHER */ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &otherFixup); + TclAdjustStackDepth(1, envPtr); /* BREAK destination */ if (TclFixupForwardJumpToHere(envPtr, &breakFixup, 127)) { Tcl_Panic("TclCompileSubstCmd: bad break jump distance %d", @@ -955,6 +1232,7 @@ TclSubstCompile( OP1(JUMP1, -breakJump); } + TclAdjustStackDepth(2, envPtr); /* CONTINUE destination */ if (TclFixupForwardJumpToHere(envPtr, &continueFixup, 127)) { Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %d", @@ -964,6 +1242,7 @@ TclSubstCompile( OP( POP); TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &endFixup); + TclAdjustStackDepth(2, envPtr); /* RETURN + other destination */ if (TclFixupForwardJumpToHere(envPtr, &returnFixup, 127)) { Tcl_Panic("TclCompileSubstCmd: bad return jump distance %d", @@ -981,24 +1260,13 @@ TclSubstCompile( OP4( REVERSE, 2); OP( POP); - /* - * We've emitted several POP instructions, and the automatic - * computations for stack depth requirements have been decrementing - * for every one. However, we know that every branch actually taken - * only encounters some of those instructions. No branch passes - * through them all. So, we now have a stack requirements estimate - * that is too low. Here we manually fix that up. - */ - - TclAdjustStackDepth(5, envPtr); - /* OK destination */ if (TclFixupForwardJumpToHere(envPtr, &okFixup, 127)) { Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %d", (int) (CurrentOffset(envPtr) - okFixup.codeOffset)); } if (count > 1) { - OP1(CONCAT1, count); + OP1(STR_CONCAT1, count); count = 1; } @@ -1011,11 +1279,11 @@ TclSubstCompile( } while (count > 255) { - OP1( CONCAT1, 255); + OP1( STR_CONCAT1, 255); count -= 254; } if (count > 1) { - OP1( CONCAT1, count); + OP1( STR_CONCAT1, count); } Tcl_FreeParse(&parse); @@ -1050,9 +1318,6 @@ TclSubstCompile( * Instructions are added to envPtr to execute the "switch" command at * runtime. * - * FIXME: - * Stack depths are probably not calculated correctly. - * *---------------------------------------------------------------------- */ @@ -1343,13 +1608,15 @@ TclCompileSwitchCmd( * but it handles the most common case well enough. */ + /* Both methods push the value to match against onto the stack. */ + CompileWord(envPtr, valueTokenPtr, interp, valueIndex); + if (mode == Switch_Exact) { - IssueSwitchJumpTable(interp, envPtr, mapPtr, eclIndex, valueIndex, - valueTokenPtr, numWords, bodyToken, bodyLines, bodyContLines); + IssueSwitchJumpTable(interp, envPtr, valueIndex, numWords, bodyToken, + bodyLines, bodyContLines); } else { - IssueSwitchChainedTests(interp, envPtr, mapPtr, eclIndex, mode,noCase, - valueIndex, valueTokenPtr, numWords, bodyToken, bodyLines, - bodyContLines); + IssueSwitchChainedTests(interp, envPtr, mode, noCase, valueIndex, + numWords, bodyToken, bodyLines, bodyContLines); } result = TCL_OK; @@ -1387,13 +1654,9 @@ static void IssueSwitchChainedTests( Tcl_Interp *interp, /* Context for compiling script bodies. */ CompileEnv *envPtr, /* Holds resulting instructions. */ - ExtCmdLoc *mapPtr, /* For mapping tokens to their source code - * location. */ - int eclIndex, int mode, /* Exact, Glob or Regexp */ int noCase, /* Case-insensitivity flag. */ int valueIndex, /* The value to match against. */ - Tcl_Token *valueTokenPtr, int numBodyTokens, /* Number of tokens describing things the * switch can match against and bodies to * execute when the match succeeds. */ @@ -1403,7 +1666,6 @@ IssueSwitchChainedTests( int **bodyContLines) /* Array of continuation line info. */ { enum {Switch_Exact, Switch_Glob, Switch_Regexp}; - int savedStackDepth = envPtr->currStackDepth; int foundDefault; /* Flag to indicate whether a "default" clause * is present. */ JumpFixup *fixupArray; /* Array of forward-jump fixup records. */ @@ -1419,13 +1681,6 @@ IssueSwitchChainedTests( int i; /* - * First, we push the value we're matching against on the stack. - */ - - SetLineInformation(valueIndex); - CompileTokens(envPtr, valueTokenPtr, interp); - - /* * Generate a test for each arm. */ @@ -1438,7 +1693,6 @@ IssueSwitchChainedTests( foundDefault = 0; for (i=0 ; i<numBodyTokens ; i+=2) { nextArmFixupIndex = -1; - envPtr->currStackDepth = savedStackDepth + 1; if (i!=numBodyTokens-2 || bodyToken[numBodyTokens-2]->size != 7 || memcmp(bodyToken[numBodyTokens-2]->start, "default", 7)) { /* @@ -1472,7 +1726,7 @@ IssueSwitchChainedTests( * when the RE == "". */ - PushLiteral(envPtr, "1", 1); + PUSH("1"); break; } @@ -1569,13 +1823,12 @@ IssueSwitchChainedTests( } /* - * Now do the actual compilation. Note that we do not use CompileBody + * Now do the actual compilation. Note that we do not use BODY() * because we may have synthesized the tokens in a non-standard * pattern. */ OP( POP); - envPtr->currStackDepth = savedStackDepth + 1; envPtr->line = bodyLines[i+1]; /* TIP #280 */ envPtr->clNext = bodyContLines[i+1]; /* TIP #280 */ TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr); @@ -1597,7 +1850,7 @@ IssueSwitchChainedTests( if (!foundDefault) { OP( POP); - PushLiteral(envPtr, "", 0); + PUSH(""); } /* @@ -1633,8 +1886,6 @@ IssueSwitchChainedTests( } TclStackFree(interp, fixupTargetArray); TclStackFree(interp, fixupArray); - - envPtr->currStackDepth = savedStackDepth + 1; } /* @@ -1654,11 +1905,7 @@ static void IssueSwitchJumpTable( Tcl_Interp *interp, /* Context for compiling script bodies. */ CompileEnv *envPtr, /* Holds resulting instructions. */ - ExtCmdLoc *mapPtr, /* For mapping tokens to their source code - * location. */ - int eclIndex, int valueIndex, /* The value to match against. */ - Tcl_Token *valueTokenPtr, int numBodyTokens, /* Number of tokens describing things the * switch can match against and bodies to * execute when the match succeeds. */ @@ -1668,20 +1915,12 @@ IssueSwitchJumpTable( int **bodyContLines) /* Array of continuation line info. */ { JumptableInfo *jtPtr; - int savedStackDepth = envPtr->currStackDepth; int infoIndex, isNew, *finalFixups, numRealBodies = 0, jumpLocation; int mustGenerate, foundDefault, jumpToDefault, i; Tcl_DString buffer; Tcl_HashEntry *hPtr; /* - * First, we push the value we're matching against on the stack. - */ - - SetLineInformation(valueIndex); - CompileTokens(envPtr, valueTokenPtr, interp); - - /* * Compile the switch by using a jump table, which is basically a * hashtable that maps from literal values to match against to the offset * (relative to the INST_JUMP_TABLE instruction) to jump to. The jump @@ -1781,7 +2020,6 @@ IssueSwitchJumpTable( * Compile the body of the arm. */ - envPtr->currStackDepth = savedStackDepth; envPtr->line = bodyLines[i+1]; /* TIP #280 */ envPtr->clNext = bodyContLines[i+1]; /* TIP #280 */ TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr); @@ -1803,6 +2041,7 @@ IssueSwitchJumpTable( */ OP4( JUMP4, 0); + TclAdjustStackDepth(-1, envPtr); } } @@ -1813,10 +2052,9 @@ IssueSwitchJumpTable( */ if (!foundDefault) { - envPtr->currStackDepth = savedStackDepth; TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault, envPtr->codeStart+jumpToDefault+1); - PushLiteral(envPtr, "", 0); + PUSH(""); } /* @@ -1834,7 +2072,6 @@ IssueSwitchJumpTable( */ TclStackFree(interp, finalFixups); - envPtr->currStackDepth = savedStackDepth + 1; } /* @@ -1953,11 +2190,14 @@ TclCompileTailcallCmd( return TCL_ERROR; } + /* make room for the nsObjPtr */ + /* TODO: Doesn't this have to be a known value? */ + CompileWord(envPtr, tokenPtr, interp, 0); for (i=1 ; i<parsePtr->numWords ; i++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, i); } - TclEmitInstInt1( INST_TAILCALL, parsePtr->numWords-1, envPtr); + TclEmitInstInt1( INST_TAILCALL, parsePtr->numWords, envPtr); return TCL_OK; } @@ -1990,9 +2230,9 @@ TclCompileThrowCmd( { DefineLineInformation; /* TIP #280 */ int numWords = parsePtr->numWords; - int savedStackDepth = envPtr->currStackDepth; Tcl_Token *codeToken, *msgToken; Tcl_Obj *objPtr; + int codeKnown, codeIsList, codeIsValid, len; if (numWords != 3) { return TCL_ERROR; @@ -2002,77 +2242,66 @@ TclCompileThrowCmd( TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); - if (TclWordKnownAtCompileTime(codeToken, objPtr)) { - Tcl_Obj *errPtr, *dictPtr; - const char *string; - int len; - /* - * The code is known at compilation time. This allows us to issue a - * very efficient sequence of instructions. - */ + codeKnown = TclWordKnownAtCompileTime(codeToken, objPtr); - if (Tcl_ListObjLength(interp, objPtr, &len) != TCL_OK) { - /* - * Must still do this; might generate an error when getting this - * "ignored" value prepared as an argument. - */ + /* + * First we must emit the code to substitute the arguments. This + * must come first in case substitution raises errors. + */ + if (!codeKnown) { + CompileWord(envPtr, codeToken, interp, 1); + PUSH( "-errorcode"); + } + CompileWord(envPtr, msgToken, interp, 2); - CompileWord(envPtr, msgToken, interp, 2); - TclCompileSyntaxError(interp, envPtr); - Tcl_DecrRefCount(objPtr); - envPtr->currStackDepth = savedStackDepth + 1; - return TCL_OK; - } - if (len == 0) { - /* - * Must still do this; might generate an error when getting this - * "ignored" value prepared as an argument. - */ + codeIsList = codeKnown && (TCL_OK == + Tcl_ListObjLength(interp, objPtr, &len)); + codeIsValid = codeIsList && (len != 0); + + if (codeIsValid) { + Tcl_Obj *errPtr, *dictPtr; - CompileWord(envPtr, msgToken, interp, 2); - goto issueErrorForEmptyCode; - } TclNewLiteralStringObj(errPtr, "-errorcode"); TclNewObj(dictPtr); Tcl_DictObjPut(NULL, dictPtr, errPtr, objPtr); - Tcl_IncrRefCount(dictPtr); - string = Tcl_GetStringFromObj(dictPtr, &len); - CompileWord(envPtr, msgToken, interp, 2); - PushLiteral(envPtr, string, len); - TclDecrRefCount(dictPtr); - OP44( RETURN_IMM, 1, 0); - envPtr->currStackDepth = savedStackDepth + 1; - } else { - /* - * When the code token is not known at compilation time, we need to do - * a little bit more work. The main tricky bit here is that the error - * code has to be a list (a [throw] restriction) so we must emit extra - * instructions to enforce that condition. - */ + TclEmitPush(TclAddLiteralObj(envPtr, dictPtr, NULL), envPtr); + } + TclDecrRefCount(objPtr); - CompileWord(envPtr, codeToken, interp, 1); - PUSH( "-errorcode"); - CompileWord(envPtr, msgToken, interp, 2); - OP4( REVERSE, 3); - OP( DUP); - OP( LIST_LENGTH); - OP1( JUMP_FALSE1, 16); - OP4( LIST, 2); - OP44( RETURN_IMM, 1, 0); + /* + * Simpler bytecodes when we detect invalid arguments at compile time. + */ + if (codeKnown && !codeIsValid) { + OP( POP); + if (codeIsList) { + /* Must be an empty list */ + goto issueErrorForEmptyCode; + } + TclCompileSyntaxError(interp, envPtr); + return TCL_OK; + } + if (!codeKnown) { /* - * Generate an error for being an empty list. Can't leverage anything - * else to do this for us. + * Argument validity checking has to be done by bytecode at + * run time. */ - + OP4( REVERSE, 3); + OP( DUP); + OP( LIST_LENGTH); + OP1( JUMP_FALSE1, 16); + OP4( LIST, 2); + OP44( RETURN_IMM, TCL_ERROR, 0); + TclAdjustStackDepth(2, envPtr); + OP( POP); + OP( POP); + OP( POP); issueErrorForEmptyCode: - PUSH( "type must be non-empty list"); - PUSH( ""); - OP44( RETURN_IMM, 1, 0); + PUSH( "type must be non-empty list"); + PUSH( "-errorcode {TCL OPERATION THROW BADEXCEPTION}"); } - envPtr->currStackDepth = savedStackDepth + 1; - TclDecrRefCount(objPtr); + OP44( RETURN_IMM, TCL_ERROR, 0); return TCL_OK; } @@ -2122,8 +2351,7 @@ TclCompileTryCmd( */ DefineLineInformation; /* TIP #280 */ - SetLineInformation(1); - CompileBody(envPtr, bodyToken, interp); + BODY(bodyToken, 1); return TCL_OK; } @@ -2214,12 +2442,11 @@ TclCompileTryCmd( int len; const char *varname = Tcl_GetStringFromObj(objv[0], &len); - if (!TclIsLocalScalar(varname, len)) { + resultVarIndices[i] = LocalScalar(varname, len, envPtr); + if (resultVarIndices[i] < 0) { TclDecrRefCount(tmpObj); goto failedToCompile; } - resultVarIndices[i] = - TclFindCompiledLocal(varname, len, 1, envPtr); } else { resultVarIndices[i] = -1; } @@ -2227,12 +2454,11 @@ TclCompileTryCmd( int len; const char *varname = Tcl_GetStringFromObj(objv[1], &len); - if (!TclIsLocalScalar(varname, len)) { + optionVarIndices[i] = LocalScalar(varname, len, envPtr); + if (optionVarIndices[i] < 0) { TclDecrRefCount(tmpObj); goto failedToCompile; } - optionVarIndices[i] = - TclFindCompiledLocal(varname, len, 1, envPtr); } else { optionVarIndices[i] = -1; } @@ -2280,14 +2506,17 @@ TclCompileTryCmd( * Issue the bytecode. */ - if (finallyToken) { + if (!finallyToken) { + result = IssueTryClausesInstructions(interp, envPtr, bodyToken, + numHandlers, matchCodes, matchClauses, resultVarIndices, + optionVarIndices, handlerTokens); + } else if (numHandlers == 0) { result = IssueTryFinallyInstructions(interp, envPtr, bodyToken, + finallyToken); + } else { + result = IssueTryClausesFinallyInstructions(interp, envPtr, bodyToken, numHandlers, matchCodes, matchClauses, resultVarIndices, optionVarIndices, handlerTokens, finallyToken); - } else { - result = IssueTryInstructions(interp, envPtr, bodyToken, numHandlers, - matchCodes, matchClauses, resultVarIndices, optionVarIndices, - handlerTokens); } /* @@ -2313,12 +2542,13 @@ TclCompileTryCmd( /* *---------------------------------------------------------------------- * - * IssueTryInstructions, IssueTryFinallyInstructions -- + * IssueTryClausesInstructions, IssueTryClausesFinallyInstructions, + * IssueTryFinallyInstructions -- * * The code generators for [try]. Split from the parsing engine for - * reasons of developer sanity, and also split between no-finally and - * with-finally cases because so many of the details of generation vary - * between the two. + * reasons of developer sanity, and also split between no-finally, + * just-finally and with-finally cases because so many of the details of + * generation vary between the three. * * The macros below make the instruction issuing easier to follow. * @@ -2326,7 +2556,7 @@ TclCompileTryCmd( */ static int -IssueTryInstructions( +IssueTryClausesInstructions( Tcl_Interp *interp, CompileEnv *envPtr, Tcl_Token *bodyToken, @@ -2339,32 +2569,51 @@ IssueTryInstructions( { DefineLineInformation; /* TIP #280 */ int range, resultVar, optionsVar; - int savedStackDepth = envPtr->currStackDepth; - int i, j, len, forwardsNeedFixing = 0; + int i, j, len, forwardsNeedFixing = 0, trapZero = 0, afterBody = 0; int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource; + int *noError; char buf[TCL_INTEGER_SPACE]; - resultVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); - optionsVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); + resultVar = AnonymousLocal(envPtr); + optionsVar = AnonymousLocal(envPtr); if (resultVar < 0 || optionsVar < 0) { return TCL_ERROR; } /* + * Check if we're supposed to trap a normal TCL_OK completion of the body. + * If not, we can handle that case much more efficiently. + */ + + for (i=0 ; i<numHandlers ; i++) { + if (matchCodes[i] == 0) { + trapZero = 1; + break; + } + } + + /* * Compile the body, trapping any error in it so that we can trap on it * and/or run a finally clause. Note that there must be at least one * on/trap clause; when none is present, this whole function is not called * (and it's never called when there's a finally clause). */ - range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); + range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); OP4( BEGIN_CATCH4, range); ExceptionRangeStarts(envPtr, range); BODY( bodyToken, 1); ExceptionRangeEnds(envPtr, range); - PUSH( "0"); - OP4( REVERSE, 2); - OP1( JUMP1, 4); + if (!trapZero) { + OP( END_CATCH); + JUMP4( JUMP, afterBody); + TclAdjustStackDepth(-1, envPtr); + } else { + PUSH( "0"); + OP4( REVERSE, 2); + OP1( JUMP1, 4); + TclAdjustStackDepth(-2, envPtr); + } ExceptionRangeTarget(envPtr, range, catchOffset); OP( PUSH_RETURN_CODE); OP( PUSH_RESULT); @@ -2384,14 +2633,17 @@ IssueTryInstructions( addrsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers); forwardsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers); + noError = TclStackAlloc(interp, sizeof(int)*numHandlers); for (i=0 ; i<numHandlers ; i++) { + noError[i] = -1; sprintf(buf, "%d", matchCodes[i]); OP( DUP); - PUSH( buf); + PushLiteral(envPtr, buf, strlen(buf)); OP( EQ); - JUMP(notCodeJumpSource, JUMP_FALSE4); + JUMP4( JUMP_FALSE, notCodeJumpSource); if (matchClauses[i]) { + const char *p; Tcl_ListObjLength(NULL, matchClauses[i], &len); /* @@ -2403,9 +2655,10 @@ IssueTryInstructions( OP4( DICT_GET, 1); TclAdjustStackDepth(-1, envPtr); OP44( LIST_RANGE_IMM, 0, len-1); - PUSH( TclGetString(matchClauses[i])); + p = Tcl_GetStringFromObj(matchClauses[i], &len); + PushLiteral(envPtr, p, len); OP( STR_EQ); - JUMP(notECJumpSource, JUMP_FALSE4); + JUMP4( JUMP_FALSE, notECJumpSource); } else { notECJumpSource = -1; /* LINT */ } @@ -2429,8 +2682,10 @@ IssueTryInstructions( } if (!handlerTokens[i]) { forwardsNeedFixing = 1; - JUMP(forwardsToFix[i], JUMP4); + JUMP4( JUMP, forwardsToFix[i]); } else { + int dontChangeOptions; + forwardsToFix[i] = -1; if (forwardsNeedFixing) { forwardsNeedFixing = 0; @@ -2438,19 +2693,44 @@ IssueTryInstructions( if (forwardsToFix[j] == -1) { continue; } - FIXJUMP(forwardsToFix[j]); + FIXJUMP4(forwardsToFix[j]); forwardsToFix[j] = -1; } } - envPtr->currStackDepth = savedStackDepth; + range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); + OP4( BEGIN_CATCH4, range); + ExceptionRangeStarts(envPtr, range); BODY( handlerTokens[i], 5+i*4); + ExceptionRangeEnds(envPtr, range); + OP( END_CATCH); + JUMP4( JUMP, noError[i]); + ExceptionRangeTarget(envPtr, range, catchOffset); + TclAdjustStackDepth(-1, envPtr); + OP( PUSH_RESULT); + OP( PUSH_RETURN_OPTIONS); + OP( PUSH_RETURN_CODE); + OP( END_CATCH); + PUSH( "1"); + OP( EQ); + JUMP1( JUMP_FALSE, dontChangeOptions); + LOAD( optionsVar); + OP4( REVERSE, 2); + STORE( optionsVar); + OP( POP); + PUSH( "-during"); + OP4( REVERSE, 2); + OP44( DICT_SET, 1, optionsVar); + TclAdjustStackDepth(-1, envPtr); + FIXJUMP1( dontChangeOptions); + OP4( REVERSE, 2); + INVOKE( RETURN_STK); } - JUMP(addrsToFix[i], JUMP4); + JUMP4( JUMP, addrsToFix[i]); if (matchClauses[i]) { - FIXJUMP(notECJumpSource); + FIXJUMP4( notECJumpSource); } - FIXJUMP(notCodeJumpSource); + FIXJUMP4( notCodeJumpSource); } /* @@ -2462,24 +2742,30 @@ IssueTryInstructions( OP( POP); LOAD( optionsVar); LOAD( resultVar); - OP( RETURN_STK); + INVOKE( RETURN_STK); /* * Fix all the jumps from taken clauses to here (which is the end of the * [try]). */ + if (!trapZero) { + FIXJUMP4(afterBody); + } for (i=0 ; i<numHandlers ; i++) { - FIXJUMP(addrsToFix[i]); + FIXJUMP4(addrsToFix[i]); + if (noError[i] != -1) { + FIXJUMP4(noError[i]); + } } + TclStackFree(interp, noError); TclStackFree(interp, forwardsToFix); TclStackFree(interp, addrsToFix); - envPtr->currStackDepth = savedStackDepth + 1; return TCL_OK; } static int -IssueTryFinallyInstructions( +IssueTryClausesFinallyInstructions( Tcl_Interp *interp, CompileEnv *envPtr, Tcl_Token *bodyToken, @@ -2492,31 +2778,53 @@ IssueTryFinallyInstructions( Tcl_Token *finallyToken) /* Not NULL */ { DefineLineInformation; /* TIP #280 */ - int savedStackDepth = envPtr->currStackDepth; int range, resultVar, optionsVar, i, j, len, forwardsNeedFixing = 0; + int trapZero = 0, afterBody = 0, finalOK, finalError, noFinalError; int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource; char buf[TCL_INTEGER_SPACE]; - resultVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); - optionsVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); + resultVar = AnonymousLocal(envPtr); + optionsVar = AnonymousLocal(envPtr); if (resultVar < 0 || optionsVar < 0) { return TCL_ERROR; } /* + * Check if we're supposed to trap a normal TCL_OK completion of the body. + * If not, we can handle that case much more efficiently. + */ + + for (i=0 ; i<numHandlers ; i++) { + if (matchCodes[i] == 0) { + trapZero = 1; + break; + } + } + + /* * Compile the body, trapping any error in it so that we can trap on it * (if any trap matches) and run a finally clause. */ - range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); + range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); OP4( BEGIN_CATCH4, range); ExceptionRangeStarts(envPtr, range); - envPtr->currStackDepth = savedStackDepth; BODY( bodyToken, 1); ExceptionRangeEnds(envPtr, range); - PUSH( "0"); - OP4( REVERSE, 2); - OP1( JUMP1, 4); + if (!trapZero) { + OP( END_CATCH); + STORE( resultVar); + OP( POP); + PUSH( "-level 0 -code 0"); + STORE( optionsVar); + OP( POP); + JUMP4( JUMP, afterBody); + } else { + PUSH( "0"); + OP4( REVERSE, 2); + OP1( JUMP1, 4); + TclAdjustStackDepth(-2, envPtr); + } ExceptionRangeTarget(envPtr, range, catchOffset); OP( PUSH_RETURN_CODE); OP( PUSH_RESULT); @@ -2526,161 +2834,176 @@ IssueTryFinallyInstructions( OP( POP); STORE( resultVar); OP( POP); - envPtr->currStackDepth = savedStackDepth + 1; /* * Now we handle all the registered 'on' and 'trap' handlers in order. + * + * Slight overallocation, but reduces size of this function. */ - if (numHandlers) { - /* - * Slight overallocation, but reduces size of this function. - */ - - addrsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers); - forwardsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers); - - for (i=0 ; i<numHandlers ; i++) { - sprintf(buf, "%d", matchCodes[i]); - OP( DUP); - PUSH( buf); - OP( EQ); - JUMP(notCodeJumpSource, JUMP_FALSE4); - if (matchClauses[i]) { - Tcl_ListObjLength(NULL, matchClauses[i], &len); + addrsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers); + forwardsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers); - /* - * Match the errorcode according to try/trap rules. - */ + for (i=0 ; i<numHandlers ; i++) { + int noTrapError, trapError; + const char *p; - LOAD( optionsVar); - PUSH( "-errorcode"); - OP4( DICT_GET, 1); - TclAdjustStackDepth(-1, envPtr); - OP44( LIST_RANGE_IMM, 0, len-1); - PUSH( TclGetString(matchClauses[i])); - OP( STR_EQ); - JUMP(notECJumpSource, JUMP_FALSE4); - } else { - notECJumpSource = -1; /* LINT */ - } + sprintf(buf, "%d", matchCodes[i]); + OP( DUP); + PushLiteral(envPtr, buf, strlen(buf)); + OP( EQ); + JUMP4( JUMP_FALSE, notCodeJumpSource); + if (matchClauses[i]) { + Tcl_ListObjLength(NULL, matchClauses[i], &len); /* - * There is a finally clause, so we need a fairly complex sequence - * of instructions to deal with an on/trap handler because we must - * call the finally handler *and* we need to substitute the result - * from a failed trap for the result from the main script. + * Match the errorcode according to try/trap rules. */ - if (resultVars[i] >= 0 || handlerTokens[i]) { - range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); - OP4( BEGIN_CATCH4, range); - ExceptionRangeStarts(envPtr, range); - } - if (resultVars[i] >= 0) { - LOAD( resultVar); - STORE( resultVars[i]); - OP( POP); - if (optionVars[i] >= 0) { - LOAD( optionsVar); - STORE( optionVars[i]); - OP( POP); - } + LOAD( optionsVar); + PUSH( "-errorcode"); + OP4( DICT_GET, 1); + TclAdjustStackDepth(-1, envPtr); + OP44( LIST_RANGE_IMM, 0, len-1); + p = Tcl_GetStringFromObj(matchClauses[i], &len); + PushLiteral(envPtr, p, len); + OP( STR_EQ); + JUMP4( JUMP_FALSE, notECJumpSource); + } else { + notECJumpSource = -1; /* LINT */ + } + OP( POP); - if (!handlerTokens[i]) { - /* - * No handler. Will not be the last handler (that is a - * condition that is checked by the caller). Chain to the - * next one. - */ + /* + * There is a finally clause, so we need a fairly complex sequence of + * instructions to deal with an on/trap handler because we must call + * the finally handler *and* we need to substitute the result from a + * failed trap for the result from the main script. + */ - ExceptionRangeEnds(envPtr, range); - OP( END_CATCH); - forwardsNeedFixing = 1; - JUMP(forwardsToFix[i], JUMP4); - goto finishTrapCatchHandling; - } - } else if (!handlerTokens[i]) { + if (resultVars[i] >= 0 || handlerTokens[i]) { + range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); + OP4( BEGIN_CATCH4, range); + ExceptionRangeStarts(envPtr, range); + } + if (resultVars[i] >= 0) { + LOAD( resultVar); + STORE( resultVars[i]); + OP( POP); + if (optionVars[i] >= 0) { + LOAD( optionsVar); + STORE( optionVars[i]); + OP( POP); + } + + if (!handlerTokens[i]) { /* - * No handler. Will not be the last handler (that condition is - * checked by the caller). Chain to the next one. + * No handler. Will not be the last handler (that is a + * condition that is checked by the caller). Chain to the next + * one. */ + ExceptionRangeEnds(envPtr, range); + OP( END_CATCH); forwardsNeedFixing = 1; - JUMP(forwardsToFix[i], JUMP4); - goto endOfThisArm; + JUMP4( JUMP, forwardsToFix[i]); + goto finishTrapCatchHandling; } - + } else if (!handlerTokens[i]) { /* - * Got a handler. Make sure that any pending patch-up actions from - * previous unprocessed handlers are dealt with now that we know - * where they are to jump to. + * No handler. Will not be the last handler (that condition is + * checked by the caller). Chain to the next one. */ - if (forwardsNeedFixing) { - forwardsNeedFixing = 0; - OP1( JUMP1, 7); - for (j=0 ; j<i ; j++) { - if (forwardsToFix[j] == -1) { - continue; - } - FIXJUMP(forwardsToFix[j]); - forwardsToFix[j] = -1; - } - OP4( BEGIN_CATCH4, range); - } - envPtr->currStackDepth = savedStackDepth; - BODY( handlerTokens[i], 5+i*4); - ExceptionRangeEnds(envPtr, range); - OP( PUSH_RETURN_OPTIONS); - OP4( REVERSE, 2); - OP1( JUMP1, 4); - forwardsToFix[i] = -1; - - /* - * Error in handler or setting of variables; replace the stored - * exception with the new one. Note that we only push this if we - * have either a body or some variable setting here. Otherwise - * this code is unreachable. - */ + forwardsNeedFixing = 1; + JUMP4( JUMP, forwardsToFix[i]); + goto endOfThisArm; + } - finishTrapCatchHandling: - ExceptionRangeTarget(envPtr, range, catchOffset); - OP( PUSH_RETURN_OPTIONS); - OP( PUSH_RESULT); - OP( END_CATCH); - STORE( resultVar); - OP( POP); - STORE( optionsVar); - OP( POP); + /* + * Got a handler. Make sure that any pending patch-up actions from + * previous unprocessed handlers are dealt with now that we know where + * they are to jump to. + */ - endOfThisArm: - if (i+1 < numHandlers) { - JUMP(addrsToFix[i], JUMP4); - } - if (matchClauses[i]) { - FIXJUMP(notECJumpSource); + if (forwardsNeedFixing) { + forwardsNeedFixing = 0; + OP1( JUMP1, 7); + for (j=0 ; j<i ; j++) { + if (forwardsToFix[j] == -1) { + continue; + } + FIXJUMP4( forwardsToFix[j]); + forwardsToFix[j] = -1; } - FIXJUMP(notCodeJumpSource); + OP4( BEGIN_CATCH4, range); } + BODY( handlerTokens[i], 5+i*4); + ExceptionRangeEnds(envPtr, range); + PUSH( "0"); + OP( PUSH_RETURN_OPTIONS); + OP4( REVERSE, 3); + OP1( JUMP1, 5); + TclAdjustStackDepth(-3, envPtr); + forwardsToFix[i] = -1; /* - * Fix all the jumps from taken clauses to here (the start of the - * finally clause). + * Error in handler or setting of variables; replace the stored + * exception with the new one. Note that we only push this if we have + * either a body or some variable setting here. Otherwise this code is + * unreachable. */ - for (i=0 ; i<numHandlers-1 ; i++) { - FIXJUMP(addrsToFix[i]); + finishTrapCatchHandling: + ExceptionRangeTarget(envPtr, range, catchOffset); + OP( PUSH_RETURN_OPTIONS); + OP( PUSH_RETURN_CODE); + OP( PUSH_RESULT); + OP( END_CATCH); + STORE( resultVar); + OP( POP); + PUSH( "1"); + OP( EQ); + JUMP1( JUMP_FALSE, noTrapError); + LOAD( optionsVar); + PUSH( "-during"); + OP4( REVERSE, 3); + STORE( optionsVar); + OP( POP); + OP44( DICT_SET, 1, optionsVar); + TclAdjustStackDepth(-1, envPtr); + JUMP1( JUMP, trapError); + FIXJUMP1( noTrapError); + STORE( optionsVar); + FIXJUMP1( trapError); + /* Skip POP at end; can clean up with subsequent POP */ + if (i+1 < numHandlers) { + OP( POP); + } + + endOfThisArm: + if (i+1 < numHandlers) { + JUMP4( JUMP, addrsToFix[i]); + TclAdjustStackDepth(1, envPtr); } - TclStackFree(interp, forwardsToFix); - TclStackFree(interp, addrsToFix); + if (matchClauses[i]) { + FIXJUMP4( notECJumpSource); + } + FIXJUMP4( notCodeJumpSource); } /* - * Drop the result code. + * Drop the result code, and fix all the jumps from taken clauses - which + * drop the result code as their first action - to point straight after + * (i.e., to the start of the finally clause). */ OP( POP); + for (i=0 ; i<numHandlers-1 ; i++) { + FIXJUMP4( addrsToFix[i]); + } + TclStackFree(interp, forwardsToFix); + TclStackFree(interp, addrsToFix); /* * Process the finally clause (at last!) Note that we do not wrap this in @@ -2690,14 +3013,104 @@ IssueTryFinallyInstructions( * next command (or some inter-command manipulation). */ - envPtr->currStackDepth = savedStackDepth; + if (!trapZero) { + FIXJUMP4( afterBody); + } + range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); + OP4( BEGIN_CATCH4, range); + ExceptionRangeStarts(envPtr, range); BODY( finallyToken, 3 + 4*numHandlers); + ExceptionRangeEnds(envPtr, range); + OP( END_CATCH); + OP( POP); + JUMP1( JUMP, finalOK); + ExceptionRangeTarget(envPtr, range, catchOffset); + OP( PUSH_RESULT); + OP( PUSH_RETURN_OPTIONS); + OP( PUSH_RETURN_CODE); + OP( END_CATCH); + PUSH( "1"); + OP( EQ); + JUMP1( JUMP_FALSE, noFinalError); + LOAD( optionsVar); + PUSH( "-during"); + OP4( REVERSE, 3); + STORE( optionsVar); + OP( POP); + OP44( DICT_SET, 1, optionsVar); + TclAdjustStackDepth(-1, envPtr); + OP( POP); + JUMP1( JUMP, finalError); + TclAdjustStackDepth(1, envPtr); + FIXJUMP1( noFinalError); + STORE( optionsVar); + OP( POP); + FIXJUMP1( finalError); + STORE( resultVar); OP( POP); + FIXJUMP1( finalOK); LOAD( optionsVar); LOAD( resultVar); - OP( RETURN_STK); - envPtr->currStackDepth = savedStackDepth + 1; + INVOKE( RETURN_STK); + + return TCL_OK; +} + +static int +IssueTryFinallyInstructions( + Tcl_Interp *interp, + CompileEnv *envPtr, + Tcl_Token *bodyToken, + Tcl_Token *finallyToken) +{ + DefineLineInformation; /* TIP #280 */ + int range, jumpOK, jumpSplice; + + /* + * Note that this one is simple enough that we can issue it without + * needing a local variable table, making it a universal compilation. + */ + + range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); + OP4( BEGIN_CATCH4, range); + ExceptionRangeStarts(envPtr, range); + BODY( bodyToken, 1); + ExceptionRangeEnds(envPtr, range); + OP1( JUMP1, 3); + TclAdjustStackDepth(-1, envPtr); + ExceptionRangeTarget(envPtr, range, catchOffset); + OP( PUSH_RESULT); + OP( PUSH_RETURN_OPTIONS); + OP( END_CATCH); + range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); + OP4( BEGIN_CATCH4, range); + ExceptionRangeStarts(envPtr, range); + BODY( finallyToken, 3); + ExceptionRangeEnds(envPtr, range); + OP( END_CATCH); + OP( POP); + JUMP1( JUMP, jumpOK); + ExceptionRangeTarget(envPtr, range, catchOffset); + OP( PUSH_RESULT); + OP( PUSH_RETURN_OPTIONS); + OP( PUSH_RETURN_CODE); + OP( END_CATCH); + PUSH( "1"); + OP( EQ); + JUMP1( JUMP_FALSE, jumpSplice); + PUSH( "-during"); + OP4( OVER, 3); + OP4( LIST, 2); + OP( LIST_CONCAT); + FIXJUMP1( jumpSplice); + OP4( REVERSE, 4); + OP( POP); + OP( POP); + OP1( JUMP1, 7); + FIXJUMP1( jumpOK); + OP4( REVERSE, 2); + INVOKE( RETURN_STK); return TCL_OK; } @@ -2729,38 +3142,81 @@ TclCompileUnsetCmd( CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr; - int isScalar, simpleVarName, localIndex, numWords, flags, i; - Tcl_Obj *leadingWord; + int isScalar, localIndex, flags = 1, i, varCount = 0, haveFlags = 0; DefineLineInformation; /* TIP #280 */ - numWords = parsePtr->numWords-1; - flags = 1; - varTokenPtr = TokenAfter(parsePtr->tokenPtr); - leadingWord = Tcl_NewObj(); - if (TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) { - int len; - const char *bytes = Tcl_GetStringFromObj(leadingWord, &len); - - if (len == 11 && !strncmp("-nocomplain", bytes, 11)) { - flags = 0; - varTokenPtr = TokenAfter(varTokenPtr); - numWords--; - } else if (len == 2 && !strncmp("--", bytes, 2)) { - varTokenPtr = TokenAfter(varTokenPtr); - numWords--; + /* TODO: Consider support for compiling expanded args. */ + + /* + * Verify that all words - except the first non-option one - are known at + * compile time so that we can handle them without needing to do a nasty + * push/rotate. [Bug 3970f54c4e] + */ + + for (i=1,varTokenPtr=parsePtr->tokenPtr ; i<parsePtr->numWords ; i++) { + Tcl_Obj *leadingWord = Tcl_NewObj(); + + varTokenPtr = TokenAfter(varTokenPtr); + if (!TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) { + TclDecrRefCount(leadingWord); + + /* + * We can tolerate non-trivial substitutions in the first variable + * to be unset. If a '--' or '-nocomplain' was present, anything + * goes in that one place! (All subsequent variable names must be + * constants since we don't want to have to push them all first.) + */ + + if (varCount == 0) { + if (haveFlags) { + continue; + } + + /* + * In fact, we're OK as long as we're the first argument *and* + * we provably don't start with a '-'. If that is true, then + * even if everything else is varying, we still can't be a + * flag. Otherwise we'll spill to runtime to place a limit on + * the trickiness. + */ + + if (varTokenPtr->type == TCL_TOKEN_WORD + && varTokenPtr[1].type == TCL_TOKEN_TEXT + && varTokenPtr[1].size > 0 + && varTokenPtr[1].start[0] != '-') { + continue; + } + } + return TCL_ERROR; } - } else { - /* - * Cannot guarantee that the first word is not '-nocomplain' at - * evaluation with reasonable effort, so spill to interpreted version. - */ + if (i == 1) { + const char *bytes; + int len; + bytes = Tcl_GetStringFromObj(leadingWord, &len); + if (len == 11 && !strncmp("-nocomplain", bytes, 11)) { + flags = 0; + haveFlags = 1; + } else if (len == 2 && !strncmp("--", bytes, 2)) { + haveFlags = 1; + } else { + varCount++; + } + } else { + varCount++; + } TclDecrRefCount(leadingWord); - return TCL_ERROR; } - TclDecrRefCount(leadingWord); - for (i=0 ; i<numWords ; i++) { + /* + * Issue instructions to unset each of the named variables. + */ + + varTokenPtr = TokenAfter(parsePtr->tokenPtr); + if (haveFlags) { + varTokenPtr = TokenAfter(varTokenPtr); + } + for (i=1+haveFlags ; i<parsePtr->numWords ; i++) { /* * Decide if we can use a frame slot for the var/array name or if we * need to emit code to compute and push the name at runtime. We use a @@ -2770,15 +3226,13 @@ TclCompileUnsetCmd( */ PushVarNameWord(interp, varTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + &localIndex, &isScalar, i); /* * Emit instructions to unset the variable. */ - if (!simpleVarName) { - OP1( UNSET_STK, flags); - } else if (isScalar) { + if (isScalar) { if (localIndex < 0) { OP1( UNSET_STK, flags); } else { @@ -2794,7 +3248,7 @@ TclCompileUnsetCmd( varTokenPtr = TokenAfter(varTokenPtr); } - PushLiteral(envPtr, "", 0); + PUSH(""); return TCL_OK; } @@ -2828,7 +3282,6 @@ TclCompileWhileCmd( Tcl_Token *testTokenPtr, *bodyTokenPtr; JumpFixup jumpEvalCondFixup; int testCodeOffset, bodyCodeOffset, jumpDist, range, code, boolVal; - int savedStackDepth = envPtr->currStackDepth; int loopMayEnd = 1; /* This is set to 0 if it is recognized as an * infinite loop. */ Tcl_Obj *boolObj; @@ -2886,7 +3339,7 @@ TclCompileWhileCmd( * implement break and continue. */ - range = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE); + range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); /* * Jump to the evaluation of the condition. This code uses the "loop @@ -2912,7 +3365,7 @@ TclCompileWhileCmd( * INST_START_CMD, and hence counted properly. [Bug 1752146] */ - envPtr->atCmdStart = 0; + envPtr->atCmdStart &= ~1; testCodeOffset = CurrentOffset(envPtr); } @@ -2920,11 +3373,13 @@ TclCompileWhileCmd( * Compile the loop body. */ - SetLineInformation(2); bodyCodeOffset = ExceptionRangeStarts(envPtr, range); - CompileBody(envPtr, bodyTokenPtr, interp); + if (!loopMayEnd) { + envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset; + envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset; + } + BODY(bodyTokenPtr, 2); ExceptionRangeEnds(envPtr, range); - envPtr->currStackDepth = savedStackDepth + 1; OP( POP); /* @@ -2939,10 +3394,9 @@ TclCompileWhileCmd( bodyCodeOffset += 3; testCodeOffset += 3; } - envPtr->currStackDepth = savedStackDepth; SetLineInformation(1); TclCompileExprWords(interp, testTokenPtr, 1, envPtr); - envPtr->currStackDepth = savedStackDepth + 1; + TclClearNumConversion(envPtr); jumpDist = CurrentOffset(envPtr) - bodyCodeOffset; if (jumpDist > 127) { @@ -2966,14 +3420,14 @@ TclCompileWhileCmd( envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset; envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset; ExceptionRangeTarget(envPtr, range, breakOffset); + TclFinalizeLoopExceptionRange(envPtr, range); /* * The while command's result is an empty string. */ pushResult: - envPtr->currStackDepth = savedStackDepth; - PushLiteral(envPtr, "", 0); + PUSH(""); return TCL_OK; } @@ -3009,7 +3463,7 @@ TclCompileYieldCmd( } if (parsePtr->numWords == 1) { - PushLiteral(envPtr, "", 0); + PUSH(""); } else { DefineLineInformation; /* TIP #280 */ Tcl_Token *valueTokenPtr = TokenAfter(parsePtr->tokenPtr); @@ -3023,246 +3477,6 @@ TclCompileYieldCmd( /* *---------------------------------------------------------------------- * - * PushVarName -- - * - * Procedure used in the compiling where pushing a variable name is - * necessary (append, lappend, set). - * - * Results: - * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer - * evaluation to runtime. - * - * Side effects: - * Instructions are added to envPtr to execute the "set" command at - * runtime. - * - *---------------------------------------------------------------------- - */ - -static int -PushVarName( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Token *varTokenPtr, /* Points to a variable token. */ - CompileEnv *envPtr, /* Holds resulting instructions. */ - int flags, /* TCL_NO_LARGE_INDEX. */ - int *localIndexPtr, /* Must not be NULL. */ - int *simpleVarNamePtr, /* Must not be NULL. */ - int *isScalarPtr, /* Must not be NULL. */ - int line, /* Line the token starts on. */ - int *clNext) /* Reference to offset of next hidden cont. - * line. */ -{ - register const char *p; - const char *name, *elName; - register int i, n; - Tcl_Token *elemTokenPtr = NULL; - int nameChars, elNameChars, simpleVarName, localIndex; - int elemTokenCount = 0, allocedTokens = 0, removedParen = 0; - - /* - * Decide if we can use a frame slot for the var/array name or if we need - * to emit code to compute and push the name at runtime. We use a frame - * slot (entry in the array of local vars) if we are compiling a procedure - * body and if the name is simple text that does not include namespace - * qualifiers. - */ - - simpleVarName = 0; - name = elName = NULL; - nameChars = elNameChars = 0; - localIndex = -1; - - /* - * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether - * curly braces surround the variable name. This really matters for array - * elements to handle things like - * set {x($foo)} 5 - * which raises an undefined var error if we are not careful here. - */ - - if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) && - (varTokenPtr->start[0] != '{')) { - /* - * A simple variable name. Divide it up into "name" and "elName" - * strings. If it is not a local variable, look it up at runtime. - */ - - simpleVarName = 1; - - name = varTokenPtr[1].start; - nameChars = varTokenPtr[1].size; - if (name[nameChars-1] == ')') { - /* - * last char is ')' => potential array reference. - */ - - for (i=0,p=name ; i<nameChars ; i++,p++) { - if (*p == '(') { - elName = p + 1; - elNameChars = nameChars - i - 2; - nameChars = i; - break; - } - } - - if ((elName != NULL) && elNameChars) { - /* - * An array element, the element name is a simple string: - * assemble the corresponding token. - */ - - elemTokenPtr = TclStackAlloc(interp, sizeof(Tcl_Token)); - allocedTokens = 1; - elemTokenPtr->type = TCL_TOKEN_TEXT; - elemTokenPtr->start = elName; - elemTokenPtr->size = elNameChars; - elemTokenPtr->numComponents = 0; - elemTokenCount = 1; - } - } - } else if (((n = varTokenPtr->numComponents) > 1) - && (varTokenPtr[1].type == TCL_TOKEN_TEXT) - && (varTokenPtr[n].type == TCL_TOKEN_TEXT) - && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) { - /* - * Check for parentheses inside first token. - */ - - simpleVarName = 0; - for (i = 0, p = varTokenPtr[1].start; - i < varTokenPtr[1].size; i++, p++) { - if (*p == '(') { - simpleVarName = 1; - break; - } - } - if (simpleVarName) { - int remainingChars; - - /* - * Check the last token: if it is just ')', do not count it. - * Otherwise, remove the ')' and flag so that it is restored at - * the end. - */ - - if (varTokenPtr[n].size == 1) { - n--; - } else { - varTokenPtr[n].size--; - removedParen = n; - } - - name = varTokenPtr[1].start; - nameChars = p - varTokenPtr[1].start; - elName = p + 1; - remainingChars = (varTokenPtr[2].start - p) - 1; - elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 2; - - if (remainingChars) { - /* - * Make a first token with the extra characters in the first - * token. - */ - - elemTokenPtr = TclStackAlloc(interp, n * sizeof(Tcl_Token)); - allocedTokens = 1; - elemTokenPtr->type = TCL_TOKEN_TEXT; - elemTokenPtr->start = elName; - elemTokenPtr->size = remainingChars; - elemTokenPtr->numComponents = 0; - elemTokenCount = n; - - /* - * Copy the remaining tokens. - */ - - memcpy(elemTokenPtr+1, varTokenPtr+2, - (n-1) * sizeof(Tcl_Token)); - } else { - /* - * Use the already available tokens. - */ - - elemTokenPtr = &varTokenPtr[2]; - elemTokenCount = n - 1; - } - } - } - - if (simpleVarName) { - /* - * See whether name has any namespace separators (::'s). - */ - - int hasNsQualifiers = 0; - - for (i = 0, p = name; i < nameChars; i++, p++) { - if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) { - hasNsQualifiers = 1; - break; - } - } - - /* - * Look up the var name's index in the array of local vars in the proc - * frame. If retrieving the var's value and it doesn't already exist, - * push its name and look it up at runtime. - */ - - if (!hasNsQualifiers) { - localIndex = TclFindCompiledLocal(name, nameChars, - 1, envPtr); - if ((flags & TCL_NO_LARGE_INDEX) && (localIndex > 255)) { - /* - * We'll push the name. - */ - - localIndex = -1; - } - } - if (localIndex < 0) { - PushLiteral(envPtr, name, nameChars); - } - - /* - * Compile the element script, if any. - */ - - if (elName != NULL) { - if (elNameChars) { - envPtr->line = line; - envPtr->clNext = clNext; - TclCompileTokens(interp, elemTokenPtr, elemTokenCount, - envPtr); - } else { - PushLiteral(envPtr, "", 0); - } - } - } else { - /* - * The var name isn't simple: compile and push it. - */ - - envPtr->line = line; - envPtr->clNext = clNext; - CompileTokens(envPtr, varTokenPtr, interp); - } - - if (removedParen) { - varTokenPtr[removedParen].size++; - } - if (allocedTokens) { - TclStackFree(interp, elemTokenPtr); - } - *localIndexPtr = localIndex; - *simpleVarNamePtr = simpleVarName; - *isScalarPtr = (elName == NULL); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * * CompileUnaryOpCmd -- * * Utility routine to compile the unary operator commands. @@ -3331,6 +3545,7 @@ CompileAssociativeBinaryOpCmd( DefineLineInformation; /* TIP #280 */ int words; + /* TODO: Consider support for compiling expanded args. */ for (words=1 ; words<parsePtr->numWords ; words++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, words); @@ -3414,8 +3629,9 @@ CompileComparisonOpCmd( Tcl_Token *tokenPtr; DefineLineInformation; /* TIP #280 */ + /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords < 3) { - PushLiteral(envPtr, "1", 1); + PUSH("1"); } else if (parsePtr->numWords == 3) { tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); @@ -3429,7 +3645,7 @@ CompileComparisonOpCmd( return TCL_ERROR; } else { - int tmpIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr); + int tmpIndex = AnonymousLocal(envPtr); int words; tokenPtr = TokenAfter(parsePtr->tokenPtr); @@ -3586,7 +3802,7 @@ TclCompilePowOpCmd( CompileWord(envPtr, tokenPtr, interp, words); } if (parsePtr->numWords <= 2) { - PushLiteral(envPtr, "1", 1); + PUSH("1"); words++; } while (--words > 1) { @@ -3751,6 +3967,7 @@ TclCompileMinusOpCmd( DefineLineInformation; /* TIP #280 */ int words; + /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords == 1) { /* * Fallback to direct eval to report syntax error. @@ -3796,6 +4013,7 @@ TclCompileDivOpCmd( DefineLineInformation; /* TIP #280 */ int words; + /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords == 1) { /* * Fallback to direct eval to report syntax error. @@ -3804,7 +4022,7 @@ TclCompileDivOpCmd( return TCL_ERROR; } if (parsePtr->numWords == 2) { - PushLiteral(envPtr, "1.0", 3); + PUSH("1.0"); } for (words=1 ; words<parsePtr->numWords ; words++) { tokenPtr = TokenAfter(tokenPtr); diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 890d518..94c1bd6 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -490,13 +490,6 @@ typedef struct JumpList { JumpFixup jump; /* Pass this argument to matching calls of * TclEmitForwardJump() and * TclFixupForwardJump(). */ - int depth; /* Remember the currStackDepth of the - * CompileEnv here. */ - int offset; /* Data used to compute jump lengths to pass - * to TclFixupForwardJump() */ - int convert; /* Temporary storage used to compute whether - * numeric conversion will be needed following - * the operator we're compiling. */ struct JumpList *next; /* Point to next item on the stack */ } JumpList; @@ -2207,7 +2200,7 @@ ExecConstantExprTree( TclInitByteCodeObj(byteCodeObj, envPtr); TclFreeCompileEnv(envPtr); TclStackFree(interp, envPtr); - byteCodePtr = byteCodeObj->internalRep.otherValuePtr; + byteCodePtr = byteCodeObj->internalRep.twoPtrValue.ptr1; TclNRExecuteByteCode(interp, byteCodePtr); code = TclNRRunCallbacks(interp, TCL_OK, rootPtr); Tcl_DecrRefCount(byteCodeObj); @@ -2261,30 +2254,8 @@ CompileExprTree( if (nodePtr->mark == MARK_LEFT) { next = nodePtr->left; - switch (nodePtr->lexeme) { - case QUESTION: - newJump = TclStackAlloc(interp, sizeof(JumpList)); - newJump->next = jumpPtr; - jumpPtr = newJump; - newJump = TclStackAlloc(interp, sizeof(JumpList)); - newJump->next = jumpPtr; - jumpPtr = newJump; - jumpPtr->depth = envPtr->currStackDepth; + if (nodePtr->lexeme == QUESTION) { convert = 1; - break; - case AND: - case OR: - newJump = TclStackAlloc(interp, sizeof(JumpList)); - newJump->next = jumpPtr; - jumpPtr = newJump; - newJump = TclStackAlloc(interp, sizeof(JumpList)); - newJump->next = jumpPtr; - jumpPtr = newJump; - newJump = TclStackAlloc(interp, sizeof(JumpList)); - newJump->next = jumpPtr; - jumpPtr = newJump; - jumpPtr->depth = envPtr->currStackDepth; - break; } } else if (nodePtr->mark == MARK_RIGHT) { next = nodePtr->right; @@ -2317,25 +2288,35 @@ CompileExprTree( break; } case QUESTION: + newJump = TclStackAlloc(interp, sizeof(JumpList)); + newJump->next = jumpPtr; + jumpPtr = newJump; TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump); break; case COLON: - CLANG_ASSERT(jumpPtr); + newJump = TclStackAlloc(interp, sizeof(JumpList)); + newJump->next = jumpPtr; + jumpPtr = newJump; TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, - &jumpPtr->next->jump); - envPtr->currStackDepth = jumpPtr->depth; - jumpPtr->offset = (envPtr->codeNext - envPtr->codeStart); - jumpPtr->convert = convert; + &jumpPtr->jump); + TclAdjustStackDepth(-1, envPtr); + if (convert) { + jumpPtr->jump.jumpType = TCL_TRUE_JUMP; + } convert = 1; break; case AND: - TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump); - break; case OR: - TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &jumpPtr->jump); + newJump = TclStackAlloc(interp, sizeof(JumpList)); + newJump->next = jumpPtr; + jumpPtr = newJump; + TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND) + ? TCL_FALSE_JUMP : TCL_TRUE_JUMP, &jumpPtr->jump); break; } } else { + int pc1, pc2, target; + switch (nodePtr->lexeme) { case START: case QUESTION: @@ -2354,9 +2335,9 @@ CompileExprTree( */ if (numWords < 255) { - TclEmitInstInt1(INST_INVOKE_STK1, numWords, envPtr); + TclEmitInvoke(envPtr, INST_INVOKE_STK1, numWords); } else { - TclEmitInstInt4(INST_INVOKE_STK4, numWords, envPtr); + TclEmitInvoke(envPtr, INST_INVOKE_STK4, numWords); } /* @@ -2375,18 +2356,20 @@ CompileExprTree( break; case COLON: CLANG_ASSERT(jumpPtr); - if (TclFixupForwardJump(envPtr, &jumpPtr->next->jump, - (envPtr->codeNext - envPtr->codeStart) - - jumpPtr->next->jump.codeOffset, 127)) { - jumpPtr->offset += 3; + if (jumpPtr->jump.jumpType == TCL_TRUE_JUMP) { + jumpPtr->jump.jumpType = TCL_UNCONDITIONAL_JUMP; + convert = 1; + } + target = jumpPtr->jump.codeOffset + 2; + if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) { + target += 3; } - 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); + TclFixupForwardJump(envPtr, &jumpPtr->jump, + target - jumpPtr->jump.codeOffset, 127); + freePtr = jumpPtr; jumpPtr = jumpPtr->next; TclStackFree(interp, freePtr); @@ -2394,29 +2377,24 @@ CompileExprTree( case AND: case OR: CLANG_ASSERT(jumpPtr); - TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND) - ? TCL_FALSE_JUMP : TCL_TRUE_JUMP, - &jumpPtr->next->jump); + pc1 = CurrentOffset(envPtr); + TclEmitInstInt1((nodePtr->lexeme == AND) ? INST_JUMP_FALSE1 + : INST_JUMP_TRUE1, 0, envPtr); 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); + pc2 = CurrentOffset(envPtr); + TclEmitInstInt1(INST_JUMP1, 0, envPtr); + TclAdjustStackDepth(-1, envPtr); + TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc1, + envPtr->codeStart + pc1 + 1); if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) { - jumpPtr->next->next->jump.codeOffset += 3; + pc2 += 3; } TclEmitPush(TclRegisterNewLiteral(envPtr, (nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr); - TclFixupForwardJumpToHere(envPtr, &jumpPtr->next->next->jump, - 127); + TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc2, + envPtr->codeStart + pc2 + 1); 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); @@ -2445,14 +2423,11 @@ CompileExprTree( Tcl_Obj *literal = *litObjv; if (optimize) { - int length, index; + int length; const char *bytes = TclGetStringFromObj(literal, &length); - LiteralEntry *lePtr; - Tcl_Obj *objPtr; - - index = TclRegisterNewLiteral(envPtr, bytes, length); - lePtr = envPtr->literalArrayPtr + index; - objPtr = lePtr->objPtr; + int index = TclRegisterNewLiteral(envPtr, bytes, length); + Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index); + if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) { /* * Would like to do this: @@ -2488,8 +2463,7 @@ CompileExprTree( break; } case OT_TOKENS: - TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents, - envPtr); + CompileTokens(envPtr, tokenPtr, interp); tokenPtr += tokenPtr->numComponents + 1; break; default: @@ -2511,7 +2485,7 @@ CompileExprTree( index = TclRegisterNewLiteral(envPtr, objPtr->bytes, objPtr->length); - tableValue = envPtr->literalArrayPtr[index].objPtr; + tableValue = TclFetchLiteral(envPtr, index); if ((tableValue->typePtr == NULL) && (objPtr->typePtr != NULL)) { /* diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 3ee7f3b..ee67e24 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -14,6 +14,7 @@ #include "tclInt.h" #include "tclCompile.h" +#include <assert.h> /* * Table of all AuxData types. @@ -62,7 +63,7 @@ InstructionDesc const tclInstructionTable[] = { /* Pop the topmost stack object */ {"dup", 1, +1, 0, {OPERAND_NONE}}, /* Duplicate the topmost stack object and push the result */ - {"concat1", 2, INT_MIN, 1, {OPERAND_UINT1}}, + {"strcat", 2, INT_MIN, 1, {OPERAND_UINT1}}, /* Concatenate the top op1 items and push result */ {"invokeStk1", 2, INT_MIN, 1, {OPERAND_UINT1}}, /* Invoke command named objv[0]; <objc,objv> = <op1,top op1> */ @@ -309,7 +310,7 @@ InstructionDesc const tclInstructionTable[] = { {"pushReturnOpts", 1, +1, 0, {OPERAND_NONE}}, /* Push the interpreter's return option dictionary as an object on the * stack. */ - {"returnStk", 1, -2, 0, {OPERAND_NONE}}, + {"returnStk", 1, -1, 0, {OPERAND_NONE}}, /* Compiled [return]; options and result are on the stack, code and * level are in the options. */ @@ -382,7 +383,8 @@ InstructionDesc const tclInstructionTable[] = { /* 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. */ + /* Compiled bytecodes to signal syntax error. Equivalent to returnImm + * except for the ERR_ALREADY_LOGGED flag in the interpreter. */ {"reverse", 5, 0, 1, {OPERAND_UINT4}}, /* Reverse the order of the arg elements at the top of stack */ @@ -430,7 +432,7 @@ InstructionDesc const tclInstructionTable[] = { /* Map variable contents back into a dictionary in a variable. Part of * [dict with]. * Stack: ... dictVarName path keyList => ... */ - {"dictRecombineImm", 1, -2, 1, {OPERAND_LVT4}}, + {"dictRecombineImm", 5, -2, 1, {OPERAND_LVT4}}, /* Map variable contents back into a dictionary in the local variable * indicated by the LVT index. Part of [dict with]. * Stack: ... path keyList => ... */ @@ -535,6 +537,86 @@ InstructionDesc const tclInstructionTable[] = { * the word at the top of the stack; * <objc,objv> = <op4,top op4 after popping 1> */ + {"listConcat", 1, -1, 0, {OPERAND_NONE}}, + /* Concatenates the two lists at the top of the stack into a single + * list and pushes that resulting list onto the stack. + * Stack: ... list1 list2 => ... [lconcat list1 list2] */ + + {"expandDrop", 1, 0, 0, {OPERAND_NONE}}, + /* Drops an element from the auxiliary stack, popping stack elements + * until the matching stack depth is reached. */ + + /* New foreach implementation */ + {"foreach_start", 5, +2, 1, {OPERAND_AUX4}}, + /* Initialize execution of a foreach loop. Operand is aux data index + * of the ForeachInfo structure for the foreach command. It pushes 2 + * elements which hold runtime params for foreach_step, they are later + * dropped by foreach_end together with the value lists. NOTE that the + * iterator-tracker and info reference must not be passed to bytecodes + * that handle normal Tcl values. NOTE that this instruction jumps to + * the foreach_step instruction paired with it; the stack info below + * is only nominal. + * Stack: ... listObjs... => ... listObjs... iterTracker info */ + {"foreach_step", 1, 0, 0, {OPERAND_NONE}}, + /* "Step" or begin next iteration of foreach loop. Assigns to foreach + * iteration variables. May jump to straight after the foreach_start + * that pushed the iterTracker and info values. MUST be followed + * immediately by a foreach_end. + * Stack: ... listObjs... iterTracker info => + * ... listObjs... iterTracker info */ + {"foreach_end", 1, 0, 0, {OPERAND_NONE}}, + /* Clean up a foreach loop by dropping the info value, the tracker + * value and the lists that were being iterated over. + * Stack: ... listObjs... iterTracker info => ... */ + {"lmap_collect", 1, -1, 0, {OPERAND_NONE}}, + /* Appends the value at the top of the stack to the list located on + * the stack the "other side" of the foreach-related values. + * Stack: ... collector listObjs... iterTracker info value => + * ... collector listObjs... iterTracker info */ + + {"strtrim", 1, -1, 0, {OPERAND_NONE}}, + /* [string trim] core: removes the characters (designated by the value + * at the top of the stack) from both ends of the string and pushes + * the resulting string. + * Stack: ... string charset => ... trimmedString */ + {"strtrimLeft", 1, -1, 0, {OPERAND_NONE}}, + /* [string trimleft] core: removes the characters (designated by the + * value at the top of the stack) from the left of the string and + * pushes the resulting string. + * Stack: ... string charset => ... trimmedString */ + {"strtrimRight", 1, -1, 0, {OPERAND_NONE}}, + /* [string trimright] core: removes the characters (designated by the + * value at the top of the stack) from the right of the string and + * pushes the resulting string. + * Stack: ... string charset => ... trimmedString */ + + {"concatStk", 5, INT_MIN, 1, {OPERAND_UINT4}}, + /* Wrapper round Tcl_ConcatObj(), used for [concat] and [eval]. opnd + * is number of values to concatenate. + * Operation: push concat(stk1 stk2 ... stktop) */ + + {"strcaseUpper", 1, 0, 0, {OPERAND_NONE}}, + /* [string toupper] core: converts whole string to upper case using + * the default (extended "C" locale) rules. + * Stack: ... string => ... newString */ + {"strcaseLower", 1, 0, 0, {OPERAND_NONE}}, + /* [string tolower] core: converts whole string to upper case using + * the default (extended "C" locale) rules. + * Stack: ... string => ... newString */ + {"strcaseTitle", 1, 0, 0, {OPERAND_NONE}}, + /* [string totitle] core: converts whole string to upper case using + * the default (extended "C" locale) rules. + * Stack: ... string => ... newString */ + {"strreplace", 1, -3, 0, {OPERAND_NONE}}, + /* [string replace] core: replaces a non-empty range of one string + * with the contents of another. + * Stack: ... string fromIdx toIdx replacement => ... newString */ + + {"originCmd", 1, 0, 0, {OPERAND_NONE}}, + /* Reports which command was the origin (via namespace import chain) + * of the command named on the top of the stack. + * Stack: ... cmdName => ... fullOriginalCmdName */ + {"tclooNext", 2, INT_MIN, 1, {OPERAND_UINT1}}, /* Push the identity of the current TclOO object (i.e., the name of * its current public access command) on the stack. */ @@ -559,11 +641,15 @@ static void EnterCmdStartData(CompileEnv *envPtr, static void FreeByteCodeInternalRep(Tcl_Obj *objPtr); static void FreeSubstCodeInternalRep(Tcl_Obj *objPtr); static int GetCmdLocEncodingSize(CompileEnv *envPtr); +static int IsCompactibleCompileEnv(Tcl_Interp *interp, + CompileEnv *envPtr); #ifdef TCL_COMPILE_STATS static void RecordByteCodeStats(ByteCode *codePtr); #endif /* TCL_COMPILE_STATS */ +static void RegisterAuxDataType(const AuxDataType *typePtr); static int SetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); +static void StartExpanding(CompileEnv *envPtr); static int FormatInstruction(ByteCode *codePtr, const unsigned char *pc, Tcl_Obj *bufferObj); static void PrintSourceToObj(Tcl_Obj *appendObj, @@ -578,6 +664,7 @@ static void EnterCmdWordData(ExtCmdLoc *eclPtr, int srcOffset, Tcl_Token *tokenPtr, const char *cmd, int len, int numWords, int line, int *clNext, int **lines, CompileEnv *envPtr); +static void ReleaseCmdWordData(ExtCmdLoc *eclPtr); /* * The structure below defines the bytecode Tcl object type by means of @@ -617,6 +704,13 @@ static const Tcl_ObjType tclInstNameType = { UpdateStringOfInstName, /* updateStringProc */ NULL, /* setFromAnyProc */ }; + +/* + * Helper macros. + */ + +#define TclIncrUInt4AtPtr(ptr, delta) \ + TclStoreInt4AtPtr(TclGetUInt4AtPtr(ptr)+(delta), (ptr)); /* *---------------------------------------------------------------------- @@ -655,11 +749,9 @@ TclSetByteCodeFromAny( Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated * in frame. */ - register const AuxData *auxDataPtr; - LiteralEntry *entryPtr; - register int i; int length, result = TCL_OK; const char *stringPtr; + Proc *procPtr = iPtr->compiledProcPtr; ContLineLoc *clLocPtr; #ifdef TCL_COMPILE_DEBUG @@ -697,9 +789,7 @@ TclSetByteCodeFromAny( clLocPtr = TclContinuationsGet(objPtr); if (clLocPtr) { - compEnv.clLoc = clLocPtr; - compEnv.clNext = &compEnv.clLoc->loc[0]; - Tcl_Preserve(compEnv.clLoc); + compEnv.clNext = &clLocPtr->loc[0]; } TclCompileScript(interp, stringPtr, length, &compEnv); @@ -711,6 +801,40 @@ TclSetByteCodeFromAny( TclEmitOpcode(INST_DONE, &compEnv); /* + * Check for optimizations! + * + * Test if the generated code is free of most hazards; if so, recompile + * but with generation of INST_START_CMD disabled. This produces somewhat + * faster code in some cases, and more compact code in more. + */ + + if (Tcl_GetMaster(interp) == NULL && + !Tcl_LimitTypeEnabled(interp, TCL_LIMIT_COMMANDS|TCL_LIMIT_TIME) + && IsCompactibleCompileEnv(interp, &compEnv)) { + TclFreeCompileEnv(&compEnv); + iPtr->compiledProcPtr = procPtr; + TclInitCompileEnv(interp, &compEnv, stringPtr, length, + iPtr->invokeCmdFramePtr, iPtr->invokeWord); + if (clLocPtr) { + compEnv.clNext = &clLocPtr->loc[0]; + } + compEnv.atCmdStart = 2; /* The disabling magic. */ + TclCompileScript(interp, stringPtr, length, &compEnv); + assert (compEnv.atCmdStart > 1); + TclEmitOpcode(INST_DONE, &compEnv); + assert (compEnv.atCmdStart > 1); + } + + /* + * Apply some peephole optimizations that can cross specific/generic + * instruction generator boundaries. + */ + + if (iPtr->extra.optimizer) { + (iPtr->extra.optimizer)(&compEnv); + } + + /* * Invoke the compilation hook procedure if one exists. */ @@ -727,35 +851,14 @@ TclSetByteCodeFromAny( TclVerifyLocalLiteralTable(&compEnv); #endif /*TCL_COMPILE_DEBUG*/ - TclInitByteCodeObj(objPtr, &compEnv); -#ifdef TCL_COMPILE_DEBUG - if (tclTraceCompile >= 2) { - TclPrintByteCodeObj(interp, objPtr); - fflush(stdout); - } -#endif /* TCL_COMPILE_DEBUG */ - - if (result != TCL_OK) { - /* - * Handle any error from the hookProc - */ - - entryPtr = compEnv.literalArrayPtr; - for (i = 0; i < compEnv.literalArrayNext; i++) { - TclReleaseLiteral(interp, entryPtr->objPtr); - entryPtr++; - } + if (result == TCL_OK) { + TclInitByteCodeObj(objPtr, &compEnv); #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++; + if (tclTraceCompile >= 2) { + TclPrintByteCodeObj(interp, objPtr); + fflush(stdout); } +#endif /* TCL_COMPILE_DEBUG */ } TclFreeCompileEnv(&compEnv); @@ -794,8 +897,7 @@ SetByteCodeFromAny( if (interp == NULL) { return TCL_ERROR; } - TclSetByteCodeFromAny(interp, objPtr, NULL, NULL); - return TCL_OK; + return TclSetByteCodeFromAny(interp, objPtr, NULL, NULL); } /* @@ -849,10 +951,9 @@ static void FreeByteCodeInternalRep( register Tcl_Obj *objPtr) /* Object whose internal rep to free. */ { - register ByteCode *codePtr = objPtr->internalRep.otherValuePtr; + register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1; objPtr->typePtr = NULL; - objPtr->internalRep.otherValuePtr = NULL; codePtr->refCount--; if (codePtr->refCount <= 0) { TclCleanupByteCode(codePtr); @@ -872,9 +973,8 @@ FreeByteCodeInternalRep( * None. * * Side effects: - * Frees objPtr's bytecode internal representation and sets its type and - * objPtr->internalRep.otherValuePtr NULL. Also releases its literals and - * frees its auxiliary data items. + * Frees objPtr's bytecode internal representation and sets its type NULL + * Also releases its literals and frees its auxiliary data items. * *---------------------------------------------------------------------- */ @@ -949,7 +1049,7 @@ TclCleanupByteCode( * released. */ - if ((codePtr->flags & TCL_BYTECODE_PRECOMPILED) || (interp == NULL)) { + if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) { objArrayPtr = codePtr->objArrayPtr; for (i = 0; i < numLitObjects; i++) { @@ -962,17 +1062,9 @@ TclCleanupByteCode( codePtr->numLitObjects = 0; } else { objArrayPtr = codePtr->objArrayPtr; - for (i = 0; i < numLitObjects; i++) { - /* - * TclReleaseLiteral sets a ByteCode's object array entry NULL to - * indicate that it has already freed the literal. - */ - - objPtr = *objArrayPtr; - if (objPtr != NULL) { - TclReleaseLiteral(interp, objPtr); - } - objArrayPtr++; + while (numLitObjects--) { + /* TclReleaseLiteral calls Tcl_DecrRefCount() for us */ + TclReleaseLiteral(interp, *objArrayPtr++); } } @@ -997,22 +1089,7 @@ TclCleanupByteCode( (char *) codePtr); if (hePtr) { - ExtCmdLoc *eclPtr = Tcl_GetHashValue(hePtr); - - if (eclPtr->type == TCL_LOCATION_SOURCE) { - Tcl_DecrRefCount(eclPtr->path); - } - for (i=0 ; i<eclPtr->nuloc ; i++) { - ckfree(eclPtr->loc[i].line); - } - - if (eclPtr->loc != NULL) { - ckfree(eclPtr->loc); - } - - Tcl_DeleteHashTable(&eclPtr->litInfo); - - ckfree(eclPtr); + ReleaseCmdWordData(Tcl_GetHashValue(hePtr)); Tcl_DeleteHashEntry(hePtr); } } @@ -1026,6 +1103,77 @@ TclCleanupByteCode( } /* + * --------------------------------------------------------------------- + * + * IsCompactibleCompileEnv -- + * + * Checks to see if we may apply some basic compaction optimizations to a + * piece of bytecode. Idempotent. + * + * --------------------------------------------------------------------- + */ + +static int +IsCompactibleCompileEnv( + Tcl_Interp *interp, + CompileEnv *envPtr) +{ + unsigned char *pc; + int size; + + /* + * Special: procedures in the '::tcl' namespace (or its children) are + * considered to be well-behaved and so can have compaction applied even + * if it would otherwise be invalid. + */ + + if (envPtr->procPtr != NULL && envPtr->procPtr->cmdPtr != NULL + && envPtr->procPtr->cmdPtr->nsPtr != NULL) { + Namespace *nsPtr = envPtr->procPtr->cmdPtr->nsPtr; + + if (strcmp(nsPtr->fullName, "::tcl") == 0 + || strncmp(nsPtr->fullName, "::tcl::", 7) == 0) { + return 1; + } + } + + /* + * Go through and ensure that no operation involved can cause a desired + * change of bytecode sequence during running. This comes down to ensuring + * that there are no mapped variables (due to traces) or calls to external + * commands (traces, [uplevel] trickery). This is actually a very + * conservative check; it turns down a lot of code that is OK in practice. + */ + + for (pc = envPtr->codeStart ; pc < envPtr->codeNext ; pc += size) { + switch (*pc) { + /* Invokes */ + case INST_INVOKE_STK1: + case INST_INVOKE_STK4: + case INST_INVOKE_EXPANDED: + case INST_INVOKE_REPLACE: + return 0; + /* Runtime evals */ + case INST_EVAL_STK: + case INST_EXPR_STK: + case INST_YIELD: + return 0; + /* Upvars */ + case INST_UPVAR: + case INST_NSUPVAR: + case INST_VARIABLE: + return 0; + default: + size = tclInstructionTable[*pc].numBytes; + assert (size > 0); + break; + } + } + + return 1; +} + +/* *---------------------------------------------------------------------- * * Tcl_SubstObj -- @@ -1149,14 +1297,19 @@ CompileSubstObj( objPtr->typePtr = &substCodeType; TclFreeCompileEnv(&compEnv); - codePtr = objPtr->internalRep.otherValuePtr; + codePtr = objPtr->internalRep.twoPtrValue.ptr1; objPtr->internalRep.ptrAndLongRep.ptr = codePtr; objPtr->internalRep.ptrAndLongRep.value = flags; if (iPtr->varFramePtr->localCachePtr) { codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr; codePtr->localCachePtr->refCount++; } - /* TODO: Debug printing? */ +#ifdef TCL_COMPILE_DEBUG + if (tclTraceCompile >= 2) { + TclPrintByteCodeObj(interp, objPtr); + fflush(stdout); + } +#endif /* TCL_COMPILE_DEBUG */ } return codePtr; } @@ -1188,12 +1341,31 @@ FreeSubstCodeInternalRep( register ByteCode *codePtr = objPtr->internalRep.ptrAndLongRep.ptr; objPtr->typePtr = NULL; - objPtr->internalRep.otherValuePtr = NULL; codePtr->refCount--; if (codePtr->refCount <= 0) { TclCleanupByteCode(codePtr); } } + +static void +ReleaseCmdWordData( + ExtCmdLoc *eclPtr) +{ + int i; + + if (eclPtr->type == TCL_LOCATION_SOURCE) { + Tcl_DecrRefCount(eclPtr->path); + } + for (i=0 ; i<eclPtr->nuloc ; i++) { + ckfree((char *) eclPtr->loc[i].line); + } + + if (eclPtr->loc != NULL) { + ckfree((char *) eclPtr->loc); + } + + ckfree((char *) eclPtr); +} /* *---------------------------------------------------------------------- @@ -1226,6 +1398,8 @@ TclInitCompileEnv( { Interp *iPtr = (Interp *) interp; + assert(tclInstructionTable[LAST_INST_OPCODE+1].name == NULL); + envPtr->iPtr = iPtr; envPtr->source = stringPtr; envPtr->numSrcBytes = numBytes; @@ -1249,6 +1423,7 @@ TclInitCompileEnv( envPtr->mallocedLiteralArray = 0; envPtr->exceptArrayPtr = envPtr->staticExceptArraySpace; + envPtr->exceptAuxArrayPtr = envPtr->staticExAuxArraySpace; envPtr->exceptArrayNext = 0; envPtr->exceptArrayEnd = COMPILEENV_INIT_EXCEPT_RANGES; envPtr->mallocedExceptArray = 0; @@ -1257,6 +1432,7 @@ TclInitCompileEnv( envPtr->cmdMapEnd = COMPILEENV_INIT_CMD_MAP_SIZE; envPtr->mallocedCmdMap = 0; envPtr->atCmdStart = 1; + envPtr->expandCount = 0; /* * TIP #280: Set up the extended command location information, based on @@ -1272,9 +1448,8 @@ TclInitCompileEnv( envPtr->extCmdMapPtr->nloc = 0; envPtr->extCmdMapPtr->nuloc = 0; envPtr->extCmdMapPtr->path = NULL; - Tcl_InitHashTable(&envPtr->extCmdMapPtr->litInfo, TCL_ONE_WORD_KEYS); - if ((invoker == NULL) || (invoker->type == TCL_LOCATION_EVAL_LIST)) { + if (invoker == NULL) { /* * Initialize the compiler for relative counting in case of a * dynamic context. @@ -1388,7 +1563,6 @@ TclInitCompileEnv( * data is available. */ - envPtr->clLoc = NULL; envPtr->clNext = NULL; envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace; @@ -1427,6 +1601,32 @@ TclFreeCompileEnv( ckfree(envPtr->localLitTable.buckets); envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets; } + if (envPtr->iPtr) { + /* + * We never converted to Bytecode, so free the things we would + * have transferred to it. + */ + + int i; + LiteralEntry *entryPtr = envPtr->literalArrayPtr; + AuxData *auxDataPtr = envPtr->auxDataArrayPtr; + + for (i = 0; i < envPtr->literalArrayNext; i++) { + TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, entryPtr->objPtr); + entryPtr++; + } + +#ifdef TCL_COMPILE_DEBUG + TclVerifyGlobalLiteralTable(envPtr->iPtr); +#endif /*TCL_COMPILE_DEBUG*/ + + for (i = 0; i < envPtr->auxDataArrayNext; i++) { + if (auxDataPtr->type->freeProc != NULL) { + auxDataPtr->type->freeProc(auxDataPtr->clientData); + } + auxDataPtr++; + } + } if (envPtr->mallocedCodeArray) { ckfree(envPtr->codeStart); } @@ -1435,6 +1635,7 @@ TclFreeCompileEnv( } if (envPtr->mallocedExceptArray) { ckfree(envPtr->exceptArrayPtr); + ckfree(envPtr->exceptAuxArrayPtr); } if (envPtr->mallocedCmdMap) { ckfree(envPtr->cmdMapPtr); @@ -1443,17 +1644,8 @@ TclFreeCompileEnv( ckfree(envPtr->auxDataArrayPtr); } if (envPtr->extCmdMapPtr) { - ckfree(envPtr->extCmdMapPtr); - } - - /* - * If we used data about invisible continuation lines, then now is the - * time to release on our hold on it. The lock was set in function - * TclSetByteCodeFromAny(), found in this file. - */ - - if (envPtr->clLoc) { - Tcl_Release(envPtr->clLoc); + ReleaseCmdWordData(envPtr->extCmdMapPtr); + envPtr->extCmdMapPtr = NULL; } } @@ -1555,474 +1747,467 @@ TclWordKnownAtCompileTime( *---------------------------------------------------------------------- */ +static int +ExpandRequested( + Tcl_Token *tokenPtr, + int numWords) +{ + /* Determine whether any words of the command require expansion */ + while (numWords--) { + if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { + return 1; + } + tokenPtr = TokenAfter(tokenPtr); + } + return 0; +} + +static void +CompileCmdLiteral( + Tcl_Interp *interp, + Tcl_Obj *cmdObj, + CompileEnv *envPtr) +{ + int numBytes; + const char *bytes = Tcl_GetStringFromObj(cmdObj, &numBytes); + int cmdLitIdx = TclRegisterNewCmdLiteral(envPtr, bytes, numBytes); + Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj); + + if (cmdPtr) { + TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr); + } + TclEmitPush(cmdLitIdx, envPtr); +} + void -TclCompileScript( - Tcl_Interp *interp, /* Used for error and status reporting. Also - * serves as context for finding and compiling - * commands. May not be NULL. */ - const char *script, /* The source script to compile. */ - int numBytes, /* Number of bytes in script. If < 0, the - * script consists of all bytes up to the - * first null character. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ +TclCompileInvocation( + Tcl_Interp *interp, + Tcl_Token *tokenPtr, + Tcl_Obj *cmdObj, + int numWords, + CompileEnv *envPtr) { - Interp *iPtr = (Interp *) interp; - int lastTopLevelCmdIndex = -1; - /* Index of most recent toplevel command in - * the command location table. Initialized to - * avoid compiler warning. */ - int startCodeOffset = -1; /* Offset of first byte of current command's - * code. Init. to avoid compiler warning. */ - unsigned char *entryCodeNext = envPtr->codeNext; - const char *p, *next; - Namespace *cmdNsPtr; - Command *cmdPtr; - Tcl_Token *tokenPtr; - int bytesLeft, isFirstCmd, wordIdx, currCmdIndex, commandLength, objIndex; - Tcl_DString ds; - /* TIP #280 */ - ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; - int *wlines, wlineat, cmdLine, *clNext; - Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); + int wordIdx = 0, depth = TclGetStackDepth(envPtr); + DefineLineInformation; - Tcl_DStringInit(&ds); + if (cmdObj) { + CompileCmdLiteral(interp, cmdObj, envPtr); + wordIdx = 1; + tokenPtr = TokenAfter(tokenPtr); + } - if (numBytes < 0) { - numBytes = strlen(script); + for (; wordIdx < numWords; wordIdx++, tokenPtr = TokenAfter(tokenPtr)) { + int objIdx; + + SetLineInformation(wordIdx); + + if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + CompileTokens(envPtr, tokenPtr, interp); + continue; + } + + objIdx = TclRegisterNewLiteral(envPtr, + tokenPtr[1].start, tokenPtr[1].size); + if (envPtr->clNext) { + TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx), + tokenPtr[1].start - envPtr->source, envPtr->clNext); + } + TclEmitPush(objIdx, envPtr); } - Tcl_ResetResult(interp); - isFirstCmd = 1; - if (envPtr->procPtr != NULL) { - cmdNsPtr = envPtr->procPtr->cmdPtr->nsPtr; + if (wordIdx <= 255) { + TclEmitInvoke(envPtr, INST_INVOKE_STK1, wordIdx); } else { - cmdNsPtr = NULL; /* use current NS */ + TclEmitInvoke(envPtr, INST_INVOKE_STK4, wordIdx); } + TclCheckStackDepth(depth+1, envPtr); +} - /* - * Each iteration through the following loop compiles the next command - * from the script. - */ +static void +CompileExpanded( + Tcl_Interp *interp, + Tcl_Token *tokenPtr, + Tcl_Obj *cmdObj, + int numWords, + CompileEnv *envPtr) +{ + int wordIdx = 0; + DefineLineInformation; + int depth = TclGetStackDepth(envPtr); + + StartExpanding(envPtr); + if (cmdObj) { + CompileCmdLiteral(interp, cmdObj, envPtr); + wordIdx = 1; + tokenPtr = TokenAfter(tokenPtr); + } - p = script; - bytesLeft = numBytes; - cmdLine = envPtr->line; - clNext = envPtr->clNext; - do { - if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) { - /* - * Compile bytecodes to report the parse error at runtime. - */ + for (; wordIdx < numWords; wordIdx++, tokenPtr = TokenAfter(tokenPtr)) { + int objIdx; - Tcl_LogCommandInfo(interp, script, parsePtr->commandStart, - /* Drop the command terminator (";","]") if appropriate */ - (parsePtr->term == - parsePtr->commandStart + parsePtr->commandSize - 1)? - parsePtr->commandSize - 1 : parsePtr->commandSize); - TclCompileSyntaxError(interp, envPtr); - break; + SetLineInformation(wordIdx); + + if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + CompileTokens(envPtr, tokenPtr, interp); + if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { + TclEmitInstInt4(INST_EXPAND_STKTOP, + envPtr->currStackDepth, envPtr); + } + continue; } - /* - * TIP #280: We have to count newlines before the command even in the - * degenerate case when the command has no words. (See test - * info-30.33). - * So make that counting here, and not in the (numWords > 0) branch - * below. - */ + objIdx = TclRegisterNewLiteral(envPtr, + tokenPtr[1].start, tokenPtr[1].size); + if (envPtr->clNext) { + TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx), + tokenPtr[1].start - envPtr->source, envPtr->clNext); + } + TclEmitPush(objIdx, envPtr); + } - TclAdvanceLines(&cmdLine, p, parsePtr->commandStart); - TclAdvanceContinuations(&cmdLine, &clNext, - parsePtr->commandStart - envPtr->source); + /* + * The stack depth during argument expansion can only be managed at + * runtime, as the number of elements in the expanded lists is not known + * at compile time. We adjust here the stack depth estimate so that it is + * correct after the command with expanded arguments returns. + * + * The end effect of this command's invocation is that all the words of + * the command are popped from the stack, and the result is pushed: the + * stack top changes by (1-wordIdx). + * + * Note that the estimates are not correct while the command is being + * prepared and run, INST_EXPAND_STKTOP is not stack-neutral in general. + */ - if (parsePtr->numWords > 0) { - int expand = 0; /* Set if there are dynamic expansions to - * handle */ + TclEmitInvoke(envPtr, INST_INVOKE_EXPANDED, wordIdx); + TclCheckStackDepth(depth+1, envPtr); +} - /* - * If not the first command, pop the previous command's result - * and, if we're compiling a top level command, update the last - * command's code size to account for the pop instruction. - */ +static int +CompileCmdCompileProc( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + Command *cmdPtr, + CompileEnv *envPtr) +{ + int unwind = 0, incrOffset = -1; + DefineLineInformation; + int depth = TclGetStackDepth(envPtr); - if (!isFirstCmd) { - TclEmitOpcode(INST_POP, envPtr); - envPtr->cmdMapPtr[lastTopLevelCmdIndex].numCodeBytes = - (envPtr->codeNext - envPtr->codeStart) - - startCodeOffset; - } + /* + * Emit of the INST_START_CMD instruction is controlled by the value of + * envPtr->atCmdStart: + * + * atCmdStart == 2 : We are not using the INST_START_CMD instruction. + * atCmdStart == 1 : INST_START_CMD was the last instruction emitted. + * : We do not need to emit another. Instead we + * : increment the number of cmds started at it (except + * : for the special case at the start of a script.) + * atCmdStart == 0 : The last instruction was something else. We need + * : to emit INST_START_CMD here. + */ + + switch (envPtr->atCmdStart) { + case 0: + unwind = tclInstructionTable[INST_START_CMD].numBytes; + TclEmitInstInt4(INST_START_CMD, 0, envPtr); + incrOffset = envPtr->codeNext - envPtr->codeStart; + TclEmitInt4(0, envPtr); + break; + case 1: + if (envPtr->codeNext > envPtr->codeStart) { + incrOffset = envPtr->codeNext - 4 - envPtr->codeStart; + } + break; + case 2: + /* Nothing to do */ + ; + } + if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, 1, cmdPtr, envPtr)) { + if (incrOffset >= 0) { /* - * Determine the actual length of the command. + * We successfully compiled a command. Increment the number of + * commands that start at the currently active INST_START_CMD. */ - commandLength = parsePtr->commandSize; - if (parsePtr->term == parsePtr->commandStart + commandLength-1) { - /* - * The command terminator character (such as ; or ]) is the - * last character in the parsed command. Reduce the length by - * one so that the trace message doesn't include the - * terminator character. - */ + unsigned char *incrPtr = envPtr->codeStart + incrOffset; + unsigned char *startPtr = incrPtr - 5; - commandLength -= 1; + TclIncrUInt4AtPtr(incrPtr, 1); + if (unwind) { + /* We started the INST_START_CMD. Record the code length. */ + TclStoreInt4AtPtr(envPtr->codeNext - startPtr, startPtr + 1); } + } + TclCheckStackDepth(depth+1, envPtr); + return TCL_OK; + } -#ifdef TCL_COMPILE_DEBUG - /* - * If tracing, print a line for each top level command compiled. - */ + envPtr->codeNext -= unwind; /* Unwind INST_START_CMD */ - if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) { - fprintf(stdout, " Compiling: "); - TclPrintSource(stdout, parsePtr->commandStart, - TclMin(commandLength, 55)); - fprintf(stdout, "\n"); - } -#endif + /* + * Throw out any line information generated by the failed compile attempt. + */ - /* - * Check whether expansion has been requested for any of the - * words. - */ + while (mapPtr->nuloc - 1 > eclIndex) { + mapPtr->nuloc--; + ckfree(mapPtr->loc[mapPtr->nuloc].line); + mapPtr->loc[mapPtr->nuloc].line = NULL; + } - for (wordIdx = 0, tokenPtr = parsePtr->tokenPtr; - wordIdx < parsePtr->numWords; - wordIdx++, tokenPtr += tokenPtr->numComponents + 1) { - if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { - expand = 1; - break; - } - } + /* + * Reset the index of next command. Toss out any from failed nested + * partial compiles. + */ - envPtr->numCommands++; - currCmdIndex = envPtr->numCommands - 1; - lastTopLevelCmdIndex = currCmdIndex; - startCodeOffset = envPtr->codeNext - envPtr->codeStart; - EnterCmdStartData(envPtr, currCmdIndex, - parsePtr->commandStart - envPtr->source, startCodeOffset); + envPtr->numCommands = mapPtr->nuloc; + return TCL_ERROR; +} - /* - * Should only start issuing instructions after the "command has - * started" so that the command range is correct in the bytecode. - */ +static int +CompileCommandTokens( + Tcl_Interp *interp, + Tcl_Parse *parsePtr, + CompileEnv *envPtr) +{ + Interp *iPtr = (Interp *) interp; + Tcl_Token *tokenPtr = parsePtr->tokenPtr; + ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; + Tcl_Obj *cmdObj = Tcl_NewObj(); + Command *cmdPtr = NULL; + int code = TCL_ERROR; + int cmdKnown, expand = -1; + int *wlines, wlineat; + int cmdLine = envPtr->line; + int *clNext = envPtr->clNext; + int cmdIdx = envPtr->numCommands; + int startCodeOffset = envPtr->codeNext - envPtr->codeStart; + int depth = TclGetStackDepth(envPtr); + + assert (parsePtr->numWords > 0); + + /* Pre-Compile */ + + envPtr->numCommands++; + EnterCmdStartData(envPtr, cmdIdx, + parsePtr->commandStart - envPtr->source, startCodeOffset); - if (expand) { - TclEmitOpcode(INST_EXPAND_START, envPtr); - } + /* + * TIP #280. Scan the words and compute the extended location information. + * The map first contain full per-word line information for use by the + * compiler. This is later replaced by a reduced form which signals + * non-literal words, stored in 'wlines'. + */ - /* - * TIP #280. Scan the words and compute the extended location - * information. The map first contain full per-word line - * information for use by the compiler. This is later replaced by - * a reduced form which signals non-literal words, stored in - * 'wlines'. - */ + EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source, + parsePtr->tokenPtr, parsePtr->commandStart, + parsePtr->commandSize, parsePtr->numWords, cmdLine, + clNext, &wlines, envPtr); + wlineat = eclPtr->nuloc - 1; - EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source, - parsePtr->tokenPtr, parsePtr->commandStart, - parsePtr->commandSize, parsePtr->numWords, cmdLine, - clNext, &wlines, envPtr); - wlineat = eclPtr->nuloc - 1; + envPtr->line = eclPtr->loc[wlineat].line[0]; + envPtr->clNext = eclPtr->loc[wlineat].next[0]; + /* Do we know the command word? */ + Tcl_IncrRefCount(cmdObj); + tokenPtr = parsePtr->tokenPtr; + cmdKnown = TclWordKnownAtCompileTime(tokenPtr, cmdObj); + + /* Is this a command we should (try to) compile with a compileProc ? */ + if (cmdKnown && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) { + cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj); + if (cmdPtr) { /* - * Each iteration of the following loop compiles one word from the - * command. + * Found a command. Test the ways we can be told not to attempt + * to compile it. */ + if ((cmdPtr->compileProc == NULL) + || (cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION) + || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) { + cmdPtr = NULL; + } + } + if (cmdPtr && !(cmdPtr->flags & CMD_COMPILES_EXPANDED)) { + expand = ExpandRequested(parsePtr->tokenPtr, parsePtr->numWords); + if (expand) { + /* We need to expand, but compileProc cannot. */ + cmdPtr = NULL; + } + } + } - for (wordIdx = 0, tokenPtr = parsePtr->tokenPtr; - wordIdx < parsePtr->numWords; wordIdx++, - tokenPtr += tokenPtr->numComponents + 1) { - - envPtr->line = eclPtr->loc[wlineat].line[wordIdx]; - envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx]; - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - /* - * The word is not a simple string of characters. - */ + /* If cmdPtr != NULL, we will try to call cmdPtr->compileProc */ + if (cmdPtr) { + code = CompileCmdCompileProc(interp, parsePtr, cmdPtr, envPtr); + } - TclCompileTokens(interp, tokenPtr+1, - tokenPtr->numComponents, envPtr); - if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { - TclEmitInstInt4(INST_EXPAND_STKTOP, - envPtr->currStackDepth, envPtr); - } - continue; - } + if (code == TCL_ERROR) { + if (expand < 0) { + expand = ExpandRequested(parsePtr->tokenPtr, parsePtr->numWords); + } - /* - * This is a simple string of literal characters (i.e. we know - * it absolutely and can use it directly). If this is the - * first word and the command has a compile procedure, let it - * compile the command. - */ + if (expand) { + CompileExpanded(interp, parsePtr->tokenPtr, + cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr); + } else { + TclCompileInvocation(interp, parsePtr->tokenPtr, + cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr); + } + } - if ((wordIdx == 0) && !expand) { - /* - * We copy the string before trying to find the command by - * name. We used to modify the string in place, but this - * is not safe because the name resolution handlers could - * have side effects that rely on the unmodified string. - */ + Tcl_DecrRefCount(cmdObj); - TclDStringClear(&ds); - TclDStringAppendToken(&ds, &tokenPtr[1]); - - cmdPtr = (Command *) Tcl_FindCommand(interp, - Tcl_DStringValue(&ds), - (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0); - - if ((cmdPtr != NULL) - && (cmdPtr->compileProc != NULL) - && !(cmdPtr->nsPtr->flags&NS_SUPPRESS_COMPILATION) - && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES) - && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) { - int code, savedNumCmds = envPtr->numCommands; - unsigned savedCodeNext = - envPtr->codeNext - envPtr->codeStart; - int update = 0; -#ifdef TCL_COMPILE_DEBUG - int startStackDepth = envPtr->currStackDepth; -#endif + TclEmitOpcode(INST_POP, envPtr); + EnterCmdExtentData(envPtr, cmdIdx, + parsePtr->term - parsePtr->commandStart, + (envPtr->codeNext-envPtr->codeStart) - startCodeOffset); - /* - * Mark the start of the command; the proper bytecode - * length will be updated later. There is no need to - * do this for the first bytecode in the compile env, - * as the check is done before calling - * TclNRExecuteByteCode(). Do emit an INST_START_CMD in - * special cases where the first bytecode is in a - * loop, to insure that the corresponding command is - * counted properly. Compilers for commands able to - * produce such a beast (currently 'while 1' only) set - * envPtr->atCmdStart to 0 in order to signal this - * case. [Bug 1752146] - * - * Note that the environment is initialised with - * atCmdStart=1 to avoid emitting ISC for the first - * command. - */ - - if (envPtr->atCmdStart) { - if (savedCodeNext != 0) { - /* - * Increase the number of commands being - * started at the current point. Note that - * this depends on the exact layout of the - * INST_START_CMD's operands, so be careful! - */ - - unsigned char *fixPtr = envPtr->codeNext - 4; - - TclStoreInt4AtPtr(TclGetUInt4AtPtr(fixPtr)+1, - fixPtr); - } - } else { - TclEmitInstInt4(INST_START_CMD, 0, envPtr); - TclEmitInt4(1, envPtr); - update = 1; - } - - code = cmdPtr->compileProc(interp, parsePtr, cmdPtr, - envPtr); - - if (code == TCL_OK) { - /* - * Confirm that the command compiler generated a - * single value on the stack as its result. This - * is only done in debugging mode, as it *should* - * be correct and normal users have no reasonable - * way to fix it anyway. - */ + /* + * TIP #280: Free full form of per-word line data and insert the reduced + * form now + */ -#ifdef TCL_COMPILE_DEBUG - int diff = envPtr->currStackDepth-startStackDepth; - - if (diff != 1 && (diff != 0 || - *(envPtr->codeNext-1) != INST_DONE)) { - Tcl_Panic("bad stack adjustment when compiling" - " %.*s (was %d instead of 1)", - parsePtr->tokenPtr->size, - parsePtr->tokenPtr->start, diff); - } -#endif - if (update) { - /* - * Fix the bytecode length. - */ - - unsigned char *fixPtr = envPtr->codeStart - + savedCodeNext + 1; - unsigned fixLen = envPtr->codeNext - - envPtr->codeStart - savedCodeNext; - - TclStoreInt4AtPtr(fixLen, fixPtr); - } - goto finishCommand; - } - - if (envPtr->atCmdStart && savedCodeNext != 0) { - /* - * Decrease the number of commands being started - * at the current point. Note that this depends on - * the exact layout of the INST_START_CMD's - * operands, so be careful! - */ - - unsigned char *fixPtr = envPtr->codeNext - 4; - - TclStoreInt4AtPtr(TclGetUInt4AtPtr(fixPtr)-1, - fixPtr); - } - - /* - * Restore numCommands and codeNext to their correct - * values, removing any commands compiled before the - * failure to produce bytecode got reported. [Bugs - * 705406 and 735055] - */ - - envPtr->numCommands = savedNumCmds; - envPtr->codeNext = envPtr->codeStart + savedCodeNext; - } + envPtr->line = cmdLine; + envPtr->clNext = clNext; + ckfree(eclPtr->loc[wlineat].line); + ckfree(eclPtr->loc[wlineat].next); + eclPtr->loc[wlineat].line = wlines; + eclPtr->loc[wlineat].next = NULL; - /* - * No compile procedure so push the word. If the command - * was found, push a CmdName object to reduce runtime - * lookups. Mark this as a command name literal to reduce - * shimmering. - */ + TclCheckStackDepth(depth, envPtr); + return cmdIdx; +} - objIndex = TclRegisterNewCmdLiteral(envPtr, - tokenPtr[1].start, tokenPtr[1].size); - if (cmdPtr != NULL) { - TclSetCmdNameObj(interp, - envPtr->literalArrayPtr[objIndex].objPtr, - cmdPtr); - } - } else { - /* - * Simple argument word of a command. We reach this if and - * only if the command word was not compiled for whatever - * reason. Register the literal's location for use by - * uplevel, etc. commands, should they encounter it - * unmodified. We care only if the we are in a context - * which already allows absolute counting. - */ +void +TclCompileScript( + Tcl_Interp *interp, /* Used for error and status reporting. Also + * serves as context for finding and compiling + * commands. May not be NULL. */ + const char *script, /* The source script to compile. */ + int numBytes, /* Number of bytes in script. If < 0, the + * script consists of all bytes up to the + * first null character. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + int lastCmdIdx = -1; /* Index into envPtr->cmdMapPtr of the last + * command this routine compiles into bytecode. + * Initial value of -1 indicates this routine + * has not yet generated any bytecode. */ + const char *p = script; /* Where we are in our compile. */ + int depth = TclGetStackDepth(envPtr); + + if (envPtr->iPtr == NULL) { + Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv"); + } - objIndex = TclRegisterNewLiteral(envPtr, - tokenPtr[1].start, tokenPtr[1].size); + /* Each iteration compiles one command from the script. */ - if (envPtr->clNext) { - TclContinuationsEnterDerived( - envPtr->literalArrayPtr[objIndex].objPtr, - tokenPtr[1].start - envPtr->source, - eclPtr->loc[wlineat].next[wordIdx]); - } - } - TclEmitPush(objIndex, envPtr); - } /* for loop */ + while (numBytes > 0) { + Tcl_Parse parse; + const char *next; + if (TCL_OK != Tcl_ParseCommand(interp, p, numBytes, 0, &parse)) { /* - * Emit an invoke instruction for the command. We skip this if a - * compile procedure was found for the command. + * Compile bytecodes to report the parse error at runtime. */ - if (expand) { - /* - * The stack depth during argument expansion can only be - * managed at runtime, as the number of elements in the - * expanded lists is not known at compile time. We adjust here - * the stack depth estimate so that it is correct after the - * command with expanded arguments returns. - * - * The end effect of this command's invocation is that all the - * words of the command are popped from the stack, and the - * result is pushed: the stack top changes by (1-wordIdx). - * - * Note that the estimates are not correct while the command - * is being prepared and run, INST_EXPAND_STKTOP is not - * stack-neutral in general. - */ + Tcl_LogCommandInfo(interp, script, parse.commandStart, + parse.term + 1 - parse.commandStart); + TclCompileSyntaxError(interp, envPtr); + return; + } - TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr); - TclAdjustStackDepth((1-wordIdx), envPtr); - } else if (wordIdx > 0) { - /* - * Save PC -> command map for the TclArgumentBC* functions. - */ +#ifdef TCL_COMPILE_DEBUG + /* + * If tracing, print a line for each top level command compiled. + * TODO: Suppress when numWords == 0 ? + */ - int isnew; - Tcl_HashEntry *hePtr = Tcl_CreateHashEntry(&eclPtr->litInfo, - INT2PTR(envPtr->codeNext - envPtr->codeStart), - &isnew); + if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) { + int commandLength = parse.term - parse.commandStart; + fprintf(stdout, " Compiling: "); + TclPrintSource(stdout, parse.commandStart, + TclMin(commandLength, 55)); + fprintf(stdout, "\n"); + } +#endif - Tcl_SetHashValue(hePtr, INT2PTR(wlineat)); - if (wordIdx <= 255) { - TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr); - } else { - TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr); - } - } + /* + * TIP #280: Count newlines before the command start. + * (See test info-30.33). + */ - /* - * Update the compilation environment structure and record the - * offsets of the source and code for the command. - */ + TclAdvanceLines(&envPtr->line, p, parse.commandStart); + TclAdvanceContinuations(&envPtr->line, &envPtr->clNext, + parse.commandStart - envPtr->source); - finishCommand: - EnterCmdExtentData(envPtr, currCmdIndex, commandLength, - (envPtr->codeNext-envPtr->codeStart) - startCodeOffset); - isFirstCmd = 0; + /* + * Advance parser to the next command in the script. + */ + next = parse.commandStart + parse.commandSize; + numBytes -= next - p; + p = next; + + if (parse.numWords == 0) { /* - * TIP #280: Free full form of per-word line data and insert the - * reduced form now + * The "command" parsed has no words. In this case we can skip + * the rest of the loop body. With no words, clearly + * CompileCommandTokens() has nothing to do. Since the parser + * aggressively sucks up leading comment and white space, + * including newlines, parse.commandStart must be pointing at + * either the end of script, or a command-terminating semi-colon. + * In either case, the TclAdvance*() calls have nothing to do. + * Finally, when no words are parsed, no tokens have been + * allocated at parse.tokenPtr so there's also nothing for + * Tcl_FreeParse() to do. + * + * The advantage of this shortcut is that CompileCommandTokens() + * can be written with an assumption that parse.numWords > 0, with + * the implication the CCT() always generates bytecode. */ + continue; + } - ckfree(eclPtr->loc[wlineat].line); - ckfree(eclPtr->loc[wlineat].next); - eclPtr->loc[wlineat].line = wlines; - eclPtr->loc[wlineat].next = NULL; - } /* end if parsePtr->numWords > 0 */ + lastCmdIdx = CompileCommandTokens(interp, &parse, envPtr); /* - * Advance to the next command in the script. + * TIP #280: Track lines in the just compiled command. */ - next = parsePtr->commandStart + parsePtr->commandSize; - bytesLeft -= next - p; - p = next; + TclAdvanceLines(&envPtr->line, parse.commandStart, p); + TclAdvanceContinuations(&envPtr->line, &envPtr->clNext, + p - envPtr->source); + Tcl_FreeParse(&parse); + } + if (lastCmdIdx == -1) { /* - * TIP #280: Track lines in the just compiled command. + * Compiling the script yielded no bytecode. The script must be all + * whitespace, comments, and empty commands. Such scripts are defined + * to successfully produce the empty string result, so we emit the + * simple bytecode that makes that happen. */ - TclAdvanceLines(&cmdLine, parsePtr->commandStart, p); - TclAdvanceContinuations(&cmdLine, &clNext, p - envPtr->source); - Tcl_FreeParse(parsePtr); - } while (bytesLeft > 0); - - /* - * TIP #280: Bring the line counts in the CompEnv up to date. - * See tests info-30.33,34,35 . - */ - - envPtr->line = cmdLine; - envPtr->clNext = clNext; - - /* - * If the source script yielded no instructions (e.g., if it was empty), - * push an empty string as the command's result. - */ + PushStringLiteral(envPtr, ""); + } else { + /* + * We compiled at least one command to bytecode. The routine + * CompileCommandTokens() follows the bytecode of each compiled + * command with an INST_POP, so that stack balance is maintained when + * several commands are in sequence. (The result of each command is + * thrown away before moving on to the next command). For the last + * command compiled, we need to undo that INST_POP so that the result + * of the last command becomes the result of the script. The code + * here removes that trailing INST_POP. + */ - if (envPtr->codeNext == entryCodeNext) { - TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); + envPtr->cmdMapPtr[lastCmdIdx].numCodeBytes--; + envPtr->codeNext--; + envPtr->currStackDepth++; } - - envPtr->numSrcBytes = p - script; - TclStackFree(interp, parsePtr); - Tcl_DStringFree(&ds); + TclCheckStackDepth(depth+1, envPtr); } /* @@ -2086,7 +2271,7 @@ TclCompileVarSubst( localVar = TclFindCompiledLocal(name, nameBytes, localVarName, envPtr); } if (localVar < 0) { - TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameBytes), envPtr); + PushLiteral(envPtr, name, nameBytes); } /* @@ -2098,7 +2283,7 @@ TclCompileVarSubst( if (tokenPtr->numComponents == 1) { if (localVar < 0) { - TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr); + TclEmitOpcode(INST_LOAD_STK, envPtr); } else if (localVar <= 255) { TclEmitInstInt1(INST_LOAD_SCALAR1, localVar, envPtr); } else { @@ -2128,11 +2313,12 @@ TclCompileTokens( Tcl_DString textBuffer; /* Holds concatenated chars from adjacent * TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */ char buffer[TCL_UTF_MAX]; - int i, numObjsToConcat, length; + int i, numObjsToConcat, length, adjust; unsigned char *entryCodeNext = envPtr->codeNext; #define NUM_STATIC_POS 20 int isLiteral, maxNumCL, numCL; int *clPosition = NULL; + int depth = TclGetStackDepth(envPtr); /* * For the handling of continuation lines in literals we first check if @@ -2165,6 +2351,7 @@ TclCompileTokens( clPosition = ckalloc(maxNumCL * sizeof(int)); } + adjust = 0; Tcl_DStringInit(&textBuffer); numObjsToConcat = 0; for ( ; count > 0; count--, tokenPtr++) { @@ -2208,6 +2395,7 @@ TclCompileTokens( clPosition[numCL] = clPos; numCL ++; } + adjust++; } break; @@ -2224,15 +2412,16 @@ TclCompileTokens( Tcl_DStringFree(&textBuffer); if (numCL) { - TclContinuationsEnter( - envPtr->literalArrayPtr[literal].objPtr, numCL, - clPosition); + TclContinuationsEnter(TclFetchLiteral(envPtr, literal), + numCL, clPosition); } numCL = 0; } + envPtr->line += adjust; TclCompileScript(interp, tokenPtr->start+1, tokenPtr->size-2, envPtr); + envPtr->line -= adjust; numObjsToConcat++; break; @@ -2272,7 +2461,7 @@ TclCompileTokens( TclEmitPush(literal, envPtr); numObjsToConcat++; if (numCL) { - TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr, + TclContinuationsEnter(TclFetchLiteral(envPtr, literal), numCL, clPosition); } numCL = 0; @@ -2283,11 +2472,11 @@ TclCompileTokens( */ while (numObjsToConcat > 255) { - TclEmitInstInt1(INST_CONCAT1, 255, envPtr); + TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr); numObjsToConcat -= 254; /* concat pushes 1 obj, the result */ } if (numObjsToConcat > 1) { - TclEmitInstInt1(INST_CONCAT1, numObjsToConcat, envPtr); + TclEmitInstInt1(INST_STR_CONCAT1, numObjsToConcat, envPtr); } /* @@ -2295,7 +2484,7 @@ TclCompileTokens( */ if (envPtr->codeNext == entryCodeNext) { - TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); + PushStringLiteral(envPtr, ""); } Tcl_DStringFree(&textBuffer); @@ -2307,6 +2496,7 @@ TclCompileTokens( if (maxNumCL) { ckfree(clPosition); } + TclCheckStackDepth(depth+1, envPtr); } /* @@ -2354,7 +2544,7 @@ TclCompileCmdWord( */ TclCompileTokens(interp, tokenPtr, count, envPtr); - TclEmitOpcode(INST_EVAL_STK, envPtr); + TclEmitInvoke(envPtr, INST_EVAL_STK); } } @@ -2410,19 +2600,19 @@ TclCompileExprWords( wordPtr = tokenPtr; for (i = 0; i < numWords; i++) { - TclCompileTokens(interp, wordPtr+1, wordPtr->numComponents, envPtr); + CompileTokens(envPtr, wordPtr, interp); if (i < (numWords - 1)) { - TclEmitPush(TclRegisterNewLiteral(envPtr, " ", 1), envPtr); + PushStringLiteral(envPtr, " "); } wordPtr += wordPtr->numComponents + 1; } concatItems = 2*numWords - 1; while (concatItems > 255) { - TclEmitInstInt1(INST_CONCAT1, 255, envPtr); + TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr); concatItems -= 254; } if (concatItems > 1) { - TclEmitInstInt1(INST_CONCAT1, concatItems, envPtr); + TclEmitInstInt1(INST_STR_CONCAT1, concatItems, envPtr); } TclEmitOpcode(INST_EXPR_STK, envPtr); } @@ -2456,21 +2646,17 @@ TclCompileNoOp( { Tcl_Token *tokenPtr; int i; - int savedStackDepth = envPtr->currStackDepth; tokenPtr = parsePtr->tokenPtr; for (i = 1; i < parsePtr->numWords; i++) { tokenPtr = tokenPtr + tokenPtr->numComponents + 1; - envPtr->currStackDepth = savedStackDepth; if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents, - envPtr); + CompileTokens(envPtr, tokenPtr, interp); TclEmitOpcode(INST_POP, envPtr); } } - envPtr->currStackDepth = savedStackDepth; - TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); + PushStringLiteral(envPtr, ""); return TCL_OK; } @@ -2519,6 +2705,10 @@ TclInitByteCodeObj( int i, isNew; Interp *iPtr; + if (envPtr->iPtr == NULL) { + Tcl_Panic("TclInitByteCodeObj() called on uninitialized CompileEnv"); + } + iPtr = envPtr->iPtr; codeBytes = envPtr->codeNext - envPtr->codeStart; @@ -2576,7 +2766,9 @@ TclInitByteCodeObj( p += TCL_ALIGN(codeBytes); /* align object array */ codePtr->objArrayPtr = (Tcl_Obj **) p; for (i = 0; i < numLitObjects; i++) { - if (objPtr == envPtr->literalArrayPtr[i].objPtr) { + Tcl_Obj *fetched = TclFetchLiteral(envPtr, i); + + if (objPtr == fetched) { /* * Prevent circular reference where the bytecode intrep of * a value contains a literal which is that same value. @@ -2593,9 +2785,9 @@ TclInitByteCodeObj( codePtr->objArrayPtr[i] = Tcl_NewStringObj(bytes, numBytes); Tcl_IncrRefCount(codePtr->objArrayPtr[i]); - Tcl_DecrRefCount(objPtr); + TclReleaseLiteral((Tcl_Interp *)iPtr, objPtr); } else { - codePtr->objArrayPtr[i] = envPtr->literalArrayPtr[i].objPtr; + codePtr->objArrayPtr[i] = fetched; } } @@ -2644,7 +2836,7 @@ TclInitByteCodeObj( */ TclFreeIntRep(objPtr); - objPtr->internalRep.otherValuePtr = codePtr; + objPtr->internalRep.twoPtrValue.ptr1 = codePtr; objPtr->typePtr = &tclByteCodeType; /* @@ -2656,6 +2848,9 @@ TclInitByteCodeObj( &isNew), envPtr->extCmdMapPtr); envPtr->extCmdMapPtr = NULL; + /* We've used up the CompileEnv. Mark as uninitialized. */ + envPtr->iPtr = NULL; + codePtr->localCachePtr = NULL; } @@ -3070,6 +3265,7 @@ TclCreateExceptRange( * new ExceptionRange structure. */ { register ExceptionRange *rangePtr; + register ExceptionAux *auxPtr; int index = envPtr->exceptArrayNext; if (index >= envPtr->exceptArrayEnd) { @@ -3081,12 +3277,16 @@ TclCreateExceptRange( size_t currBytes = envPtr->exceptArrayNext * sizeof(ExceptionRange); + size_t currBytes2 = envPtr->exceptArrayNext * sizeof(ExceptionAux); int newElems = 2*envPtr->exceptArrayEnd; size_t newBytes = newElems * sizeof(ExceptionRange); + size_t newBytes2 = newElems * sizeof(ExceptionAux); if (envPtr->mallocedExceptArray) { envPtr->exceptArrayPtr = ckrealloc(envPtr->exceptArrayPtr, newBytes); + envPtr->exceptAuxArrayPtr = + ckrealloc(envPtr->exceptAuxArrayPtr, newBytes2); } else { /* * envPtr->exceptArrayPtr isn't a ckalloc'd pointer, so we must @@ -3094,9 +3294,12 @@ TclCreateExceptRange( */ ExceptionRange *newPtr = ckalloc(newBytes); + ExceptionAux *newPtr2 = ckalloc(newBytes2); memcpy(newPtr, envPtr->exceptArrayPtr, currBytes); + memcpy(newPtr2, envPtr->exceptAuxArrayPtr, currBytes2); envPtr->exceptArrayPtr = newPtr; + envPtr->exceptAuxArrayPtr = newPtr2; envPtr->mallocedExceptArray = 1; } envPtr->exceptArrayEnd = newElems; @@ -3111,10 +3314,294 @@ TclCreateExceptRange( rangePtr->breakOffset = -1; rangePtr->continueOffset = -1; rangePtr->catchOffset = -1; + auxPtr = &envPtr->exceptAuxArrayPtr[index]; + auxPtr->supportsContinue = 1; + auxPtr->stackDepth = envPtr->currStackDepth; + auxPtr->expandTarget = envPtr->expandCount; + auxPtr->expandTargetDepth = -1; + auxPtr->numBreakTargets = 0; + auxPtr->breakTargets = NULL; + auxPtr->allocBreakTargets = 0; + auxPtr->numContinueTargets = 0; + auxPtr->continueTargets = NULL; + auxPtr->allocContinueTargets = 0; return index; } /* + * --------------------------------------------------------------------- + * + * TclGetInnermostExceptionRange -- + * + * Returns the innermost exception range that covers the current code + * creation point, and (optionally) the stack depth that is expected at + * that point. Relies on the fact that the range has a numCodeBytes = -1 + * when it is being populated and that inner ranges come after outer + * ranges. + * + * --------------------------------------------------------------------- + */ + +ExceptionRange * +TclGetInnermostExceptionRange( + CompileEnv *envPtr, + int returnCode, + ExceptionAux **auxPtrPtr) +{ + int exnIdx = -1, i; + + for (i=0 ; i<envPtr->exceptArrayNext ; i++) { + ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[i]; + + if (CurrentOffset(envPtr) >= rangePtr->codeOffset && + (rangePtr->numCodeBytes == -1 || CurrentOffset(envPtr) < + rangePtr->codeOffset+rangePtr->numCodeBytes) && + (returnCode != TCL_CONTINUE || + envPtr->exceptAuxArrayPtr[i].supportsContinue)) { + exnIdx = i; + } + } + if (exnIdx == -1) { + return NULL; + } + if (auxPtrPtr) { + *auxPtrPtr = &envPtr->exceptAuxArrayPtr[exnIdx]; + } + return &envPtr->exceptArrayPtr[exnIdx]; +} + +/* + * --------------------------------------------------------------------- + * + * TclAddLoopBreakFixup, TclAddLoopContinueFixup -- + * + * Adds a place that wants to break/continue to the loop exception range + * tracking that will be fixed up once the loop can be finalized. These + * functions will generate an INST_JUMP4 that will be fixed up during the + * loop finalization. + * + * --------------------------------------------------------------------- + */ + +void +TclAddLoopBreakFixup( + CompileEnv *envPtr, + ExceptionAux *auxPtr) +{ + int range = auxPtr - envPtr->exceptAuxArrayPtr; + + if (envPtr->exceptArrayPtr[range].type != LOOP_EXCEPTION_RANGE) { + Tcl_Panic("trying to add 'break' fixup to full exception range"); + } + + if (++auxPtr->numBreakTargets > auxPtr->allocBreakTargets) { + auxPtr->allocBreakTargets *= 2; + auxPtr->allocBreakTargets += 2; + if (auxPtr->breakTargets) { + auxPtr->breakTargets = ckrealloc(auxPtr->breakTargets, + sizeof(int) * auxPtr->allocBreakTargets); + } else { + auxPtr->breakTargets = + ckalloc(sizeof(int) * auxPtr->allocBreakTargets); + } + } + auxPtr->breakTargets[auxPtr->numBreakTargets - 1] = CurrentOffset(envPtr); + TclEmitInstInt4(INST_JUMP4, 0, envPtr); +} + +void +TclAddLoopContinueFixup( + CompileEnv *envPtr, + ExceptionAux *auxPtr) +{ + int range = auxPtr - envPtr->exceptAuxArrayPtr; + + if (envPtr->exceptArrayPtr[range].type != LOOP_EXCEPTION_RANGE) { + Tcl_Panic("trying to add 'continue' fixup to full exception range"); + } + + if (++auxPtr->numContinueTargets > auxPtr->allocContinueTargets) { + auxPtr->allocContinueTargets *= 2; + auxPtr->allocContinueTargets += 2; + if (auxPtr->continueTargets) { + auxPtr->continueTargets = ckrealloc(auxPtr->continueTargets, + sizeof(int) * auxPtr->allocContinueTargets); + } else { + auxPtr->continueTargets = + ckalloc(sizeof(int) * auxPtr->allocContinueTargets); + } + } + auxPtr->continueTargets[auxPtr->numContinueTargets - 1] = + CurrentOffset(envPtr); + TclEmitInstInt4(INST_JUMP4, 0, envPtr); +} + +/* + * --------------------------------------------------------------------- + * + * TclCleanupStackForBreakContinue -- + * + * Ditch the extra elements from the auxiliary stack and the main stack. + * How to do this exactly depends on whether there are any elements on + * the auxiliary stack to pop. + * + * --------------------------------------------------------------------- + */ + +void +TclCleanupStackForBreakContinue( + CompileEnv *envPtr, + ExceptionAux *auxPtr) +{ + int savedStackDepth = envPtr->currStackDepth; + int toPop = envPtr->expandCount - auxPtr->expandTarget; + + if (toPop > 0) { + while (toPop --> 0) { + TclEmitOpcode(INST_EXPAND_DROP, envPtr); + } + TclAdjustStackDepth(auxPtr->expandTargetDepth - envPtr->currStackDepth, + envPtr); + envPtr->currStackDepth = auxPtr->expandTargetDepth; + } + toPop = envPtr->currStackDepth - auxPtr->stackDepth; + while (toPop --> 0) { + TclEmitOpcode(INST_POP, envPtr); + } + envPtr->currStackDepth = savedStackDepth; +} + +/* + * --------------------------------------------------------------------- + * + * StartExpanding -- + * + * Pushes an INST_EXPAND_START and does some additional housekeeping so + * that the [break] and [continue] compilers can use an exception-free + * issue to discard it. + * + * --------------------------------------------------------------------- + */ + +static void +StartExpanding( + CompileEnv *envPtr) +{ + int i; + + TclEmitOpcode(INST_EXPAND_START, envPtr); + + /* + * Update inner exception ranges with information about the environment + * where this expansion started. + */ + + for (i=0 ; i<envPtr->exceptArrayNext ; i++) { + ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[i]; + ExceptionAux *auxPtr = &envPtr->exceptAuxArrayPtr[i]; + + /* + * Ignore loops unless they're still being built. + */ + + if (rangePtr->codeOffset > CurrentOffset(envPtr)) { + continue; + } + if (rangePtr->numCodeBytes != -1) { + continue; + } + + /* + * Adequate condition: further out loops and further in exceptions + * don't actually need this information. + */ + + if (auxPtr->expandTarget == envPtr->expandCount) { + auxPtr->expandTargetDepth = envPtr->currStackDepth; + } + } + + /* + * There's now one more expansion being processed on the auxiliary stack. + */ + + envPtr->expandCount++; +} + +/* + * --------------------------------------------------------------------- + * + * TclFinalizeLoopExceptionRange -- + * + * Finalizes a loop exception range, binding the registered [break] and + * [continue] implementations so that they jump to the correct place. + * Note that this must only be called after *all* the exception range + * target offsets have been set. + * + * --------------------------------------------------------------------- + */ + +void +TclFinalizeLoopExceptionRange( + CompileEnv *envPtr, + int range) +{ + ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[range]; + ExceptionAux *auxPtr = &envPtr->exceptAuxArrayPtr[range]; + int i, offset; + unsigned char *site; + + if (rangePtr->type != LOOP_EXCEPTION_RANGE) { + Tcl_Panic("trying to finalize a loop exception range"); + } + + /* + * Do the jump fixups. Note that these are always issued as INST_JUMP4 so + * there is no need to fuss around with updating code offsets. + */ + + for (i=0 ; i<auxPtr->numBreakTargets ; i++) { + site = envPtr->codeStart + auxPtr->breakTargets[i]; + offset = rangePtr->breakOffset - auxPtr->breakTargets[i]; + TclUpdateInstInt4AtPc(INST_JUMP4, offset, site); + } + for (i=0 ; i<auxPtr->numContinueTargets ; i++) { + site = envPtr->codeStart + auxPtr->continueTargets[i]; + if (rangePtr->continueOffset == -1) { + int j; + + /* + * WTF? Can't bind, so revert to an INST_CONTINUE. Not enough + * space to do anything else. + */ + + *site = INST_CONTINUE; + for (j=0 ; j<4 ; j++) { + *++site = INST_NOP; + } + } else { + offset = rangePtr->continueOffset - auxPtr->continueTargets[i]; + TclUpdateInstInt4AtPc(INST_JUMP4, offset, site); + } + } + + /* + * Drop the arrays we were holding the only reference to. + */ + + if (auxPtr->breakTargets) { + ckfree(auxPtr->breakTargets); + auxPtr->breakTargets = NULL; + auxPtr->numBreakTargets = 0; + } + if (auxPtr->continueTargets) { + ckfree(auxPtr->continueTargets); + auxPtr->continueTargets = NULL; + auxPtr->numContinueTargets = 0; + } +} + +/* *---------------------------------------------------------------------- * * TclCreateAuxData -- @@ -3474,70 +3961,215 @@ TclFixupForwardJump( } } + for (k = 0 ; k < envPtr->exceptArrayNext ; k++) { + ExceptionAux *auxPtr = &envPtr->exceptAuxArrayPtr[k]; + int i; + + for (i=0 ; i<auxPtr->numBreakTargets ; i++) { + if (jumpFixupPtr->codeOffset < auxPtr->breakTargets[i]) { + auxPtr->breakTargets[i] += 3; + } + } + for (i=0 ; i<auxPtr->numContinueTargets ; i++) { + if (jumpFixupPtr->codeOffset < auxPtr->continueTargets[i]) { + auxPtr->continueTargets[i] += 3; + } + } + } + + return 1; /* the jump was grown */ +} + +/* + *---------------------------------------------------------------------- + * + * TclEmitInvoke -- + * + * Emit one of the invoke-related instructions, wrapping it if necessary + * in code that ensures that any break or continue operation passing + * through it gets the stack unwinding correct, converting it into an + * internal jump if in an appropriate context. + * + * Results: + * None + * + * Side effects: + * Issues the jump with all correct stack management. May create another + * loop exception range; pointers to ExceptionRange and ExceptionAux + * structures should not be held across this call. + * + *---------------------------------------------------------------------- + */ + +void +TclEmitInvoke( + CompileEnv *envPtr, + int opcode, + ...) +{ + va_list argList; + ExceptionRange *rangePtr; + ExceptionAux *auxBreakPtr, *auxContinuePtr; + int arg1, arg2, wordCount = 0, expandCount = 0; + int loopRange = 0, breakRange = 0, continueRange = 0; + int cleanup, depth = TclGetStackDepth(envPtr); + + /* + * Parse the arguments. + */ + + va_start(argList, opcode); + switch (opcode) { + case INST_INVOKE_STK1: + wordCount = arg1 = cleanup = va_arg(argList, int); + arg2 = 0; + break; + case INST_INVOKE_STK4: + wordCount = arg1 = cleanup = va_arg(argList, int); + arg2 = 0; + break; + case INST_INVOKE_REPLACE: + arg1 = va_arg(argList, int); + arg2 = va_arg(argList, int); + wordCount = arg1 + arg2 - 1; + cleanup = arg1 + 1; + break; + default: + Tcl_Panic("unexpected opcode"); + case INST_EVAL_STK: + wordCount = cleanup = 1; + arg1 = arg2 = 0; + break; + case INST_RETURN_STK: + wordCount = cleanup = 2; + arg1 = arg2 = 0; + break; + case INST_INVOKE_EXPANDED: + wordCount = arg1 = cleanup = va_arg(argList, int); + arg2 = 0; + expandCount = 1; + break; + } + va_end(argList); + /* - * TIP #280: Adjust the mapping from PC values to the per-command - * information about arguments and their line numbers. + * Determine if we need to handle break and continue exceptions with a + * special handling exception range (so that we can correctly unwind the + * stack). * - * Note: We cannot simply remove an out-of-date entry and then reinsert - * with the proper PC, because then we might overwrite another entry which - * was at that location. Therefore we pull (copy + delete) all effected - * entries (beyond the fixed PC) into an array, update them there, and at - * last reinsert them all. + * These must be done separately; they can be different (especially for + * calls from inside a [for] increment clause). */ - { - ExtCmdLoc* eclPtr = envPtr->extCmdMapPtr; + rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxBreakPtr); + if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) { + auxBreakPtr = NULL; + } else if (auxBreakPtr->stackDepth == envPtr->currStackDepth-wordCount + && auxBreakPtr->expandTarget == envPtr->expandCount-expandCount) { + auxBreakPtr = NULL; + } else { + breakRange = auxBreakPtr - envPtr->exceptAuxArrayPtr; + } - /* A helper structure */ + rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE, + &auxContinuePtr); + if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) { + auxContinuePtr = NULL; + } else if (auxContinuePtr->stackDepth == envPtr->currStackDepth-wordCount + && auxContinuePtr->expandTarget == envPtr->expandCount-expandCount) { + auxContinuePtr = NULL; + } else { + continueRange = auxBreakPtr - envPtr->exceptAuxArrayPtr; + } - typedef struct { - int pc; - int cmd; - } MAP; + if (auxBreakPtr != NULL || auxContinuePtr != NULL) { + loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); + ExceptionRangeStarts(envPtr, loopRange); + } - /* - * And the helper array. At most the whole hashtable is placed into - * this. - */ + /* + * Issue the invoke itself. + */ - MAP *map = (MAP*) ckalloc (sizeof(MAP) * eclPtr->litInfo.numEntries); + switch (opcode) { + case INST_INVOKE_STK1: + TclEmitInstInt1(INST_INVOKE_STK1, arg1, envPtr); + break; + case INST_INVOKE_STK4: + TclEmitInstInt4(INST_INVOKE_STK4, arg1, envPtr); + break; + case INST_INVOKE_EXPANDED: + TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr); + envPtr->expandCount--; + TclAdjustStackDepth(1 - arg1, envPtr); + break; + case INST_EVAL_STK: + TclEmitOpcode(INST_EVAL_STK, envPtr); + break; + case INST_RETURN_STK: + TclEmitOpcode(INST_RETURN_STK, envPtr); + break; + case INST_INVOKE_REPLACE: + TclEmitInstInt4(INST_INVOKE_REPLACE, arg1, envPtr); + TclEmitInt1(arg2, envPtr); + TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs */ + break; + } - Tcl_HashSearch hSearch; - Tcl_HashEntry* hPtr; - int n, k, isnew; + /* + * If we're generating a special wrapper exception range, we need to + * finish that up now. + */ + + if (auxBreakPtr != NULL || auxContinuePtr != NULL) { + int savedStackDepth = envPtr->currStackDepth; + int savedExpandCount = envPtr->expandCount; + JumpFixup nonTrapFixup; + + if (auxBreakPtr != NULL) { + auxBreakPtr = envPtr->exceptAuxArrayPtr + breakRange; + } + if (auxContinuePtr != NULL) { + auxContinuePtr = envPtr->exceptAuxArrayPtr + continueRange; + } + + ExceptionRangeEnds(envPtr, loopRange); + TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &nonTrapFixup); /* - * Phase I: Locate the affected entries, and save them in adjusted - * form to the array. This removes them from the hash. + * Careful! When generating these stack unwinding sequences, the depth + * of stack in the cases where they are taken is not the same as if + * the exception is not taken. */ - for (n = 0, hPtr = Tcl_FirstHashEntry(&eclPtr->litInfo, &hSearch); - hPtr != NULL; - hPtr = Tcl_NextHashEntry(&hSearch)) { + if (auxBreakPtr != NULL) { + TclAdjustStackDepth(-1, envPtr); - map [n].cmd = PTR2INT(Tcl_GetHashValue(hPtr)); - map [n].pc = PTR2INT(Tcl_GetHashKey (&eclPtr->litInfo,hPtr)); + ExceptionRangeTarget(envPtr, loopRange, breakOffset); + TclCleanupStackForBreakContinue(envPtr, auxBreakPtr); + TclAddLoopBreakFixup(envPtr, auxBreakPtr); + TclAdjustStackDepth(1, envPtr); - if (map[n].pc >= (jumpFixupPtr->codeOffset + 2)) { - Tcl_DeleteHashEntry(hPtr); - map [n].pc += 3; - n++; - } + envPtr->currStackDepth = savedStackDepth; + envPtr->expandCount = savedExpandCount; } - /* - * Phase II: Re-insert the modified entries into the hash. - */ + if (auxContinuePtr != NULL) { + TclAdjustStackDepth(-1, envPtr); - for (k=0;k<n;k++) { - hPtr = Tcl_CreateHashEntry(&eclPtr->litInfo, INT2PTR(map[k].pc), &isnew); - Tcl_SetHashValue(hPtr, INT2PTR(map[k].cmd)); + ExceptionRangeTarget(envPtr, loopRange, continueOffset); + TclCleanupStackForBreakContinue(envPtr, auxContinuePtr); + TclAddLoopContinueFixup(envPtr, auxContinuePtr); + TclAdjustStackDepth(1, envPtr); + + envPtr->currStackDepth = savedStackDepth; + envPtr->expandCount = savedExpandCount; } - ckfree (map); + TclFinalizeLoopExceptionRange(envPtr, loopRange); + TclFixupForwardJumpToHere(envPtr, &nonTrapFixup, 127); } - - return 1; /* the jump was grown */ + TclCheckStackDepth(depth+1-cleanup, envPtr); } /* @@ -3568,7 +4200,7 @@ TclGetInstructionTable(void) /* *-------------------------------------------------------------- * - * TclRegisterAuxDataType -- + * RegisterAuxDataType -- * * This procedure is called to register a new AuxData type in the table * of all AuxData types supported by Tcl. @@ -3584,8 +4216,8 @@ TclGetInstructionTable(void) *-------------------------------------------------------------- */ -void -TclRegisterAuxDataType( +static void +RegisterAuxDataType( const AuxDataType *typePtr) /* Information about object type; storage must * be statically allocated (must live forever; * will not be deallocated). */ @@ -3686,12 +4318,12 @@ TclInitAuxDataTypeTable(void) Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS); /* - * There are only two AuxData type at this time, so register them here. + * There are only three AuxData types at this time, so register them here. */ - TclRegisterAuxDataType(&tclForeachInfoType); - TclRegisterAuxDataType(&tclJumptableInfoType); - TclRegisterAuxDataType(&tclDictUpdateInfoType); + RegisterAuxDataType(&tclForeachInfoType); + RegisterAuxDataType(&tclJumptableInfoType); + RegisterAuxDataType(&tclDictUpdateInfoType); } /* @@ -4063,7 +4695,7 @@ Tcl_Obj * TclDisassembleByteCodeObj( Tcl_Obj *objPtr) /* The bytecode object to disassemble. */ { - ByteCode *codePtr = objPtr->internalRep.otherValuePtr; + ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1; unsigned char *codeStart, *codeLimit, *pc; unsigned char *codeDeltaNext, *codeLengthNext; unsigned char *srcDeltaNext, *srcLengthNext; @@ -4568,7 +5200,11 @@ TclGetInnerContext( if (!objPtr) { Tcl_Panic("InnerContext: bad tos -- appending null object"); } - if (objPtr->refCount<=0 || objPtr->refCount==0x61616161) { + if ((objPtr->refCount<=0) +#ifdef TCL_MEM_DEBUG + || (objPtr->refCount==0x61616161) +#endif + ) { Tcl_Panic("InnerContext: bad tos -- appending freed object %p", objPtr); } diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 33e286e..6ecadf4 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -100,6 +100,54 @@ typedef struct ExceptionRange { } ExceptionRange; /* + * Auxiliary data used when issuing (currently just loop) exception ranges, + * but which is not required during execution. + */ + +typedef struct ExceptionAux { + int supportsContinue; /* Whether this exception range will have a + * continueOffset created for it; if it is a + * loop exception range that *doesn't* have + * one (see [for] next-clause) then we must + * not pick up the range when scanning for a + * target to continue to. */ + int stackDepth; /* The stack depth at the point where the + * exception range was created. This is used + * to calculate the number of POPs required to + * restore the stack to its prior state. */ + int expandTarget; /* The number of expansions expected on the + * auxData stack at the time the loop starts; + * we can't currently discard them except by + * doing INST_INVOKE_EXPANDED; this is a known + * problem. */ + int expandTargetDepth; /* The stack depth expected at the outermost + * expansion within the loop. Not meaningful + * if there are no open expansions between the + * looping level and the point of jump + * issue. */ + int numBreakTargets; /* The number of [break]s that want to be + * targeted to the place where this loop + * exception will be bound to. */ + int *breakTargets; /* The offsets of the INST_JUMP4 instructions + * issued by the [break]s that we must + * update. Note that resizing a jump (via + * TclFixupForwardJump) can cause the contents + * of this array to be updated. When + * numBreakTargets==0, this is NULL. */ + int allocBreakTargets; /* The size of the breakTargets array. */ + int numContinueTargets; /* The number of [continue]s that want to be + * targeted to the place where this loop + * exception will be bound to. */ + int *continueTargets; /* The offsets of the INST_JUMP4 instructions + * issued by the [continue]s that we must + * update. Note that resizing a jump (via + * TclFixupForwardJump) can cause the contents + * of this array to be updated. When + * numContinueTargets==0, this is NULL. */ + int allocContinueTargets; /* The size of the continueTargets array. */ +} ExceptionAux; + +/* * Structure used to map between instruction pc and source locations. It * defines for each compiled Tcl command its code's starting offset and its * source's starting offset and length. Note that the code offset increases @@ -145,13 +193,6 @@ typedef struct ExtCmdLoc { ECL *loc; /* Command word locations (lines). */ int nloc; /* Number of allocated entries in 'loc'. */ int nuloc; /* Number of used entries in 'loc'. */ - Tcl_HashTable litInfo; /* Indexed by bytecode 'PC', to have the - * information accessible per command and - * argument, not per whole bytecode. Value is - * index of command in 'loc', giving us the - * literals to associate with line information - * as command argument, see - * TclArgumentBCEnter() */ } ExtCmdLoc; /* @@ -275,6 +316,11 @@ typedef struct CompileEnv { * entry. */ int mallocedExceptArray; /* 1 if ExceptionRange array was expanded and * exceptArrayPtr points in heap, else 0. */ + ExceptionAux *exceptAuxArrayPtr; + /* Array of information used to restore the + * state when processing BREAK/CONTINUE + * exceptions. Must be the same size as the + * exceptArrayPtr. */ CmdLocation *cmdMapPtr; /* Points to start of CmdLocation array. * numCommands is the index of the next entry * to use; (numCommands-1) is the entry index @@ -296,6 +342,9 @@ typedef struct CompileEnv { /* Initial storage of LiteralEntry array. */ ExceptionRange staticExceptArraySpace[COMPILEENV_INIT_EXCEPT_RANGES]; /* Initial ExceptionRange array storage. */ + ExceptionAux staticExAuxArraySpace[COMPILEENV_INIT_EXCEPT_RANGES]; + /* Initial static except auxiliary info array + * storage. */ CmdLocation staticCmdMapSpace[COMPILEENV_INIT_CMD_MAP_SIZE]; /* Initial storage for cmd location map. */ AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE]; @@ -309,11 +358,13 @@ typedef struct CompileEnv { int atCmdStart; /* Flag to say whether an INST_START_CMD * should be issued; they should never be * issued repeatedly, as that is significantly - * inefficient. */ - ContLineLoc *clLoc; /* If not NULL, the table holding the - * locations of the invisible continuation - * lines in the input script, to adjust the - * line counter. */ + * inefficient. If set to 2, that instruction + * should not be issued at all (by the generic + * part of the command compiler). */ + int expandCount; /* Number of INST_EXPAND_START instructions + * encountered that have not yet been paired + * with a corresponding + * INST_INVOKE_EXPANDED. */ int *clNext; /* If not NULL, it refers to the next slot in * clLoc to check for an invisible * continuation line. */ @@ -461,7 +512,7 @@ typedef struct ByteCode { #define INST_PUSH4 2 #define INST_POP 3 #define INST_DUP 4 -#define INST_CONCAT1 5 +#define INST_STR_CONCAT1 5 #define INST_INVOKE_STK1 6 #define INST_INVOKE_STK4 7 #define INST_EVAL_STK 8 @@ -535,8 +586,8 @@ typedef struct ByteCode { #define INST_CONTINUE 66 /* Opcodes 67 to 68 */ -#define INST_FOREACH_START4 67 -#define INST_FOREACH_STEP4 68 +#define INST_FOREACH_START4 67 /* DEPRECATED */ +#define INST_FOREACH_STEP4 68 /* DEPRECATED */ /* Opcodes 69 to 72 */ #define INST_BEGIN_CATCH4 69 @@ -712,12 +763,37 @@ typedef struct ByteCode { #define INST_ARRAY_EXISTS_IMM 160 #define INST_ARRAY_MAKE_STK 161 #define INST_ARRAY_MAKE_IMM 162 -#define INST_TCLOO_NEXT 163 #define INST_INVOKE_REPLACE 163 +#define INST_LIST_CONCAT 164 + +#define INST_EXPAND_DROP 165 + +/* New foreach implementation */ +#define INST_FOREACH_START 166 +#define INST_FOREACH_STEP 167 +#define INST_FOREACH_END 168 +#define INST_LMAP_COLLECT 169 + +/* For compilation of [string trim] and related */ +#define INST_STR_TRIM 170 +#define INST_STR_TRIM_LEFT 171 +#define INST_STR_TRIM_RIGHT 172 + +#define INST_CONCAT_STK 173 + +#define INST_STR_UPPER 174 +#define INST_STR_LOWER 175 +#define INST_STR_TITLE 176 +#define INST_STR_REPLACE 177 + +#define INST_ORIGIN_COMMAND 178 + +#define INST_TCLOO_NEXT 179 + /* The last opcode */ -#define LAST_INST_OPCODE 163 +#define LAST_INST_OPCODE 179 /* * Table describing the Tcl bytecode instructions: their name (for displaying @@ -850,6 +926,10 @@ typedef struct ForeachInfo { } ForeachInfo; MODULE_SCOPE const AuxDataType tclForeachInfoType; +MODULE_SCOPE const AuxDataType tclNewForeachInfoType; + +#define FOREACHINFO(envPtr, index) \ + ((ForeachInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData)) /* * Structure used to hold information about a switch command that is needed @@ -864,6 +944,9 @@ typedef struct JumptableInfo { MODULE_SCOPE const AuxDataType tclJumptableInfoType; +#define JUMPTABLEINFO(envPtr, index) \ + ((JumptableInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData)) + /* * Structure used to hold information about a [dict update] command that is * needed during program execution. These structures are stored in CompileEnv @@ -882,6 +965,9 @@ typedef struct { MODULE_SCOPE const AuxDataType tclDictUpdateInfoType; +#define DICTUPDATEINFO(envPtr, index) \ + ((DictUpdateInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData)) + /* * ClientData type used by the math operator commands. */ @@ -919,7 +1005,12 @@ MODULE_SCOPE ByteCode * TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr, *---------------------------------------------------------------- */ +MODULE_SCOPE int TclAttemptCompileProc(Tcl_Interp *interp, + Tcl_Parse *parsePtr, int depth, Command *cmdPtr, + CompileEnv *envPtr); MODULE_SCOPE void TclCleanupByteCode(ByteCode *codePtr); +MODULE_SCOPE void TclCleanupStackForBreakContinue(CompileEnv *envPtr, + ExceptionAux *auxPtr); MODULE_SCOPE void TclCompileCmdWord(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, CompileEnv *envPtr); @@ -928,6 +1019,9 @@ MODULE_SCOPE void TclCompileExpr(Tcl_Interp *interp, const char *script, MODULE_SCOPE void TclCompileExprWords(Tcl_Interp *interp, Tcl_Token *tokenPtr, int numWords, CompileEnv *envPtr); +MODULE_SCOPE void TclCompileInvocation(Tcl_Interp *interp, + Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, int numWords, + CompileEnv *envPtr); MODULE_SCOPE void TclCompileScript(Tcl_Interp *interp, const char *script, int numBytes, CompileEnv *envPtr); @@ -952,16 +1046,16 @@ MODULE_SCOPE void TclDeleteLiteralTable(Tcl_Interp *interp, LiteralTable *tablePtr); MODULE_SCOPE void TclEmitForwardJump(CompileEnv *envPtr, TclJumpType jumpType, JumpFixup *jumpFixupPtr); +MODULE_SCOPE void TclEmitInvoke(CompileEnv *envPtr, int opcode, ...); MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc, int catchOnly, ByteCode *codePtr); MODULE_SCOPE void TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr); MODULE_SCOPE int TclNRExecuteByteCode(Tcl_Interp *interp, ByteCode *codePtr); +MODULE_SCOPE Tcl_Obj * TclFetchLiteral(CompileEnv *envPtr, unsigned int index); MODULE_SCOPE void TclFinalizeAuxDataTypeTable(void); MODULE_SCOPE int TclFindCompiledLocal(const char *name, int nameChars, int create, CompileEnv *envPtr); -MODULE_SCOPE LiteralEntry * TclLookupLiteralEntry(Tcl_Interp *interp, - Tcl_Obj *objPtr); MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr, JumpFixup *jumpFixupPtr, int jumpDist, int distThreshold); @@ -970,16 +1064,24 @@ MODULE_SCOPE void TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr); MODULE_SCOPE void TclInitAuxDataTypeTable(void); MODULE_SCOPE void TclInitByteCodeObj(Tcl_Obj *objPtr, CompileEnv *envPtr); -MODULE_SCOPE void TclInitCompilation(void); MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp, CompileEnv *envPtr, const char *string, int numBytes, const CmdFrame *invoker, int word); MODULE_SCOPE void TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr); MODULE_SCOPE void TclInitLiteralTable(LiteralTable *tablePtr); +MODULE_SCOPE ExceptionRange *TclGetInnermostExceptionRange(CompileEnv *envPtr, + int returnCode, ExceptionAux **auxPtrPtr); +MODULE_SCOPE void TclAddLoopBreakFixup(CompileEnv *envPtr, + ExceptionAux *auxPtr); +MODULE_SCOPE void TclAddLoopContinueFixup(CompileEnv *envPtr, + ExceptionAux *auxPtr); +MODULE_SCOPE void TclFinalizeLoopExceptionRange(CompileEnv *envPtr, + int range); #ifdef TCL_COMPILE_STATS MODULE_SCOPE char * TclLiteralStats(LiteralTable *tablePtr); MODULE_SCOPE int TclLog2(int value); #endif +MODULE_SCOPE void TclOptimizeBytecode(void *envPtr); #ifdef TCL_COMPILE_DEBUG MODULE_SCOPE void TclPrintByteCodeObj(Tcl_Interp *interp, Tcl_Obj *objPtr); @@ -990,9 +1092,10 @@ MODULE_SCOPE void TclPrintObject(FILE *outFile, Tcl_Obj *objPtr, int maxChars); MODULE_SCOPE void TclPrintSource(FILE *outFile, const char *string, int maxChars); -MODULE_SCOPE void TclRegisterAuxDataType(const AuxDataType *typePtr); -MODULE_SCOPE int TclRegisterLiteral(CompileEnv *envPtr, - char *bytes, int length, int flags); +MODULE_SCOPE void TclPushVarName(Tcl_Interp *interp, + Tcl_Token *varTokenPtr, CompileEnv *envPtr, + int flags, int *localIndexPtr, + int *isScalarPtr); MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr); MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp, const char *name, Namespace *nsPtr); @@ -1030,6 +1133,15 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); *---------------------------------------------------------------- */ +/* + * Simplified form to access AuxData. + * + * ClientData TclFetchAuxData(CompileEng *envPtr, int index); + */ + +#define TclFetchAuxData(envPtr, index) \ + (envPtr)->auxDataArrayPtr[(index)].clientData + #define LITERAL_ON_HEAP 0x01 #define LITERAL_CMD_NAME 0x02 @@ -1074,6 +1186,21 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); (envPtr)->currStackDepth += (delta); \ } while (0) +#define TclGetStackDepth(envPtr) \ + ((envPtr)->currStackDepth) + +#define TclSetStackDepth(depth, envPtr) \ + (envPtr)->currStackDepth = (depth) + +#define TclCheckStackDepth(depth, envPtr) \ + do { \ + int dd = (depth); \ + if (dd != (envPtr)->currStackDepth) { \ + Tcl_Panic("bad stack depth computations: is %i, should be %i", \ + (envPtr)->currStackDepth, dd); \ + } \ + } while (0) + /* * Macro used to update the stack requirements. It is called by the macros * TclEmitOpCode, TclEmitInst1 and TclEmitInst4. @@ -1096,6 +1223,18 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); } while (0) /* + * Macros used to update the flag that indicates if we are at the start of a + * command, based on whether the opcode is INST_START_COMMAND. + * + * void TclUpdateAtCmdStart(unsigned char op, CompileEnv *envPtr); + */ + +#define TclUpdateAtCmdStart(op, envPtr) \ + if ((envPtr)->atCmdStart < 2) { \ + (envPtr)->atCmdStart = ((op) == INST_START_CMD ? 1 : 0); \ + } + +/* * Macro to emit an opcode byte into a CompileEnv's code array. The ANSI C * "prototype" for this macro is: * @@ -1108,7 +1247,7 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); TclExpandCodeArray(envPtr); \ } \ *(envPtr)->codeNext++ = (unsigned char) (op); \ - (envPtr)->atCmdStart = ((op) == INST_START_CMD); \ + TclUpdateAtCmdStart(op, envPtr); \ TclUpdateStackReqs(op, 0, envPtr); \ } while (0) @@ -1160,7 +1299,7 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); } \ *(envPtr)->codeNext++ = (unsigned char) (op); \ *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i)); \ - (envPtr)->atCmdStart = ((op) == INST_START_CMD); \ + TclUpdateAtCmdStart(op, envPtr); \ TclUpdateStackReqs(op, i, envPtr); \ } while (0) @@ -1178,7 +1317,7 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); (unsigned char) ((unsigned int) (i) >> 8); \ *(envPtr)->codeNext++ = \ (unsigned char) ((unsigned int) (i) ); \ - (envPtr)->atCmdStart = ((op) == INST_START_CMD); \ + TclUpdateAtCmdStart(op, envPtr); \ TclUpdateStackReqs(op, i, envPtr); \ } while (0) @@ -1202,6 +1341,18 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); } while (0) /* + * If the expr compiler finished with TRY_CONVERT, macro to remove it when the + * job is done by the following instruction. + */ + +#define TclClearNumConversion(envPtr) \ + do { \ + if (*(envPtr->codeNext - 1) == INST_TRY_CVT_TO_NUMERIC) { \ + envPtr->codeNext--; \ + } \ + } while (0) + +/* * Macros to update a (signed or unsigned) integer starting at a pointer. The * two variants depend on the number of bytes. The ANSI C "prototypes" for * these macros are: @@ -1311,16 +1462,16 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); #define TclMax(i, j) ((((int) i) > ((int) j))? (i) : (j)) /* - * Convenience macro for use when compiling bodies of commands. The ANSI C - * "prototype" for this macro is: + * Convenience macros for use when compiling bodies of commands. The ANSI C + * "prototype" for these macros are: * - * static void CompileBody(CompileEnv *envPtr, Tcl_Token *tokenPtr, - * Tcl_Interp *interp); + * static void BODY(Tcl_Token *tokenPtr, int word); */ -#define CompileBody(envPtr, tokenPtr, interp) \ - TclCompileCmdWord((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \ - (envPtr)) +#define BODY(tokenPtr, word) \ + SetLineInformation((word)); \ + TclCompileCmdWord(interp, (tokenPtr)+1, (tokenPtr)->numComponents, \ + envPtr) /* * Convenience macro for use when compiling tokens to be pushed. The ANSI C @@ -1334,15 +1485,19 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \ (envPtr)); /* - * Convenience macro for use when pushing literals. The ANSI C "prototype" for - * this macro is: + * Convenience macros for use when pushing literals. The ANSI C "prototype" for + * these macros are: * * static void PushLiteral(CompileEnv *envPtr, * const char *string, int length); + * static void PushStringLiteral(CompileEnv *envPtr, + * const char *string); */ #define PushLiteral(envPtr, string, length) \ TclEmitPush(TclRegisterNewLiteral((envPtr), (string), (length)), (envPtr)) +#define PushStringLiteral(envPtr, string) \ + PushLiteral((envPtr), (string), (int) (sizeof(string "") - 1)) /* * Macro to advance to the next token; it is more mnemonic than the address @@ -1371,14 +1526,11 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); * of LOOP ranges is an interesting datum for debugging purposes, and that is * what we compute now. * - * static int DeclareExceptionRange(CompileEnv *envPtr, int type); * static int ExceptionRangeStarts(CompileEnv *envPtr, int index); * static void ExceptionRangeEnds(CompileEnv *envPtr, int index); * static void ExceptionRangeTarget(CompileEnv *envPtr, int index, LABEL); */ -#define DeclareExceptionRange(envPtr, type) \ - (TclCreateExceptRange((type), (envPtr))) #define ExceptionRangeStarts(envPtr, index) \ (((envPtr)->exceptDepth++), \ ((envPtr)->maxExceptDepth = \ @@ -1409,6 +1561,76 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); Tcl_DStringLength(dsPtr), /*flags*/ 0) /* + * Macro that encapsulates an efficiency trick that avoids a function call for + * the simplest of compiles. The ANSI C "prototype" for this macro is: + * + * static void CompileWord(CompileEnv *envPtr, Tcl_Token *tokenPtr, + * Tcl_Interp *interp, int word); + */ + +#define CompileWord(envPtr, tokenPtr, interp, word) \ + if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) { \ + PushLiteral((envPtr), (tokenPtr)[1].start, (tokenPtr)[1].size); \ + } else { \ + SetLineInformation((word)); \ + CompileTokens((envPtr), (tokenPtr), (interp)); \ + } + +/* + * TIP #280: Remember the per-word line information of the current command. An + * index is used instead of a pointer as recursive compilation may reallocate, + * i.e. move, the array. This is also the reason to save the nuloc now, it may + * change during the course of the function. + * + * Macro to encapsulate the variable definition and setup. + */ + +#define DefineLineInformation \ + ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \ + int eclIndex = mapPtr->nuloc - 1 + +#define SetLineInformation(word) \ + envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \ + envPtr->clNext = mapPtr->loc[eclIndex].next[(word)] + +#define PushVarNameWord(i,v,e,f,l,sc,word) \ + SetLineInformation(word); \ + TclPushVarName(i,v,e,f,l,sc) + +/* + * Often want to issue one of two versions of an instruction based on whether + * the argument will fit in a single byte or not. This makes it much clearer. + */ + +#define Emit14Inst(nm,idx,envPtr) \ + if (idx <= 255) { \ + TclEmitInstInt1(nm##1,idx,envPtr); \ + } else { \ + TclEmitInstInt4(nm##4,idx,envPtr); \ + } + +/* + * How to get an anonymous local variable (used for holding temporary values + * off the stack) or a local simple scalar. + */ + +#define AnonymousLocal(envPtr) \ + (TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, (envPtr))) +#define LocalScalar(chars,len,envPtr) \ + (!TclIsLocalScalar((chars), (len)) ? -1 : \ + TclFindCompiledLocal((chars), (len), /*create*/ 1, (envPtr))) +#define LocalScalarFromToken(tokenPtr,envPtr) \ + ((tokenPtr)->type != TCL_TOKEN_SIMPLE_WORD ? -1 : \ + LocalScalar((tokenPtr)[1].start, (tokenPtr)[1].size, (envPtr))) + +/* + * Flags bits used by TclPushVarName. + */ + +#define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */ +#define TCL_NO_ELEMENT 2 /* Do not push the array element. */ + +/* * DTrace probe macros (NOPs if DTrace support is not enabled). */ diff --git a/generic/tclConfig.c b/generic/tclConfig.c index a4ba71a..2fb3e92 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -26,14 +26,15 @@ #define ASSOC_KEY "tclPackageAboutDict" /* - * A ClientData struct for the QueryConfig command. Store the two bits + * A ClientData struct for the QueryConfig command. Store the three bits * of data we need; the package name for which we store a config dict, - * and the (Tcl_Interp *) in which it is stored. + * the (Tcl_Interp *) in which it is stored, and the encoding. */ typedef struct QCCD { Tcl_Obj *pkg; Tcl_Interp *interp; + char *encoding; } QCCD; /* @@ -75,22 +76,28 @@ Tcl_RegisterConfig( const char *valEncoding) /* Name of the encoding used to store the * configuration values, ASCII, thus UTF-8. */ { + Tcl_Obj *pDB, *pkgDict; Tcl_DString cmdName; const Tcl_Config *cfg; - Tcl_Encoding venc = Tcl_GetEncoding(NULL, valEncoding); QCCD *cdPtr = ckalloc(sizeof(QCCD)); cdPtr->interp = interp; + if (valEncoding) { + cdPtr->encoding = ckalloc(strlen(valEncoding)+1); + strcpy(cdPtr->encoding, valEncoding); + } else { + cdPtr->encoding = NULL; + } cdPtr->pkg = Tcl_NewStringObj(pkgName, -1); /* * Phase I: Adding the provided information to the internal database of - * package meta data. Only if we have an ok encoding. + * package meta data. * * Phase II: Create a command for querying this database, specific to the - * package registerting its configuration. This is the approved interface + * package registering its configuration. This is the approved interface * in TIP 59. In the future a more general interface should be done, as - * followup to TIP 59. Simply because our database is now general across + * follow-up to TIP 59. Simply because our database is now general across * packages, and not a structure tied to one package. * * Note, the created command will have a reference through its clientdata. @@ -103,51 +110,35 @@ Tcl_RegisterConfig( * dictionaries visible at Tcl level. I.e. they are not filled */ - if (venc != NULL) { - Tcl_Obj *pkgDict, *pDB = GetConfigDict(interp); - - /* - * Retrieve package specific configuration... - */ - - if (Tcl_DictObjGet(interp, pDB, cdPtr->pkg, &pkgDict) != TCL_OK - || (pkgDict == NULL)) { - pkgDict = Tcl_NewDictObj(); - } else if (Tcl_IsShared(pkgDict)) { - pkgDict = Tcl_DuplicateObj(pkgDict); - } - - /* - * Extend the package configuration... - */ - - for (cfg=configuration ; cfg->key!=NULL && cfg->key[0]!='\0' ; cfg++) { - Tcl_DString conv; - const char *convValue = - Tcl_ExternalToUtfDString(venc, cfg->value, -1, &conv); + pDB = GetConfigDict(interp); - /* - * We know that the keys are in ASCII/UTF-8, so for them is no - * conversion required. - */ + /* + * Retrieve package specific configuration... + */ - Tcl_DictObjPut(interp, pkgDict, Tcl_NewStringObj(cfg->key, -1), - Tcl_NewStringObj(convValue, -1)); - Tcl_DStringFree(&conv); - } + if (Tcl_DictObjGet(interp, pDB, cdPtr->pkg, &pkgDict) != TCL_OK + || (pkgDict == NULL)) { + pkgDict = Tcl_NewDictObj(); + } else if (Tcl_IsShared(pkgDict)) { + pkgDict = Tcl_DuplicateObj(pkgDict); + } - /* - * We're now done with the encoding, so drop it. - */ + /* + * Extend the package configuration... + * We cannot assume that the encodings are initialized, therefore + * store the value as-is in a byte array. See Bug [9b2e636361]. + */ - Tcl_FreeEncoding(venc); + for (cfg=configuration ; cfg->key!=NULL && cfg->key[0]!='\0' ; cfg++) { + Tcl_DictObjPut(interp, pkgDict, Tcl_NewStringObj(cfg->key, -1), + Tcl_NewByteArrayObj((unsigned char *)cfg->value, strlen(cfg->value))); + } - /* - * Write the changes back into the overall database. - */ + /* + * Write the changes back into the overall database. + */ - Tcl_DictObjPut(interp, pDB, cdPtr->pkg, pkgDict); - } + Tcl_DictObjPut(interp, pDB, cdPtr->pkg, pkgDict); /* * Now create the interface command for retrieval of the package @@ -218,6 +209,9 @@ QueryConfigObjCmd( enum subcmds { CFG_GET, CFG_LIST }; + Tcl_DString conv; + Tcl_Encoding venc = NULL; + const char *value; if ((objc < 2) || (objc > 3)) { Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg?"); @@ -257,7 +251,21 @@ QueryConfigObjCmd( return TCL_ERROR; } - Tcl_SetObjResult(interp, val); + if (cdPtr->encoding) { + venc = Tcl_GetEncoding(interp, cdPtr->encoding); + if (!venc) { + return TCL_ERROR; + } + } + /* + * Value is stored as-is in a byte array, see Bug [9b2e636361], + * so we have to decode it first. + */ + value = (const char *) Tcl_GetByteArrayFromObj(val, &n); + value = Tcl_ExternalToUtfDString(venc, value, n, &conv); + Tcl_SetObjResult(interp, Tcl_NewStringObj(value, + Tcl_DStringLength(&conv))); + Tcl_DStringFree(&conv); return TCL_OK; case CFG_LIST: @@ -324,7 +332,10 @@ QueryConfigDelete( Tcl_DictObjRemove(NULL, pDB, pkgName); Tcl_DecrRefCount(pkgName); - ckfree(cdPtr); + if (cdPtr->encoding) { + ckfree((char *)cdPtr->encoding); + } + ckfree((char *)cdPtr); } /* @@ -366,7 +377,7 @@ GetConfigDict( * * This function is associated with the "Package About dict" assoc data * for an interpreter; it is invoked when the interpreter is deleted in - * order to free the information assoicated with any pending error + * order to free the information associated with any pending error * reports. * * Results: diff --git a/generic/tclDate.c b/generic/tclDate.c index 14bac51..6222a8a 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -2686,7 +2686,7 @@ TclDatelex( location->first_column = yyInput - info->dateStart; for ( ; ; ) { - while (isspace(UCHAR(*yyInput))) { + while (TclIsSpaceProc(*yyInput)) { yyInput++; } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 2801102..830c998 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -31,6 +31,10 @@ /* !BEGIN!: Do not edit below this line. */ +#ifdef __cplusplus +extern "C" { +#endif + /* * Exported function declarations: */ @@ -2479,10 +2483,8 @@ typedef struct TclStubs { void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */ } TclStubs; -#ifdef __cplusplus -extern "C" { -#endif extern const TclStubs *tclStubsPtr; + #ifdef __cplusplus } #endif @@ -3783,6 +3785,7 @@ extern const TclStubs *tclStubsPtr; # undef Tcl_Init # undef Tcl_SetPanicProc # undef Tcl_SetVar +# undef Tcl_ObjSetVar2 # undef Tcl_StaticPackage # undef TclFSGetNativePath # define Tcl_CreateInterp() (tclStubsPtr->tcl_CreateInterp()) @@ -3791,6 +3794,8 @@ extern const TclStubs *tclStubsPtr; # define Tcl_SetPanicProc(proc) (tclStubsPtr->tcl_SetPanicProc(proc)) # define Tcl_SetVar(interp, varName, newValue, flags) \ (tclStubsPtr->tcl_SetVar(interp, varName, newValue, flags)) +# define Tcl_ObjSetVar2(interp, part1, part2, newValue, flags) \ + (tclStubsPtr->tcl_ObjSetVar2(interp, part1, part2, newValue, flags)) #endif #if defined(_WIN32) && defined(UNICODE) @@ -3803,4 +3808,110 @@ extern const TclStubs *tclStubsPtr; #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT +#undef Tcl_SeekOld +#undef Tcl_TellOld + +#undef Tcl_PkgPresent +#define Tcl_PkgPresent(interp, name, version, exact) \ + Tcl_PkgPresentEx(interp, name, version, exact, NULL) +#undef Tcl_PkgProvide +#define Tcl_PkgProvide(interp, name, version) \ + Tcl_PkgProvideEx(interp, name, version, NULL) +#undef Tcl_PkgRequire +#define Tcl_PkgRequire(interp, name, version, exact) \ + Tcl_PkgRequireEx(interp, name, version, exact, NULL) +#undef Tcl_GetIndexFromObj +#define Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) \ + Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, \ + sizeof(char *), msg, flags, indexPtr) +#undef Tcl_NewBooleanObj +#define Tcl_NewBooleanObj(boolValue) \ + Tcl_NewIntObj((boolValue)!=0) +#undef Tcl_DbNewBooleanObj +#define Tcl_DbNewBooleanObj(boolValue, file, line) \ + Tcl_DbNewLongObj((boolValue)!=0, file, line) +#undef Tcl_SetBooleanObj +#define Tcl_SetBooleanObj(objPtr, boolValue) \ + Tcl_SetIntObj((objPtr), (boolValue)!=0) +#undef Tcl_SetVar +#define Tcl_SetVar(interp, varName, newValue, flags) \ + Tcl_SetVar2(interp, varName, NULL, newValue, flags) +#undef Tcl_UnsetVar +#define Tcl_UnsetVar(interp, varName, flags) \ + Tcl_UnsetVar2(interp, varName, NULL, flags) +#undef Tcl_GetVar +#define Tcl_GetVar(interp, varName, flags) \ + Tcl_GetVar2(interp, varName, NULL, flags) +#undef Tcl_TraceVar +#define Tcl_TraceVar(interp, varName, flags, proc, clientData) \ + Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData) +#undef Tcl_UntraceVar +#define Tcl_UntraceVar(interp, varName, flags, proc, clientData) \ + Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData) +#undef Tcl_VarTraceInfo +#define Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) \ + Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc, prevClientData) +#undef Tcl_UpVar +#define Tcl_UpVar(interp, frameName, varName, localName, flags) \ + Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags) + +#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) +# if defined(__CYGWIN__) && defined(TCL_WIDE_INT_IS_LONG) +/* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore + * we have to make sure that all stub entries on Cygwin64 follow the + * Win64 signature. Cygwin64 stubbed extensions cannot use those stub + * entries any more, they should use the 64-bit alternatives where + * possible. Tcl 9 must find a better solution, but that cannot be done + * without introducing a binary incompatibility. + */ +# undef Tcl_DbNewLongObj +# undef Tcl_GetLongFromObj +# undef Tcl_NewLongObj +# undef Tcl_SetLongObj +# undef Tcl_ExprLong +# undef Tcl_ExprLongObj +# undef Tcl_UniCharNcmp +# undef Tcl_UtfNcmp +# undef Tcl_UtfNcasecmp +# undef Tcl_UniCharNcasecmp +# define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))Tcl_DbNewWideIntObj) +# define Tcl_GetLongFromObj ((int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetWideIntFromObj) +# define Tcl_NewLongObj ((Tcl_Obj*(*)(long))Tcl_NewWideIntObj) +# define Tcl_SetLongObj ((void(*)(Tcl_Obj*,long))Tcl_SetWideIntObj) +# define Tcl_ExprLong TclExprLong + static inline int TclExprLong(Tcl_Interp *interp, const char *string, long *ptr){ + int intValue; + int result = tclStubsPtr->tcl_ExprLong(interp, string, (long *)&intValue); + if (result == TCL_OK) *ptr = (long)intValue; + return result; + } +# define Tcl_ExprLongObj TclExprLongObj + static inline int TclExprLongObj(Tcl_Interp *interp, Tcl_Obj *obj, long *ptr){ + int intValue; + int result = tclStubsPtr->tcl_ExprLongObj(interp, obj, (long *)&intValue); + if (result == TCL_OK) *ptr = (long)intValue; + return result; + } +# define Tcl_UniCharNcmp(ucs,uct,n) \ + ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcmp)(ucs,uct,(unsigned int)(n)) +# define Tcl_UtfNcmp(s1,s2,n) \ + ((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcmp)(s1,s2,(unsigned int)(n)) +# define Tcl_UtfNcasecmp(s1,s2,n) \ + ((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcasecmp)(s1,s2,(unsigned int)(n)) +# define Tcl_UniCharNcasecmp(ucs,uct,n) \ + ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcasecmp)(ucs,uct,(unsigned int)(n)) +# endif +#endif + +/* + * Deprecated Tcl procedures: + */ + +#undef Tcl_EvalObj +#define Tcl_EvalObj(interp,objPtr) \ + Tcl_EvalObjEx((interp),(objPtr),0) +#undef Tcl_GlobalEvalObj +#define Tcl_GlobalEvalObj(interp,objPtr) \ + Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL) + #endif /* _TCLDECLS */ diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index eb3625e..e31d708 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -91,22 +91,22 @@ static const EnsembleImplMap implementationMap[] = { {"append", DictAppendCmd, TclCompileDictAppendCmd, NULL, NULL, 0 }, {"create", DictCreateCmd, TclCompileDictCreateCmd, NULL, NULL, 0 }, {"exists", DictExistsCmd, TclCompileDictExistsCmd, NULL, NULL, 0 }, - {"filter", DictFilterCmd, NULL, NULL, NULL, 0 }, + {"filter", DictFilterCmd, NULL, NULL, NULL, 0 }, {"for", NULL, TclCompileDictForCmd, DictForNRCmd, NULL, 0 }, {"get", DictGetCmd, TclCompileDictGetCmd, NULL, NULL, 0 }, {"incr", DictIncrCmd, TclCompileDictIncrCmd, NULL, NULL, 0 }, - {"info", DictInfoCmd, NULL, NULL, NULL, 0 }, - {"keys", DictKeysCmd, NULL, NULL, NULL, 0 }, + {"info", DictInfoCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0 }, + {"keys", DictKeysCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, {"lappend", DictLappendCmd, TclCompileDictLappendCmd, NULL, NULL, 0 }, {"map", NULL, TclCompileDictMapCmd, DictMapNRCmd, NULL, 0 }, {"merge", DictMergeCmd, TclCompileDictMergeCmd, NULL, NULL, 0 }, - {"remove", DictRemoveCmd, NULL, NULL, NULL, 0 }, + {"remove", DictRemoveCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0 }, {"replace", DictReplaceCmd, NULL, NULL, NULL, 0 }, {"set", DictSetCmd, TclCompileDictSetCmd, NULL, NULL, 0 }, - {"size", DictSizeCmd, NULL, NULL, NULL, 0 }, + {"size", DictSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0 }, {"unset", DictUnsetCmd, TclCompileDictUnsetCmd, NULL, NULL, 0 }, {"update", DictUpdateCmd, TclCompileDictUpdateCmd, NULL, NULL, 0 }, - {"values", DictValuesCmd, NULL, NULL, NULL, 0 }, + {"values", DictValuesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, {"with", DictWithCmd, TclCompileDictWithCmd, NULL, NULL, 0 }, {NULL, NULL, NULL, NULL, NULL, 0} }; @@ -361,7 +361,7 @@ DupDictInternalRep( Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) { - Dict *oldDict = srcPtr->internalRep.otherValuePtr; + Dict *oldDict = srcPtr->internalRep.twoPtrValue.ptr1; Dict *newDict = ckalloc(sizeof(Dict)); ChainEntry *cPtr; @@ -396,7 +396,7 @@ DupDictInternalRep( * Store in the object. */ - copyPtr->internalRep.otherValuePtr = newDict; + copyPtr->internalRep.twoPtrValue.ptr1 = newDict; copyPtr->typePtr = &tclDictType; } @@ -422,14 +422,12 @@ static void FreeDictInternalRep( Tcl_Obj *dictPtr) { - Dict *dict = dictPtr->internalRep.otherValuePtr; + Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1; dict->refcount--; if (dict->refcount <= 0) { DeleteDict(dict); } - - dictPtr->internalRep.otherValuePtr = NULL; /* Belt and braces! */ dictPtr->typePtr = NULL; } @@ -489,7 +487,7 @@ UpdateStringOfDict( { #define LOCAL_SIZE 20 int localFlags[LOCAL_SIZE], *flagPtr = NULL; - Dict *dict = dictPtr->internalRep.otherValuePtr; + Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1; ChainEntry *cPtr; Tcl_Obj *keyPtr, *valuePtr; int i, length, bytesNeeded = 0; @@ -715,7 +713,7 @@ SetDictFromAny( dict->epoch = 0; dict->chain = NULL; dict->refcount = 1; - objPtr->internalRep.otherValuePtr = dict; + objPtr->internalRep.twoPtrValue.ptr1 = dict; objPtr->typePtr = &tclDictType; return TCL_OK; @@ -784,7 +782,7 @@ TclTraceDictPath( return NULL; } } - dict = dictPtr->internalRep.otherValuePtr; + dict = dictPtr->internalRep.twoPtrValue.ptr1; if (flags & DICT_PATH_UPDATE) { dict->chain = NULL; } @@ -827,7 +825,7 @@ TclTraceDictPath( } } - newDict = tmpObj->internalRep.otherValuePtr; + newDict = tmpObj->internalRep.twoPtrValue.ptr1; if (flags & DICT_PATH_UPDATE) { if (Tcl_IsShared(tmpObj)) { TclDecrRefCount(tmpObj); @@ -835,7 +833,7 @@ TclTraceDictPath( Tcl_IncrRefCount(tmpObj); Tcl_SetHashValue(hPtr, tmpObj); dict->epoch++; - newDict = tmpObj->internalRep.otherValuePtr; + newDict = tmpObj->internalRep.twoPtrValue.ptr1; } newDict->chain = dictPtr; @@ -870,17 +868,17 @@ static void InvalidateDictChain( Tcl_Obj *dictObj) { - Dict *dict = dictObj->internalRep.otherValuePtr; + Dict *dict = dictObj->internalRep.twoPtrValue.ptr1; do { - Tcl_InvalidateStringRep(dictObj); + TclInvalidateStringRep(dictObj); dict->epoch++; dictObj = dict->chain; if (dictObj == NULL) { break; } dict->chain = NULL; - dict = dictObj->internalRep.otherValuePtr; + dict = dictObj->internalRep.twoPtrValue.ptr1; } while (dict != NULL); } @@ -927,9 +925,9 @@ Tcl_DictObjPut( } if (dictPtr->bytes != NULL) { - Tcl_InvalidateStringRep(dictPtr); + TclInvalidateStringRep(dictPtr); } - dict = dictPtr->internalRep.otherValuePtr; + dict = dictPtr->internalRep.twoPtrValue.ptr1; hPtr = CreateChainEntry(dict, keyPtr, &isNew); Tcl_IncrRefCount(valuePtr); if (!isNew) { @@ -980,7 +978,7 @@ Tcl_DictObjGet( } } - dict = dictPtr->internalRep.otherValuePtr; + dict = dictPtr->internalRep.twoPtrValue.ptr1; hPtr = Tcl_FindHashEntry(&dict->table, keyPtr); if (hPtr == NULL) { *valuePtrPtr = NULL; @@ -1029,9 +1027,9 @@ Tcl_DictObjRemove( } if (dictPtr->bytes != NULL) { - Tcl_InvalidateStringRep(dictPtr); + TclInvalidateStringRep(dictPtr); } - dict = dictPtr->internalRep.otherValuePtr; + dict = dictPtr->internalRep.twoPtrValue.ptr1; if (DeleteChainEntry(dict, keyPtr)) { dict->epoch++; } @@ -1071,7 +1069,7 @@ Tcl_DictObjSize( } } - dict = dictPtr->internalRep.otherValuePtr; + dict = dictPtr->internalRep.twoPtrValue.ptr1; *sizePtr = dict->table.numEntries; return TCL_OK; } @@ -1126,7 +1124,7 @@ Tcl_DictObjFirst( } } - dict = dictPtr->internalRep.otherValuePtr; + dict = dictPtr->internalRep.twoPtrValue.ptr1; cPtr = dict->entryChainHead; if (cPtr == NULL) { searchPtr->epoch = -1; @@ -1301,7 +1299,7 @@ Tcl_DictObjPutKeyList( return TCL_ERROR; } - dict = dictPtr->internalRep.otherValuePtr; + dict = dictPtr->internalRep.twoPtrValue.ptr1; hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew); Tcl_IncrRefCount(valuePtr); if (!isNew) { @@ -1357,7 +1355,7 @@ Tcl_DictObjRemoveKeyList( return TCL_ERROR; } - dict = dictPtr->internalRep.otherValuePtr; + dict = dictPtr->internalRep.twoPtrValue.ptr1; DeleteChainEntry(dict, keyv[keyc-1]); InvalidateDictChain(dictPtr); return TCL_OK; @@ -1397,13 +1395,13 @@ Tcl_NewDictObj(void) Dict *dict; TclNewObj(dictPtr); - Tcl_InvalidateStringRep(dictPtr); + TclInvalidateStringRep(dictPtr); dict = ckalloc(sizeof(Dict)); InitChainTable(dict); dict->epoch = 0; dict->chain = NULL; dict->refcount = 1; - dictPtr->internalRep.otherValuePtr = dict; + dictPtr->internalRep.twoPtrValue.ptr1 = dict; dictPtr->typePtr = &tclDictType; return dictPtr; #endif @@ -1446,13 +1444,13 @@ Tcl_DbNewDictObj( Dict *dict; TclDbNewObj(dictPtr, file, line); - Tcl_InvalidateStringRep(dictPtr); + TclInvalidateStringRep(dictPtr); dict = ckalloc(sizeof(Dict)); InitChainTable(dict); dict->epoch = 0; dict->chain = NULL; dict->refcount = 1; - dictPtr->internalRep.otherValuePtr = dict; + dictPtr->internalRep.twoPtrValue.ptr1 = dict; dictPtr->typePtr = &tclDictType; return dictPtr; #else /* !TCL_MEM_DEBUG */ @@ -2064,7 +2062,7 @@ DictInfoCmd( return result; } } - dict = dictPtr->internalRep.otherValuePtr; + dict = dictPtr->internalRep.twoPtrValue.ptr1; statsStr = Tcl_HashStats(&dict->table); Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1)); @@ -2179,7 +2177,7 @@ DictIncrCmd( } } if (code == TCL_OK) { - Tcl_InvalidateStringRep(dictPtr); + TclInvalidateStringRep(dictPtr); valuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr, TCL_LEAVE_ERR_MSG); if (valuePtr == NULL) { @@ -2268,7 +2266,7 @@ DictLappendCmd( if (allocatedValue) { Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr); } else if (dictPtr->bytes != NULL) { - Tcl_InvalidateStringRep(dictPtr); + TclInvalidateStringRep(dictPtr); } resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr, diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 7a55724..2cc55d6 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -270,7 +270,7 @@ static int Iso88591ToUtfProc(ClientData clientData, int *dstCharsPtr); /* - * A Tcl_ObjType for holding a cached Tcl_Encoding in the otherValuePtr field + * A Tcl_ObjType for holding a cached Tcl_Encoding in the twoPtrValue.ptr1 field * of the intrep. This should help the lifetime of encodings be more useful. * See concerns raised in [Bug 1077262]. */ @@ -313,7 +313,7 @@ Tcl_GetEncodingFromObj( return TCL_ERROR; } TclFreeIntRep(objPtr); - objPtr->internalRep.otherValuePtr = encoding; + objPtr->internalRep.twoPtrValue.ptr1 = encoding; objPtr->typePtr = &encodingType; } *encodingPtr = Tcl_GetEncoding(NULL, name); @@ -334,7 +334,7 @@ static void FreeEncodingIntRep( Tcl_Obj *objPtr) { - Tcl_FreeEncoding(objPtr->internalRep.otherValuePtr); + Tcl_FreeEncoding(objPtr->internalRep.twoPtrValue.ptr1); objPtr->typePtr = NULL; } @@ -353,7 +353,7 @@ DupEncodingIntRep( Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) { - dupPtr->internalRep.otherValuePtr = Tcl_GetEncoding(NULL, srcPtr->bytes); + dupPtr->internalRep.twoPtrValue.ptr1 = Tcl_GetEncoding(NULL, srcPtr->bytes); } /* diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 0cad216..9bb7a0c 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -35,12 +35,12 @@ static void MakeCachedEnsembleCommand(Tcl_Obj *objPtr, static void FreeEnsembleCmdRep(Tcl_Obj *objPtr); static void DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static void StringOfEnsembleCmdRep(Tcl_Obj *objPtr); -static int CompileToCompiledCommand(Tcl_Interp *interp, - Tcl_Parse *parsePtr, int depth, Command *cmdPtr, - CompileEnv *envPtr); static void CompileToInvokedCommand(Tcl_Interp *interp, Tcl_Parse *parsePtr, Tcl_Obj *replacements, Command *cmdPtr, CompileEnv *envPtr); +static int CompileBasicNArgCommand(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + CompileEnv *envPtr); /* * The lists of subcommands and options for the [namespace ensemble] command. @@ -85,16 +85,6 @@ const Tcl_ObjType tclEnsembleCmdType = { NULL /* setFromAnyProc */ }; -/* - * Copied from tclCompCmds.c - */ - -#define DefineLineInformation \ - ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \ - int eclIndex = mapPtr->nuloc - 1 -#define SetLineInformation(word) \ - envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \ - envPtr->clNext = mapPtr->loc[eclIndex].next[(word)] static inline Tcl_Obj * NewNsObj( @@ -1534,6 +1524,14 @@ TclMakeEnsemble( cmdName = nameParts[nameCount - 1]; } } + + /* + * Switch on compilation always for core ensembles now that we can do + * nice bytecode things with them. Do it now. Waiting until later will + * just cause pointless epoch bumps. + */ + + ensembleFlags |= ENSEMBLE_COMPILE; ensemble = Tcl_CreateEnsemble(interp, cmdName, ns, ensembleFlags); /* @@ -1585,14 +1583,6 @@ TclMakeEnsemble( } } Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict); - - /* - * Switch on compilation always for core ensembles now that we can do - * nice bytecode things with them. - */ - - Tcl_SetEnsembleFlags(interp, ensemble, - ensembleFlags | ENSEMBLE_COMPILE); } Tcl_DStringFree(&buf); @@ -1715,7 +1705,7 @@ NsEnsembleImplementationCmdNR( if (objv[1+ensemblePtr->numParameters]->typePtr==&tclEnsembleCmdType){ EnsembleCmdRep *ensembleCmd = objv[1+ensemblePtr->numParameters] - ->internalRep.otherValuePtr; + ->internalRep.twoPtrValue.ptr1; if (ensembleCmd->nsPtr == ensemblePtr->nsPtr && ensembleCmd->epoch == ensemblePtr->epoch && @@ -1911,7 +1901,7 @@ NsEnsembleImplementationCmdNR( * Hand off to the target command. */ - iPtr->evalFlags |= TCL_EVAL_REDIRECT; + TclSkipTailcall(interp); return TclNREvalObjEx(interp, copyPtr, TCL_EVAL_INVOKE, NULL,INT_MIN); } @@ -2119,7 +2109,7 @@ EnsembleUnknownCallback( */ Tcl_Preserve(ensemblePtr); - ((Interp *) interp)->evalFlags |= TCL_EVAL_REDIRECT; + TclSkipTailcall(interp); result = Tcl_EvalObjv(interp, paramc, paramv, 0); if ((result == TCL_OK) && (ensemblePtr->flags & ENSEMBLE_DEAD)) { if (!Tcl_InterpDeleted(interp)) { @@ -2193,7 +2183,7 @@ EnsembleUnknownCallback( } Tcl_AddErrorInfo(interp, "\n result of " "ensemble unknown subcommand handler: "); - Tcl_AddErrorInfo(interp, TclGetString(unknownCmd)); + Tcl_AppendObjToErrorInfo(interp, unknownCmd); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_RESULT", NULL); } else { @@ -2235,7 +2225,7 @@ MakeCachedEnsembleCommand( int length; if (objPtr->typePtr == &tclEnsembleCmdType) { - ensembleCmd = objPtr->internalRep.otherValuePtr; + ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1; Tcl_DecrRefCount(ensembleCmd->realPrefixObj); TclNsDecrRefCount(ensembleCmd->nsPtr); ckfree(ensembleCmd->fullSubcmdName); @@ -2247,7 +2237,7 @@ MakeCachedEnsembleCommand( TclFreeIntRep(objPtr); ensembleCmd = ckalloc(sizeof(EnsembleCmdRep)); - objPtr->internalRep.otherValuePtr = ensembleCmd; + objPtr->internalRep.twoPtrValue.ptr1 = ensembleCmd; objPtr->typePtr = &tclEnsembleCmdType; } @@ -2642,7 +2632,7 @@ static void FreeEnsembleCmdRep( Tcl_Obj *objPtr) { - EnsembleCmdRep *ensembleCmd = objPtr->internalRep.otherValuePtr; + EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1; Tcl_DecrRefCount(ensembleCmd->realPrefixObj); ckfree(ensembleCmd->fullSubcmdName); @@ -2674,12 +2664,12 @@ DupEnsembleCmdRep( Tcl_Obj *objPtr, Tcl_Obj *copyPtr) { - EnsembleCmdRep *ensembleCmd = objPtr->internalRep.otherValuePtr; + EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1; EnsembleCmdRep *ensembleCopy = ckalloc(sizeof(EnsembleCmdRep)); int length = strlen(ensembleCmd->fullSubcmdName); copyPtr->typePtr = &tclEnsembleCmdType; - copyPtr->internalRep.otherValuePtr = ensembleCopy; + copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy; ensembleCopy->nsPtr = ensembleCmd->nsPtr; ensembleCopy->epoch = ensembleCmd->epoch; ensembleCopy->token = ensembleCmd->token; @@ -2712,7 +2702,7 @@ static void StringOfEnsembleCmdRep( Tcl_Obj *objPtr) { - EnsembleCmdRep *ensembleCmd = objPtr->internalRep.otherValuePtr; + EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1; int length = strlen(ensembleCmd->fullSubcmdName); objPtr->length = length; @@ -2953,9 +2943,14 @@ TclCompileEnsemble( Tcl_ListObjAppendElement(NULL, replaced, replacement); if (Tcl_ListObjGetElements(NULL, targetCmdObj, &len, &elems) != TCL_OK) { goto failed; - } - if (len != 1) { - goto failed; + } else if (len != 1) { + /* + * Note that at this point we know we can't issue any special + * instruction sequence as the mapping isn't one that we support at + * the compiled level. + */ + + goto cleanup; } targetCmdObj = elems[0]; @@ -2996,8 +2991,8 @@ TclCompileEnsemble( */ invokeAnyway = 1; - if (CompileToCompiledCommand(interp, parsePtr, depth, cmdPtr, - envPtr) == TCL_OK) { + if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, depth, cmdPtr, + envPtr)) { ourResult = TCL_OK; goto cleanup; } @@ -3008,7 +3003,7 @@ TclCompileEnsemble( */ failed: - if (len == 1 && depth < 250) { + if (depth < 250) { if (depth > 1) { if (!invokeAnyway) { cmdPtr = oldCmdPtr; @@ -3031,81 +3026,88 @@ TclCompileEnsemble( return ourResult; } -/* - * How to compile a subcommand using its own command compiler. To do that, we - * have to perform some trickery to rewrite the arguments, as compilers *must* - * have parse tokens that refer to addresses in the original script. - */ - -static int -CompileToCompiledCommand( +int +TclAttemptCompileProc( Tcl_Interp *interp, Tcl_Parse *parsePtr, int depth, Command *cmdPtr, CompileEnv *envPtr) /* Holds resulting instructions. */ { - Tcl_Parse synthetic; - Tcl_Token *tokenPtr; int result, i; + Tcl_Token *saveTokenPtr = parsePtr->tokenPtr; + int savedStackDepth = envPtr->currStackDepth; + unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart; + DefineLineInformation; if (cmdPtr->compileProc == NULL) { return TCL_ERROR; } - TclParseInit(interp, NULL, 0, &synthetic); - synthetic.numWords = parsePtr->numWords - depth + 1; - TclGrowParseTokenArray(&synthetic, 2); - synthetic.numTokens = 2; - /* - * Now we have the space to work in, install something rewritten. The - * first word will "officially" be the bytes of the structured ensemble - * name. That's technically wrong, but nobody will care; we just need - * *something* here... + * Advance parsePtr->tokenPtr so that it points at the last subcommand. + * This will be wrong, but it will not matter, and it will put the + * tokens for the arguments in the right place without the needed to + * allocate a synthetic Tcl_Parse struct, or copy tokens around. */ - synthetic.tokenPtr[0].type = TCL_TOKEN_SIMPLE_WORD; - synthetic.tokenPtr[0].start = parsePtr->tokenPtr[0].start; - synthetic.tokenPtr[0].numComponents = 1; - synthetic.tokenPtr[1].type = TCL_TOKEN_TEXT; - synthetic.tokenPtr[1].start = parsePtr->tokenPtr[0].start; - synthetic.tokenPtr[1].numComponents = 0; - for (i=0,tokenPtr=parsePtr->tokenPtr ; i<depth ; i++) { - int sclen = (tokenPtr->start - synthetic.tokenPtr[0].start) - + tokenPtr->size; - - synthetic.tokenPtr[0].size = sclen; - synthetic.tokenPtr[1].size = sclen; - tokenPtr = TokenAfter(tokenPtr); + for (i = 0; i < depth - 1; i++) { + parsePtr->tokenPtr = TokenAfter(parsePtr->tokenPtr); } + parsePtr->numWords -= (depth - 1); /* - * Copy over the real argument tokens. + * Shift the line information arrays to account for different word + * index values. */ - for (i=1; i<synthetic.numWords; i++) { - int toCopy; - - toCopy = tokenPtr->numComponents + 1; - TclGrowParseTokenArray(&synthetic, toCopy); - memcpy(synthetic.tokenPtr + synthetic.numTokens, tokenPtr, - sizeof(Tcl_Token) * toCopy); - synthetic.numTokens += toCopy; - tokenPtr = TokenAfter(tokenPtr); - } + mapPtr->loc[eclIndex].line += (depth - 1); + mapPtr->loc[eclIndex].next += (depth - 1); /* * Hand off compilation to the subcommand compiler. At last! */ - result = cmdPtr->compileProc(interp, &synthetic, cmdPtr, envPtr); + result = cmdPtr->compileProc(interp, parsePtr, cmdPtr, envPtr); + + /* + * Undo the shift. + */ + + mapPtr->loc[eclIndex].line -= (depth - 1); + mapPtr->loc[eclIndex].next -= (depth - 1); + + parsePtr->numWords += (depth - 1); + parsePtr->tokenPtr = saveTokenPtr; /* - * Clean up if necessary. + * If our target failed to compile, revert any data from failed partial + * compiles. Note that envPtr->numCommands need not be checked because + * we avoid compiling subcommands that recursively call TclCompileScript(). */ - Tcl_FreeParse(&synthetic); + if (result != TCL_OK) { + envPtr->currStackDepth = savedStackDepth; + envPtr->codeNext = envPtr->codeStart + savedCodeNext; +#ifdef TCL_COMPILE_DEBUG + } else { + /* + * Confirm that the command compiler generated a single value on + * the stack as its result. This is only done in debugging mode, + * as it *should* be correct and normal users have no reasonable + * way to fix it anyway. + */ + + int diff = envPtr->currStackDepth - savedStackDepth; + + if (diff != 1) { + Tcl_Panic("bad stack adjustment when compiling" + " %.*s (was %d instead of 1)", parsePtr->tokenPtr->size, + parsePtr->tokenPtr->start, diff); + } +#endif + } + return result; } @@ -3135,28 +3137,29 @@ CompileToInvokedCommand( */ Tcl_ListObjGetElements(NULL, replacements, &numWords, &words); - for (i=0,tokPtr=parsePtr->tokenPtr ; i<parsePtr->numWords ; i++) { + for (i = 0, tokPtr = parsePtr->tokenPtr; i < parsePtr->numWords; + i++, tokPtr = TokenAfter(tokPtr)) { if (i > 0 && i < numWords+1) { bytes = Tcl_GetStringFromObj(words[i-1], &length); PushLiteral(envPtr, bytes, length); - } else if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) { + continue; + } + + SetLineInformation(i); + if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) { int literal = TclRegisterNewLiteral(envPtr, tokPtr[1].start, tokPtr[1].size); if (envPtr->clNext) { TclContinuationsEnterDerived( - envPtr->literalArrayPtr[literal].objPtr, + TclFetchLiteral(envPtr, literal), tokPtr[1].start - envPtr->source, - mapPtr->loc[eclIndex].next[i]); + envPtr->clNext); } TclEmitPush(literal, envPtr); } else { - if (envPtr->clNext) { - SetLineInformation(i); - } CompileTokens(envPtr, tokPtr, interp); } - tokPtr = TokenAfter(tokPtr); } /* @@ -3168,7 +3171,7 @@ CompileToInvokedCommand( Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr); bytes = Tcl_GetStringFromObj(objPtr, &length); cmdLit = TclRegisterNewCmdLiteral(envPtr, bytes, length); - TclSetCmdNameObj(interp, envPtr->literalArrayPtr[cmdLit].objPtr, cmdPtr); + TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr); TclEmitPush(cmdLit, envPtr); TclDecrRefCount(objPtr); @@ -3176,9 +3179,302 @@ CompileToInvokedCommand( * Do the replacing dispatch. */ - TclEmitInstInt4(INST_INVOKE_REPLACE, parsePtr->numWords, envPtr); - TclEmitInt1(numWords+1, envPtr); - TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs. */ + TclEmitInvoke(envPtr, INST_INVOKE_REPLACE, parsePtr->numWords,numWords+1); +} + +/* + * Helpers that do issuing of instructions for commands that "don't have + * compilers" (well, they do; these). They all work by just generating base + * code to invoke the command; they're intended for ensemble subcommands so + * that the costs of INST_INVOKE_REPLACE can be avoided where we can work out + * that they're not needed. + * + * Note that these are NOT suitable for commands where there's an argument + * that is a script, as an [info level] or [info frame] in the inner context + * can see the difference. + */ + +static int +CompileBasicNArgCommand( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + Tcl_Obj *objPtr = Tcl_NewObj(); + + Tcl_IncrRefCount(objPtr); + Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr); + TclCompileInvocation(interp, parsePtr->tokenPtr, objPtr, + parsePtr->numWords, envPtr); + Tcl_DecrRefCount(objPtr); + return TCL_OK; +} + +int +TclCompileBasic0ArgCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + /* + * Verify that the number of arguments is correct; that's the only case + * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, + * which is the only code that sees the shenanigans of ensemble dispatch. + */ + + if (parsePtr->numWords != 1) { + return TCL_ERROR; + } + + return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); +} + +int +TclCompileBasic1ArgCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + /* + * Verify that the number of arguments is correct; that's the only case + * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, + * which is the only code that sees the shenanigans of ensemble dispatch. + */ + + if (parsePtr->numWords != 2) { + return TCL_ERROR; + } + + return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); +} + +int +TclCompileBasic2ArgCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + /* + * Verify that the number of arguments is correct; that's the only case + * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, + * which is the only code that sees the shenanigans of ensemble dispatch. + */ + + if (parsePtr->numWords != 3) { + return TCL_ERROR; + } + + return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); +} + +int +TclCompileBasic3ArgCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + /* + * Verify that the number of arguments is correct; that's the only case + * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, + * which is the only code that sees the shenanigans of ensemble dispatch. + */ + + if (parsePtr->numWords != 4) { + return TCL_ERROR; + } + + return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); +} + +int +TclCompileBasic0Or1ArgCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + /* + * Verify that the number of arguments is correct; that's the only case + * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, + * which is the only code that sees the shenanigans of ensemble dispatch. + */ + + if (parsePtr->numWords != 1 && parsePtr->numWords != 2) { + return TCL_ERROR; + } + + return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); +} + +int +TclCompileBasic1Or2ArgCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + /* + * Verify that the number of arguments is correct; that's the only case + * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, + * which is the only code that sees the shenanigans of ensemble dispatch. + */ + + if (parsePtr->numWords != 2 && parsePtr->numWords != 3) { + return TCL_ERROR; + } + + return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); +} + +int +TclCompileBasic2Or3ArgCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + /* + * Verify that the number of arguments is correct; that's the only case + * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, + * which is the only code that sees the shenanigans of ensemble dispatch. + */ + + if (parsePtr->numWords != 3 && parsePtr->numWords != 4) { + return TCL_ERROR; + } + + return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); +} + +int +TclCompileBasic0To2ArgCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + /* + * Verify that the number of arguments is correct; that's the only case + * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, + * which is the only code that sees the shenanigans of ensemble dispatch. + */ + + if (parsePtr->numWords < 1 || parsePtr->numWords > 3) { + return TCL_ERROR; + } + + return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); +} + +int +TclCompileBasic1To3ArgCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + /* + * Verify that the number of arguments is correct; that's the only case + * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, + * which is the only code that sees the shenanigans of ensemble dispatch. + */ + + if (parsePtr->numWords < 2 || parsePtr->numWords > 4) { + return TCL_ERROR; + } + + return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); +} + +int +TclCompileBasicMin0ArgCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + /* + * Verify that the number of arguments is correct; that's the only case + * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, + * which is the only code that sees the shenanigans of ensemble dispatch. + */ + + if (parsePtr->numWords < 1) { + return TCL_ERROR; + } + + return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); +} + +int +TclCompileBasicMin1ArgCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + /* + * Verify that the number of arguments is correct; that's the only case + * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, + * which is the only code that sees the shenanigans of ensemble dispatch. + */ + + if (parsePtr->numWords < 2) { + return TCL_ERROR; + } + + return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); +} + +int +TclCompileBasicMin2ArgCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + /* + * Verify that the number of arguments is correct; that's the only case + * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time, + * which is the only code that sees the shenanigans of ensemble dispatch. + */ + + if (parsePtr->numWords < 3) { + return TCL_ERROR; + } + + return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr); } /* diff --git a/generic/tclEnv.c b/generic/tclEnv.c index b5ae6ea..8f51c1b 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -76,36 +76,56 @@ TclSetupEnv( Tcl_Interp *interp) /* Interpreter whose "env" array is to be * managed. */ { + Var *varPtr, *arrayPtr; + Tcl_Obj *varNamePtr; Tcl_DString envString; - char *p1, *p2; - int i; + Tcl_HashTable namesHash; + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; /* * 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. - * 2) Unset the "env" variable. - * 3) If there are no environ variables, create an empty "env" array. - * Otherwise populate the array with current values. - * 4) Add a trace that synchronizes the "env" array. + * 1) Remove the trace that fires when the "env" var is updated. + * 2) Find the existing contents of the "env", storing in a hash table. + * 3) Create/update elements for each environ variable, removing + * elements from the hash table as we go. + * 4) Remove the elements for each remaining entry in the hash table, + * which must have existed before yet have no analog in the environ + * variable. + * 5) Add a trace that synchronizes the "env" array. */ Tcl_UntraceVar2(interp, "env", NULL, TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL); - Tcl_UnsetVar2(interp, "env", NULL, TCL_GLOBAL_ONLY); + /* + * Find out what elements are currently in the global env array. + */ - if (environ[0] == NULL) { - Tcl_Obj *varNamePtr; + TclNewLiteralStringObj(varNamePtr, "env"); + Tcl_IncrRefCount(varNamePtr); + Tcl_InitObjHashTable(&namesHash); + varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL, TCL_GLOBAL_ONLY, + /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); + TclFindArrayPtrElements(varPtr, &namesHash); + + /* + * Go through the environment array and transfer its values into Tcl. At + * the same time, remove those elements we add/update from the hash table + * of existing elements, so that after this part processes, that table + * will hold just the parts to remove. + */ + + if (environ[0] != NULL) { + int i; - TclNewLiteralStringObj(varNamePtr, "env"); - Tcl_IncrRefCount(varNamePtr); - TclArraySet(interp, varNamePtr, NULL); - Tcl_DecrRefCount(varNamePtr); - } else { Tcl_MutexLock(&envMutex); for (i = 0; environ[i] != NULL; i++) { + Tcl_Obj *obj1, *obj2; + char *p1, *p2; + p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString); p2 = strchr(p1, '='); if (p2 == NULL) { @@ -119,12 +139,41 @@ TclSetupEnv( } p2++; p2[-1] = '\0'; - Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY); + obj1 = Tcl_NewStringObj(p1, -1); + obj2 = Tcl_NewStringObj(p2, -1); Tcl_DStringFree(&envString); + + Tcl_IncrRefCount(obj1); + Tcl_IncrRefCount(obj2); + Tcl_ObjSetVar2(interp, varNamePtr, obj1, obj2, TCL_GLOBAL_ONLY); + hPtr = Tcl_FindHashEntry(&namesHash, obj1); + if (hPtr != NULL) { + Tcl_DeleteHashEntry(hPtr); + } + Tcl_DecrRefCount(obj1); + Tcl_DecrRefCount(obj2); } Tcl_MutexUnlock(&envMutex); } + /* + * Delete those elements that existed in the array but which had no + * counterparts in the environment array. + */ + + for (hPtr=Tcl_FirstHashEntry(&namesHash, &search); hPtr!=NULL; + hPtr=Tcl_NextHashEntry(&search)) { + Tcl_Obj *elemName = Tcl_GetHashValue(hPtr); + + TclObjUnsetVar2(interp, varNamePtr, elemName, TCL_GLOBAL_ONLY); + } + Tcl_DeleteHashTable(&namesHash); + Tcl_DecrRefCount(varNamePtr); + + /* + * Re-establish the trace. + */ + Tcl_TraceVar2(interp, "env", NULL, TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL); @@ -565,7 +614,8 @@ EnvTraceProc( const char *value = TclGetEnv(name2, &valueString); if (value == NULL) { - return (char *) "no such variable"; + Tcl_UnsetVar2(interp, name1, name2, 0); + return NULL; } Tcl_SetVar2(interp, name1, name2, value, 0); Tcl_DStringFree(&valueString); diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 0b585b6..941d566 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -1030,14 +1030,8 @@ TclInitSubsystems(void) TclpInitLock(); if (subsystemsInitialized == 0) { - /* - * Have to set this bit here to avoid deadlock with the routines - * below us that call into TclInitSubsystems. - */ - - subsystemsInitialized = 1; - /* + /* * Initialize locks used by the memory allocators before anything * interesting happens so we can use the allocators in the * implementation of self-initializing locks. @@ -1061,6 +1055,7 @@ TclInitSubsystems(void) TclInitEncodingSubsystem(); /* Process wide encoding init. */ TclpSetInterfaces(); TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */ + subsystemsInitialized = 1; } TclpInitUnlock(); } @@ -1176,8 +1171,6 @@ Tcl_Finalize(void) TclFinalizeEncodingSubsystem(); - Tcl_SetPanicProc(NULL); - /* * Repeat finalization of the thread local storage once more. Although * this step is already done by the Tcl_FinalizeThread call above, series @@ -1402,7 +1395,7 @@ Tcl_VwaitObjCmd( return TCL_ERROR; } nameString = Tcl_GetString(objv[1]); - if (Tcl_TraceVar(interp, nameString, + if (Tcl_TraceVar2(interp, nameString, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, &done) != TCL_OK) { return TCL_ERROR; @@ -1420,7 +1413,7 @@ Tcl_VwaitObjCmd( break; } } - Tcl_UntraceVar(interp, nameString, + Tcl_UntraceVar2(interp, nameString, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, &done); diff --git a/generic/tclExecute.c b/generic/tclExecute.c index c495fd8..ab26161 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -202,6 +202,9 @@ typedef struct TEBCdata { #define PUSH_TAUX_OBJ(objPtr) \ do { \ + if (auxObjList) { \ + objPtr->length += auxObjList->length; \ + } \ objPtr->internalRep.ptrAndLongRep.ptr = auxObjList; \ auxObjList = objPtr; \ } while (0) @@ -251,13 +254,27 @@ VarHashCreateVar( * otherwise, push objResultPtr. If (result < 0), objResultPtr already * has the correct reference count. * - * We use the new compile-time assertions to cheack that nCleanup is constant + * We use the new compile-time assertions to check that nCleanup is constant * and within range. */ -#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \ +/* Verify the stack depth, only when no expansion is in progress */ + +#ifdef TCL_COMPILE_DEBUG +#define CHECK_STACK() \ + do { \ + ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH, \ + /*checkStack*/ !(starting || auxObjList)); \ + starting = 0; \ + } while (0) +#else +#define CHECK_STACK() +#endif + +#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \ do { \ TCL_CT_ASSERT((nCleanup >= 0) && (nCleanup <= 2)); \ + CHECK_STACK(); \ if (nCleanup == 0) { \ if (resultHandling != 0) { \ if ((resultHandling) > 0) { \ @@ -276,17 +293,20 @@ VarHashCreateVar( switch (nCleanup) { \ case 1: goto cleanup1_pushObjResultPtr; \ case 2: goto cleanup2_pushObjResultPtr; \ + case 0: break; \ } \ } else { \ pc += (pcAdjustment); \ switch (nCleanup) { \ case 1: goto cleanup1; \ case 2: goto cleanup2; \ + case 0: break; \ } \ } \ } while (0) -#define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling) \ +#define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling) \ + CHECK_STACK(); \ do { \ pc += (pcAdjustment); \ cleanup = (nCleanup); \ @@ -342,6 +362,8 @@ VarHashCreateVar( #define CURR_DEPTH ((ptrdiff_t) (tosPtr - initTosPtr)) +#define STACK_BASE(esPtr) ((esPtr)->stackWords - 1) + /* * Macros used to trace instruction execution. The macros TRACE, * TRACE_WITH_OBJ, and O2S are only used inside TclNRExecuteByteCode. O2S is @@ -419,7 +441,7 @@ VarHashCreateVar( * ClientData *ptrPtr, int *tPtr); */ -#ifdef NO_WIDE_TYPE +#ifdef TCL_WIDE_INT_IS_LONG #define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \ (((objPtr)->typePtr == &tclIntType) \ ? (*(tPtr) = TCL_NUMBER_LONG, \ @@ -433,9 +455,9 @@ VarHashCreateVar( (&((objPtr)->internalRep.doubleValue)), TCL_OK) : \ ((((objPtr)->typePtr == NULL) && ((objPtr)->bytes == NULL)) || \ (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))) \ - ? TCL_ERROR : \ + ? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR : \ TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr))) -#else /* !NO_WIDE_TYPE */ +#else /* !TCL_WIDE_INT_IS_LONG */ #define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \ (((objPtr)->typePtr == &tclIntType) \ ? (*(tPtr) = TCL_NUMBER_LONG, \ @@ -453,9 +475,9 @@ VarHashCreateVar( (&((objPtr)->internalRep.doubleValue)), TCL_OK) : \ ((((objPtr)->typePtr == NULL) && ((objPtr)->bytes == NULL)) || \ (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))) \ - ? TCL_ERROR : \ + ? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR : \ TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr))) -#endif /* NO_WIDE_TYPE */ +#endif /* TCL_WIDE_INT_IS_LONG */ /* * Macro used in this file to save a function call for common uses of @@ -479,13 +501,13 @@ VarHashCreateVar( * Tcl_WideInt *wideIntPtr); */ -#ifdef NO_WIDE_TYPE +#ifdef TCL_WIDE_INT_IS_LONG #define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ (((objPtr)->typePtr == &tclIntType) \ ? (*(wideIntPtr) = (Tcl_WideInt) \ ((objPtr)->internalRep.longValue), TCL_OK) : \ Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) -#else /* !NO_WIDE_TYPE */ +#else /* !TCL_WIDE_INT_IS_LONG */ #define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ (((objPtr)->typePtr == &tclWideIntType) \ ? (*(wideIntPtr) = (objPtr)->internalRep.wideValue, TCL_OK) : \ @@ -493,7 +515,7 @@ VarHashCreateVar( ? (*(wideIntPtr) = (Tcl_WideInt) \ ((objPtr)->internalRep.longValue), TCL_OK) : \ Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) -#endif /* NO_WIDE_TYPE */ +#endif /* TCL_WIDE_INT_IS_LONG */ /* * Macro used to make the check for type overflow more mnemonic. This works by @@ -685,7 +707,7 @@ static void PrintByteCodeInfo(ByteCode *codePtr); static const char * StringForResultCode(int result); static void ValidatePcAndStackTop(ByteCode *codePtr, const unsigned char *pc, int stackTop, - int stackLowerBound, int checkStack); + int checkStack); #endif /* TCL_COMPILE_DEBUG */ static ByteCode * CompileExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr); static void DeleteExecStack(ExecStack *esPtr); @@ -703,13 +725,13 @@ static ExceptionRange * GetExceptRangeForPc(const unsigned char *pc, int catchOnly, ByteCode *codePtr); static const char * GetSrcInfoForPc(const unsigned char *pc, ByteCode *codePtr, int *lengthPtr, - const unsigned char **pcBeg); + const unsigned char **pcBeg, int *cmdIdxPtr); static Tcl_Obj ** GrowEvaluationStack(ExecEnv *eePtr, int growth, int move); static void IllegalExprOperandType(Tcl_Interp *interp, const unsigned char *pc, Tcl_Obj *opndPtr); static void InitByteCodeExecution(Tcl_Interp *interp); -static inline int OFFSET(void *ptr); +static inline int wordSkip(void *ptr); static void ReleaseDictIterator(Tcl_Obj *objPtr); /* Useful elsewhere, make available in tclInt.h or stubs? */ static Tcl_Obj ** StackAllocWords(Tcl_Interp *interp, int numWords); @@ -867,7 +889,7 @@ TclCreateExecEnv( esPtr->nextPtr = NULL; esPtr->markerPtr = NULL; esPtr->endPtr = &esPtr->stackWords[size-1]; - esPtr->tosPtr = &esPtr->stackWords[-1]; + esPtr->tosPtr = STACK_BASE(esPtr); Tcl_MutexLock(&execMutex); if (!execInitialized) { @@ -986,13 +1008,13 @@ TclFinalizeExecution(void) (TCL_ALLOCALIGN/sizeof(Tcl_Obj *)) /* - * OFFSET computes how many words have to be skipped until the next aligned + * wordSkip computes how many words have to be skipped until the next aligned * word. Note that we are only interested in the low order bits of ptr, so * that any possible information loss in PTR2INT is of no consequence. */ static inline int -OFFSET( +wordSkip( void *ptr) { int mask = TCL_ALLOCALIGN-1; @@ -1005,7 +1027,7 @@ OFFSET( */ #define MEMSTART(markerPtr) \ - ((markerPtr) + OFFSET(markerPtr)) + ((markerPtr) + wordSkip(markerPtr)) /* *---------------------------------------------------------------------- @@ -1048,8 +1070,9 @@ GrowEvaluationStack( return MEMSTART(markerPtr); } } else { +#ifndef PURIFY Tcl_Obj **tmpMarkerPtr = esPtr->tosPtr + 1; - int offset = OFFSET(tmpMarkerPtr); + int offset = wordSkip(tmpMarkerPtr); if (needed + offset < 0) { /* @@ -1064,6 +1087,7 @@ GrowEvaluationStack( *esPtr->markerPtr = (Tcl_Obj *) markerPtr; return memStart; } +#endif } /* @@ -1077,6 +1101,7 @@ GrowEvaluationStack( } needed = growth + moveWords + WALLOCALIGN; + /* * Check if there is enough room in the next stack (if there is one, it * should be both empty and the last one!) @@ -1085,8 +1110,8 @@ GrowEvaluationStack( if (esPtr->nextPtr) { oldPtr = esPtr; esPtr = oldPtr->nextPtr; - currElems = esPtr->endPtr - &esPtr->stackWords[-1]; - if (esPtr->markerPtr || (esPtr->tosPtr != &esPtr->stackWords[-1])) { + currElems = esPtr->endPtr - STACK_BASE(esPtr); + if (esPtr->markerPtr || (esPtr->tosPtr != STACK_BASE(esPtr))) { Tcl_Panic("STACK: Stack after current is in use"); } if (esPtr->nextPtr) { @@ -1098,7 +1123,7 @@ GrowEvaluationStack( DeleteExecStack(esPtr); esPtr = oldPtr; } else { - currElems = esPtr->endPtr - &esPtr->stackWords[-1]; + currElems = esPtr->endPtr - STACK_BASE(esPtr); } /* @@ -1106,10 +1131,15 @@ GrowEvaluationStack( * including the elements to be copied over and the new marker. */ +#ifndef PURIFY newElems = 2*currElems; while (needed > newElems) { newElems *= 2; } +#else + newElems = needed; +#endif + newBytes = sizeof(ExecStack) + (newElems-1) * sizeof(Tcl_Obj *); oldPtr = esPtr; @@ -1247,10 +1277,10 @@ TclStackFree( while (esPtr->nextPtr) { esPtr = esPtr->nextPtr; } - esPtr->tosPtr = &esPtr->stackWords[-1]; + esPtr->tosPtr = STACK_BASE(esPtr); while (esPtr->prevPtr) { ExecStack *tmpPtr = esPtr->prevPtr; - if (tmpPtr->tosPtr == &tmpPtr->stackWords[-1]) { + if (tmpPtr->tosPtr == STACK_BASE(tmpPtr)) { DeleteExecStack(tmpPtr); } else { break; @@ -1258,6 +1288,10 @@ TclStackFree( } if (esPtr->prevPtr) { eePtr->execStackPtr = esPtr->prevPtr; +#ifdef PURIFY + eePtr->execStackPtr->nextPtr = NULL; + DeleteExecStack(esPtr); +#endif } else { eePtr->execStackPtr = esPtr; } @@ -1396,17 +1430,12 @@ Tcl_NRExprObj( Tcl_Obj *resultPtr) { ByteCode *codePtr; + Tcl_InterpState state = Tcl_SaveInterpState(interp, TCL_OK); - /* TODO: consider saving whole state? */ - Tcl_Obj *saveObjPtr = Tcl_GetObjResult(interp); - - Tcl_IncrRefCount(saveObjPtr); - + Tcl_ResetResult(interp); codePtr = CompileExprObj(interp, objPtr); - /* TODO: Confirm reset not required? */ - /*Tcl_ResetResult(interp);*/ - Tcl_NRAddCallback(interp, ExprObjCallback, saveObjPtr, resultPtr, + Tcl_NRAddCallback(interp, ExprObjCallback, state, resultPtr, NULL, NULL); return TclNRExecuteByteCode(interp, codePtr); } @@ -1417,14 +1446,15 @@ ExprObjCallback( Tcl_Interp *interp, int result) { - Tcl_Obj *saveObjPtr = data[0]; + Tcl_InterpState state = data[0]; Tcl_Obj *resultPtr = data[1]; if (result == TCL_OK) { TclSetDuplicateObj(resultPtr, Tcl_GetObjResult(interp)); - Tcl_SetObjResult(interp, saveObjPtr); + (void) Tcl_RestoreInterpState(interp, state); + } else { + Tcl_DiscardInterpState(state); } - TclDecrRefCount(saveObjPtr); return result; } @@ -1467,7 +1497,7 @@ CompileExprObj( if (objPtr->typePtr == &exprCodeType) { Namespace *namespacePtr = iPtr->varFramePtr->nsPtr; - codePtr = objPtr->internalRep.otherValuePtr; + codePtr = objPtr->internalRep.twoPtrValue.ptr1; if (((Interp *) *codePtr->interpHandle != iPtr) || (codePtr->compileEpoch != iPtr->compileEpoch) || (codePtr->nsPtr != namespacePtr) @@ -1507,7 +1537,7 @@ CompileExprObj( TclInitByteCodeObj(objPtr, &compEnv); objPtr->typePtr = &exprCodeType; TclFreeCompileEnv(&compEnv); - codePtr = objPtr->internalRep.otherValuePtr; + codePtr = objPtr->internalRep.twoPtrValue.ptr1; if (iPtr->varFramePtr->localCachePtr) { codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr; codePtr->localCachePtr->refCount++; @@ -1579,10 +1609,9 @@ static void FreeExprCodeInternalRep( Tcl_Obj *objPtr) { - ByteCode *codePtr = objPtr->internalRep.otherValuePtr; + ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1; objPtr->typePtr = NULL; - objPtr->internalRep.otherValuePtr = NULL; codePtr->refCount--; if (codePtr->refCount <= 0) { TclCleanupByteCode(codePtr); @@ -1640,7 +1669,7 @@ TclCompileObj( * here. */ - codePtr = objPtr->internalRep.otherValuePtr; + codePtr = objPtr->internalRep.twoPtrValue.ptr1; if (((Interp *) *codePtr->interpHandle != iPtr) || (codePtr->compileEpoch != iPtr->compileEpoch) || (codePtr->nsPtr != namespacePtr) @@ -1768,7 +1797,7 @@ TclCompileObj( iPtr->invokeWord = word; TclSetByteCodeFromAny(interp, objPtr, NULL, NULL); iPtr->invokeCmdFramePtr = NULL; - codePtr = objPtr->internalRep.otherValuePtr; + codePtr = objPtr->internalRep.twoPtrValue.ptr1; if (iPtr->varFramePtr->localCachePtr) { codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr; codePtr->localCachePtr->refCount++; @@ -1842,7 +1871,7 @@ TclIncrObj( TclSetLongObj(valuePtr, sum); return TCL_OK; } -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG { Tcl_WideInt w1 = (Tcl_WideInt) augend; Tcl_WideInt w2 = (Tcl_WideInt) addend; @@ -1875,7 +1904,7 @@ TclIncrObj( return TCL_ERROR; } -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) { Tcl_WideInt w1, w2, sum; @@ -1973,7 +2002,6 @@ TclNRExecuteByteCode( bcFramePtr->type = ((codePtr->flags & TCL_BYTECODE_PRECOMPILED) ? TCL_LOCATION_PREBC : TCL_LOCATION_BC); bcFramePtr->level = (iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level+1 : 1); - bcFramePtr->numLevels = iPtr->numLevels; bcFramePtr->framePtr = iPtr->framePtr; bcFramePtr->nextPtr = iPtr->cmdFramePtr; bcFramePtr->nline = 0; @@ -1981,8 +2009,9 @@ TclNRExecuteByteCode( bcFramePtr->litarg = NULL; bcFramePtr->data.tebc.codePtr = codePtr; bcFramePtr->data.tebc.pc = NULL; - bcFramePtr->cmd.str.cmd = NULL; - bcFramePtr->cmd.str.len = 0; + bcFramePtr->cmdObj = NULL; + bcFramePtr->cmd = NULL; + bcFramePtr->len = 0; #ifdef TCL_COMPILE_STATS iPtr->stats.numExecutions++; @@ -2060,7 +2089,8 @@ TEBCresume( Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation * stack. */ const unsigned char *pc; /* The current program counter. */ - + unsigned char inst; /* The currently running instruction */ + /* * Transfer variables - needed only between opcodes, but not while * executing an instruction. @@ -2085,6 +2115,7 @@ TEBCresume( #endif #ifdef TCL_COMPILE_DEBUG + int starting = 1; traceInstructions = (tclTraceExec == 3); #endif @@ -2103,6 +2134,11 @@ TEBCresume( result = TCL_ERROR; } NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr); + if (bcFramePtr->cmdObj) { + Tcl_DecrRefCount(bcFramePtr->cmdObj); + bcFramePtr->cmdObj = NULL; + bcFramePtr->cmd = NULL; + } iPtr->cmdFramePtr = bcFramePtr->nextPtr; if (iPtr->flags & INTERP_DEBUG_FRAME) { TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr); @@ -2114,11 +2150,6 @@ TEBCresume( CACHE_STACK_INFO(); if (result == TCL_OK) { -#ifndef TCL_COMPILE_DEBUG - if (*pc == INST_POP) { - NEXT_INST_V(1, cleanup, 0); - } -#endif /* * Push the call's object result and continue execution with the * next instruction. @@ -2127,8 +2158,6 @@ TEBCresume( TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=", objc, cmdNameBuf), Tcl_GetObjResult(interp)); - objResultPtr = Tcl_GetObjResult(interp); - /* * Reset the interp's result to avoid possible duplications of * large objects [Bug 781585]. We do not call Tcl_ResetResult to @@ -2140,9 +2169,16 @@ TEBCresume( * the refCount it had in its role of iPtr->objResultPtr. */ + objResultPtr = Tcl_GetObjResult(interp); TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); iPtr->objResultPtr = objPtr; +#ifndef TCL_COMPILE_DEBUG + if (*pc == INST_POP) { + TclDecrRefCount(objResultPtr); + NEXT_INST_V(1, cleanup, 0); + } +#endif NEXT_INST_V(0, cleanup, -1); } @@ -2226,24 +2262,6 @@ TEBCresume( } cleanup0: -#ifdef TCL_COMPILE_DEBUG - /* - * Skip the stack depth check if an expansion is in progress. - */ - - ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH, 0, - /*checkStack*/ auxObjList == NULL); - if (traceInstructions) { - fprintf(stdout, "%2d: %2d ", iPtr->numLevels, (int) CURR_DEPTH); - TclPrintInstruction(codePtr, pc); - fflush(stdout); - } -#endif /* TCL_COMPILE_DEBUG */ - -#ifdef TCL_COMPILE_STATS - iPtr->stats.instructionCount[*pc]++; -#endif - /* * Check for asynchronous handlers [Bug 746722]; we do the check every * ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-1). @@ -2275,8 +2293,6 @@ TEBCresume( CACHE_STACK_INFO(); } - TCL_DTRACE_INST_NEXT(); - /* * These two instructions account for 26% of all instructions (according * to measurements on tclbench by Ben Vitale @@ -2286,13 +2302,62 @@ TEBCresume( * reduces total obj size. */ - if (*pc == INST_LOAD_SCALAR1) { - goto instLoadScalar1; - } else if (*pc == INST_PUSH1) { - goto instPush1Peephole; + inst = *pc; + + peepholeStart: +#ifdef TCL_COMPILE_STATS + iPtr->stats.instructionCount[*pc]++; +#endif + +#ifdef TCL_COMPILE_DEBUG + /* + * Skip the stack depth check if an expansion is in progress. + */ + + CHECK_STACK(); + if (traceInstructions) { + fprintf(stdout, "%2d: %2d ", iPtr->numLevels, (int) CURR_DEPTH); + TclPrintInstruction(codePtr, pc); + fflush(stdout); } +#endif /* TCL_COMPILE_DEBUG */ - switch (*pc) { + TCL_DTRACE_INST_NEXT(); + + if (inst == INST_LOAD_SCALAR1) { + goto instLoadScalar1; + } else if (inst == INST_PUSH1) { + PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]); + TRACE_WITH_OBJ(("%u => ", TclGetUInt1AtPtr(pc+1)), OBJ_AT_TOS); + inst = *(pc += 2); + goto peepholeStart; + } else if (inst == INST_START_CMD) { + /* + * Peephole: do not run INST_START_CMD, just skip it + */ + + iPtr->cmdCount += TclGetUInt4AtPtr(pc+5); + if (checkInterp) { + checkInterp = 0; + if (((codePtr->compileEpoch != iPtr->compileEpoch) || + (codePtr->nsEpoch != iPtr->varFramePtr->nsPtr->resolverEpoch)) && + !(codePtr->flags & TCL_BYTECODE_PRECOMPILED)) { + goto instStartCmdFailed; + } + } + inst = *(pc += 9); + goto peepholeStart; + } else if (inst == INST_NOP) { +#ifndef TCL_COMPILE_DEBUG + while (inst == INST_NOP) +#endif + { + inst = *++pc; + } + goto peepholeStart; + } + + switch (inst) { case INST_SYNTAX: case INST_RETURN_IMM: { int code = TclGetInt4AtPtr(pc+1); @@ -2305,7 +2370,7 @@ TEBCresume( TRACE(("%u %u => ", code, level)); result = TclProcessReturn(interp, code, level, OBJ_AT_TOS); if (result == TCL_OK) { - TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")", + TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")\n", O2S(objResultPtr))); NEXT_INST_F(9, 1, 0); } @@ -2314,6 +2379,7 @@ TEBCresume( iPtr->flags &= ~ERR_ALREADY_LOGGED; } cleanup = 2; + TRACE_APPEND(("\n")); goto processExceptionReturn; } @@ -2321,15 +2387,30 @@ TEBCresume( TRACE(("=> ")); objResultPtr = POP_OBJECT(); result = Tcl_SetReturnOptions(interp, OBJ_AT_TOS); - Tcl_DecrRefCount(OBJ_AT_TOS); - OBJ_AT_TOS = objResultPtr; if (result == TCL_OK) { - TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")", + Tcl_DecrRefCount(OBJ_AT_TOS); + OBJ_AT_TOS = objResultPtr; + TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")\n", O2S(objResultPtr))); NEXT_INST_F(1, 0, 0); + } else if (result == TCL_ERROR) { + /* + * BEWARE! Must do this in this order, because an error in the + * option dictionary overrides the result (and can be verified by + * test). + */ + + Tcl_SetObjResult(interp, objResultPtr); + Tcl_SetReturnOptions(interp, OBJ_AT_TOS); + Tcl_DecrRefCount(OBJ_AT_TOS); + OBJ_AT_TOS = objResultPtr; + } else { + Tcl_DecrRefCount(OBJ_AT_TOS); + OBJ_AT_TOS = objResultPtr; + Tcl_SetObjResult(interp, objResultPtr); } - Tcl_SetObjResult(interp, objResultPtr); cleanup = 1; + TRACE_APPEND(("\n")); goto processExceptionReturn; case INST_YIELD: { @@ -2359,8 +2440,11 @@ TEBCresume( iPtr->cmdFramePtr = bcFramePtr; if (iPtr->flags & INTERP_DEBUG_FRAME) { - TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc, - codePtr, bcFramePtr, pc - codePtr->codeStart); + int cmd; + if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) { + TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc, + codePtr, bcFramePtr, cmd, pc - codePtr->codeStart); + } } pc++; @@ -2376,7 +2460,6 @@ TEBCresume( case INST_TAILCALL: { Tcl_Obj *listPtr, *nsObjPtr; - NRE_callback *tailcallPtr; opnd = TclGetUInt1AtPtr(pc+1); @@ -2410,18 +2493,12 @@ TEBCresume( listPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1)); nsObjPtr = Tcl_NewStringObj(iPtr->varFramePtr->nsPtr->fullName, -1); - Tcl_IncrRefCount(listPtr); - Tcl_IncrRefCount(nsObjPtr); - TclNRAddCallback(interp, TclNRTailcallEval, listPtr, nsObjPtr, - NULL, NULL); - - /* - * Unstitch ourselves and do a [return]. - */ + TclListObjSetElement(interp, listPtr, 0, nsObjPtr); + if (iPtr->varFramePtr->tailcallPtr) { + Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr); + } + iPtr->varFramePtr->tailcallPtr = listPtr; - tailcallPtr = TOP_CB(interp); - TOP_CB(interp) = tailcallPtr->nextPtr; - iPtr->varFramePtr->tailcallPtr = tailcallPtr; result = TCL_RETURN; cleanup = opnd; goto processExceptionReturn; @@ -2449,23 +2526,6 @@ TEBCresume( (void) POP_OBJECT(); goto abnormalReturn; - case INST_PUSH1: - instPush1Peephole: - PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]); - TRACE_WITH_OBJ(("%u => ", TclGetInt1AtPtr(pc+1)), OBJ_AT_TOS); - pc += 2; -#if !TCL_COMPILE_DEBUG - /* - * Runtime peephole optimisation: check if we are pushing again. - */ - - if (*pc == INST_PUSH1) { - TCL_DTRACE_INST_NEXT(); - goto instPush1Peephole; - } -#endif - NEXT_INST_F(0, 0, 0); - case INST_PUSH4: objResultPtr = codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)]; TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), objResultPtr); @@ -2475,68 +2535,7 @@ TEBCresume( TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS); objPtr = POP_OBJECT(); TclDecrRefCount(objPtr); - - /* - * Runtime peephole optimisation: an INST_POP is scheduled at the end - * of most commands. If the next instruction is an INST_START_CMD, - * fall through to it. - */ - - pc++; -#if !TCL_COMPILE_DEBUG - if (*pc == INST_START_CMD) { - TCL_DTRACE_INST_NEXT(); - goto instStartCmdPeephole; - } -#endif - NEXT_INST_F(0, 0, 0); - - case INST_START_CMD: -#if !TCL_COMPILE_DEBUG - instStartCmdPeephole: -#endif - /* - * Remark that if the interpreter is marked for deletion its - * compileEpoch is modified, so that the epoch check also verifies - * that the interp is not deleted. If no outside call has been made - * since the last check, it is safe to omit the check. - */ - - iPtr->cmdCount += TclGetUInt4AtPtr(pc+5); - if (!checkInterp) { - goto instStartCmdOK; - } else if (((codePtr->compileEpoch == iPtr->compileEpoch) - && (codePtr->nsEpoch == iPtr->varFramePtr->nsPtr->resolverEpoch)) - || (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) { - checkInterp = 0; - instStartCmdOK: - NEXT_INST_F(9, 0, 0); - } else { - const char *bytes; - - length = 0; - - /* - * We used to switch to direct eval; for NRE-awareness we now - * compile and eval the command so that this evaluation does not - * add a new TEBC instance. [Bug 2910748] - */ - - if (TclInterpReady(interp) == TCL_ERROR) { - goto gotError; - } - - codePtr->flags |= TCL_BYTECODE_RECOMPILE; - bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL); - opnd = TclGetUInt4AtPtr(pc+1); - pc += (opnd-1); - PUSH_OBJECT(Tcl_NewStringObj(bytes, length)); - goto instEvalStk; - } - - case INST_NOP: - pc += 1; - goto cleanup0; + NEXT_INST_F(1, 0, 0); case INST_DUP: objResultPtr = OBJ_AT_TOS; @@ -2564,7 +2563,7 @@ TEBCresume( NEXT_INST_F(5, 0, 0); } - case INST_CONCAT1: { + case INST_STR_CONCAT1: { int appendLen = 0; char *bytes, *p; Tcl_Obj **currPtr; @@ -2644,7 +2643,7 @@ TEBCresume( Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } -#if !TCL_COMPILE_DEBUG +#ifndef TCL_COMPILE_DEBUG if (bytes != tclEmptyStringRep && !Tcl_IsShared(objResultPtr)) { TclFreeIntRep(objResultPtr); objResultPtr->bytes = ckrealloc(bytes, length+appendLen+1); @@ -2680,7 +2679,7 @@ TEBCresume( Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } -#if !TCL_COMPILE_DEBUG +#ifndef TCL_COMPILE_DEBUG if (!Tcl_IsShared(objResultPtr)) { bytes = (char *) Tcl_SetByteArrayLength(objResultPtr, length + appendLen); @@ -2713,6 +2712,17 @@ TEBCresume( NEXT_INST_V(2, opnd, 1); } + case INST_CONCAT_STK: + /* + * Pop the opnd (objc) top stack elements, run through Tcl_ConcatObj, + * and then decrement their ref counts. + */ + + opnd = TclGetUInt4AtPtr(pc+1); + objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd-1)); + TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); + NEXT_INST_V(5, opnd, 1); + case INST_EXPAND_START: /* * Push an element to the auxObjList. This records the current @@ -2729,9 +2739,26 @@ TEBCresume( TclNewObj(objPtr); objPtr->internalRep.ptrAndLongRep.value = CURR_DEPTH; + objPtr->length = 0; PUSH_TAUX_OBJ(objPtr); NEXT_INST_F(1, 0, 0); + case INST_EXPAND_DROP: + /* + * Drops an element of the auxObjList, popping stack elements to + * restore the stack to the state before the point where the aux + * element was created. + */ + + CLANG_ASSERT(auxObjList); + objc = CURR_DEPTH - auxObjList->internalRep.ptrAndLongRep.value; + POP_TAUX_OBJ(); +#ifdef TCL_COMPILE_DEBUG + /* Ugly abuse! */ + starting = 1; +#endif + NEXT_INST_V(1, objc, 0); + case INST_EXPAND_STKTOP: { int i; ptrdiff_t moved; @@ -2757,22 +2784,27 @@ TEBCresume( * stack depth, as seen by the compiler. */ - length = objc + (codePtr->maxStackDepth - TclGetInt4AtPtr(pc+1)); - DECACHE_STACK_INFO(); - moved = GrowEvaluationStack(iPtr->execEnvPtr, length, 1) - - (Tcl_Obj **) TD; - if (moved) { - /* - * Change the global data to point to the new stack: move the - * TEBCdataPtr TD, recompute the position of every other - * stack-allocated parameter, update the stack pointers. - */ + auxObjList->length += objc - 1; + if ((objc > 1) && (auxObjList->length > 0)) { + length = auxObjList->length /* Total expansion room we need */ + + codePtr->maxStackDepth /* Beyond the original max */ + - CURR_DEPTH; /* Relative to where we are */ + DECACHE_STACK_INFO(); + moved = GrowEvaluationStack(iPtr->execEnvPtr, length, 1) + - (Tcl_Obj **) TD; + if (moved) { + /* + * Change the global data to point to the new stack: move the + * TEBCdataPtr TD, recompute the position of every other + * stack-allocated parameter, update the stack pointers. + */ - esPtr = iPtr->execEnvPtr->execStackPtr; - TD = (TEBCdata *) (((Tcl_Obj **)TD) + moved); + esPtr = iPtr->execEnvPtr->execStackPtr; + TD = (TEBCdata *) (((Tcl_Obj **)TD) + moved); - catchTop += moved; - tosPtr += moved; + catchTop += moved; + tosPtr += moved; + } } /* @@ -2876,8 +2908,11 @@ TEBCresume( iPtr->cmdFramePtr = bcFramePtr; if (iPtr->flags & INTERP_DEBUG_FRAME) { - TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc, - codePtr, bcFramePtr, pc - codePtr->codeStart); + int cmd; + if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) { + TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc, + codePtr, bcFramePtr, cmd, pc - codePtr->codeStart); + } } DECACHE_STACK_INFO(); @@ -2885,7 +2920,7 @@ TEBCresume( pc += pcAdjustment; TEBC_YIELD(); return TclNREvalObjv(interp, objc, objv, - TCL_EVAL_NOERR, NULL); + TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL); #if TCL_SUPPORT_84_BYTECODE case INST_CALL_BUILTIN_FUNC1: @@ -3022,8 +3057,11 @@ TEBCresume( bcFramePtr->data.tebc.pc = (char *) pc; iPtr->cmdFramePtr = bcFramePtr; if (iPtr->flags & INTERP_DEBUG_FRAME) { - TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc, - codePtr, bcFramePtr, pc - codePtr->codeStart); + int cmd; + if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) { + TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc, + codePtr, bcFramePtr, cmd, pc - codePtr->codeStart); + } } iPtr->ensembleRewrite.sourceObjs = objv; iPtr->ensembleRewrite.numRemovedObjs = opnd; @@ -3031,8 +3069,9 @@ TEBCresume( DECACHE_STACK_INFO(); pc += 6; TEBC_YIELD(); + TclNRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL); - iPtr->evalFlags |= TCL_EVAL_REDIRECT; + TclSkipTailcall(interp); return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE, NULL, INT_MIN); /* @@ -3447,7 +3486,7 @@ TEBCresume( { Tcl_Obj *incrPtr; -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG Tcl_WideInt w; #endif long increment; @@ -3496,8 +3535,8 @@ TEBCresume( varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr, TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr); if (!varPtr) { - Tcl_AddObjErrorInfo(interp, - "\n (reading value of variable to increment)", -1); + Tcl_AddErrorInfo(interp, + "\n (reading value of variable to increment)"); TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); Tcl_DecrRefCount(incrPtr); goto gotError; @@ -3569,7 +3608,7 @@ TEBCresume( } goto doneIncr; } -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG w = (Tcl_WideInt)augend; TRACE(("%u %ld => ", opnd, increment)); @@ -3591,7 +3630,7 @@ TEBCresume( goto doneIncr; #endif } /* end if (type == TCL_NUMBER_LONG) */ -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG if (type == TCL_NUMBER_WIDE) { Tcl_WideInt sum; @@ -3659,7 +3698,7 @@ TEBCresume( arrayPtr = NULL; part1Ptr = part2Ptr = NULL; cleanup = 0; - TRACE(("%u %ld => ", opnd, increment)); + TRACE(("%u %s => ", opnd, Tcl_GetString(incrPtr))); doIncrVar: if (TclIsVarDirectModifyable2(varPtr, arrayPtr)) { @@ -4224,7 +4263,7 @@ TEBCresume( } else { TRACE(("%d => %.20s false, new pc %u\n", jmpOffset[0], O2S(valuePtr), - (unsigned)(pc + jmpOffset[1] - codePtr->codeStart))); + (unsigned)(pc + jmpOffset[0] - codePtr->codeStart))); } } #endif @@ -4363,15 +4402,37 @@ TEBCresume( TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } - case INST_RESOLVE_COMMAND: { - Tcl_Command cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS); + { + Tcl_Command cmd, origCmd; + case INST_RESOLVE_COMMAND: + cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS); TclNewObj(objResultPtr); if (cmd != NULL) { Tcl_GetCommandFullName(interp, cmd, objResultPtr); } TRACE_WITH_OBJ(("\"%.20s\" => ", O2S(OBJ_AT_TOS)), objResultPtr); NEXT_INST_F(1, 1, 1); + + case INST_ORIGIN_COMMAND: + TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS))); + cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS); + if (cmd == NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid command name \"%s\"", TclGetString(OBJ_AT_TOS))); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", + TclGetString(OBJ_AT_TOS), NULL); + TRACE_APPEND(("ERROR: not command\n")); + goto gotError; + } + origCmd = TclGetOriginalCommand(cmd); + if (origCmd == NULL) { + origCmd = cmd; + } + TclNewObj(objResultPtr); + Tcl_GetCommandFullName(interp, origCmd, objResultPtr); + TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_TOS))); + NEXT_INST_F(1, 1, 1); } /* @@ -4769,7 +4830,7 @@ TEBCresume( if (listPtr->refCount == 1) { TRACE(("\"%.30s\" %d %d => ", O2S(valuePtr), TclGetInt4AtPtr(pc+1), TclGetInt4AtPtr(pc+5))); - for (index=toIdx+1 ; index<objc-1 ; index++) { + for (index=toIdx+1; index<objc ; index++) { TclDecrRefCount(objv[index]); } listPtr->elemCount = toIdx+1; @@ -4851,6 +4912,29 @@ TEBCresume( objResultPtr = TCONST(match); NEXT_INST_F(0, 2, 1); + case INST_LIST_CONCAT: + value2Ptr = OBJ_AT_TOS; + valuePtr = OBJ_UNDER_TOS; + TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); + if (Tcl_IsShared(valuePtr)) { + objResultPtr = Tcl_DuplicateObj(valuePtr); + if (Tcl_ListObjAppendList(interp, objResultPtr, + value2Ptr) != TCL_OK) { + TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); + TclDecrRefCount(objResultPtr); + goto gotError; + } + TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); + NEXT_INST_F(1, 2, 1); + } else { + if (Tcl_ListObjAppendList(interp, valuePtr, value2Ptr) != TCL_OK){ + TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); + goto gotError; + } + TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr))); + NEXT_INST_F(1, 1, 0); + } + /* * End of INST_LIST and related instructions. * ----------------------------------------------------------------- @@ -4995,6 +5079,55 @@ TEBCresume( TRACE(("%.20s => %d\n", O2S(valuePtr), length)); NEXT_INST_F(1, 1, 1); + case INST_STR_UPPER: + valuePtr = OBJ_AT_TOS; + TRACE(("\"%.25s\" => ", O2S(valuePtr))); + if (Tcl_IsShared(valuePtr)) { + s1 = TclGetStringFromObj(valuePtr, &length); + TclNewStringObj(objResultPtr, s1, length); + length = Tcl_UtfToUpper(TclGetString(objResultPtr)); + Tcl_SetObjLength(objResultPtr, length); + TRACE_APPEND(("\"%.25s\"\n", O2S(objResultPtr))); + NEXT_INST_F(1, 1, 1); + } else { + length = Tcl_UtfToUpper(TclGetString(valuePtr)); + Tcl_SetObjLength(valuePtr, length); + TRACE_APPEND(("\"%.25s\"\n", O2S(valuePtr))); + NEXT_INST_F(1, 0, 0); + } + case INST_STR_LOWER: + valuePtr = OBJ_AT_TOS; + TRACE(("\"%.25s\" => ", O2S(valuePtr))); + if (Tcl_IsShared(valuePtr)) { + s1 = TclGetStringFromObj(valuePtr, &length); + TclNewStringObj(objResultPtr, s1, length); + length = Tcl_UtfToLower(TclGetString(objResultPtr)); + Tcl_SetObjLength(objResultPtr, length); + TRACE_APPEND(("\"%.25s\"\n", O2S(objResultPtr))); + NEXT_INST_F(1, 1, 1); + } else { + length = Tcl_UtfToLower(TclGetString(valuePtr)); + Tcl_SetObjLength(valuePtr, length); + TRACE_APPEND(("\"%.25s\"\n", O2S(valuePtr))); + NEXT_INST_F(1, 0, 0); + } + case INST_STR_TITLE: + valuePtr = OBJ_AT_TOS; + TRACE(("\"%.25s\" => ", O2S(valuePtr))); + if (Tcl_IsShared(valuePtr)) { + s1 = TclGetStringFromObj(valuePtr, &length); + TclNewStringObj(objResultPtr, s1, length); + length = Tcl_UtfToTitle(TclGetString(objResultPtr)); + Tcl_SetObjLength(objResultPtr, length); + TRACE_APPEND(("\"%.25s\"\n", O2S(objResultPtr))); + NEXT_INST_F(1, 1, 1); + } else { + length = Tcl_UtfToTitle(TclGetString(valuePtr)); + Tcl_SetObjLength(valuePtr, length); + TRACE_APPEND(("\"%.25s\"\n", O2S(valuePtr))); + NEXT_INST_F(1, 0, 0); + } + case INST_STR_INDEX: value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; @@ -5101,6 +5234,178 @@ TEBCresume( int length3; Tcl_Obj *value3Ptr; + case INST_STR_REPLACE: + value3Ptr = POP_OBJECT(); + valuePtr = OBJ_AT_DEPTH(2); + length = Tcl_GetCharLength(valuePtr) - 1; + TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr), + O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(value3Ptr))); + if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length, + &fromIdx) != TCL_OK + || TclGetIntForIndexM(interp, OBJ_AT_TOS, length, + &toIdx) != TCL_OK) { + TclDecrRefCount(value3Ptr); + goto gotError; + } + TclDecrRefCount(OBJ_AT_TOS); + (void) POP_OBJECT(); + TclDecrRefCount(OBJ_AT_TOS); + (void) POP_OBJECT(); + if (fromIdx < 0) { + fromIdx = 0; + } + + if (fromIdx > toIdx || fromIdx > length) { + TRACE_APPEND(("%.30s\n", O2S(valuePtr))); + TclDecrRefCount(value3Ptr); + NEXT_INST_F(1, 0, 0); + } + + if (toIdx > length) { + toIdx = length; + } + + if (fromIdx == 0 && toIdx == length) { + TclDecrRefCount(OBJ_AT_TOS); + OBJ_AT_TOS = value3Ptr; + TRACE_APPEND(("%.30s\n", O2S(value3Ptr))); + NEXT_INST_F(1, 0, 0); + } + + length3 = Tcl_GetCharLength(value3Ptr); + + /* + * Remove substring. In-place. + */ + + if (length3 == 0 && !Tcl_IsShared(valuePtr) && toIdx == length) { + TclDecrRefCount(value3Ptr); + Tcl_SetObjLength(valuePtr, fromIdx); + TRACE_APPEND(("%.30s\n", O2S(valuePtr))); + NEXT_INST_F(1, 0, 0); + } + + /* + * See if we can splice in place. This happens when the number of + * characters being replaced is the same as the number of characters + * in the string to be inserted. + */ + + if (length3 - 1 == toIdx - fromIdx) { + unsigned char *bytes1, *bytes2; + + if (Tcl_IsShared(valuePtr)) { + objResultPtr = Tcl_DuplicateObj(valuePtr); + if (TclIsPureByteArray(objResultPtr) + && TclIsPureByteArray(value3Ptr)) { + bytes1 = Tcl_GetByteArrayFromObj(objResultPtr, NULL); + bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL); + memcpy(bytes1 + fromIdx, bytes2, length3); + } else { + ustring1 = Tcl_GetUnicodeFromObj(objResultPtr, NULL); + ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL); + memcpy(ustring1 + fromIdx, ustring2, + length3 * sizeof(Tcl_UniChar)); + + /* + * Magic! Flush the info in the string internal rep that + * refers to the about-to-be-invalidated UTF-8 rep. This + * sets the 'allocated' field of the String structure to 0 + * to indicate that a new buffer needs to be allocated. + * This is safe; we know we've got a tclStringTypePtr set + * at this point (post Tcl_GetUnicodeFromObj). + */ + + ((int *) objResultPtr->internalRep.otherValuePtr)[1] = 0; + } + Tcl_InvalidateStringRep(objResultPtr); + TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); + NEXT_INST_F(1, 1, 1); + } else { + if (TclIsPureByteArray(valuePtr) + && TclIsPureByteArray(value3Ptr)) { + bytes1 = Tcl_GetByteArrayFromObj(valuePtr, NULL); + bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL); + memcpy(bytes1 + fromIdx, bytes2, length3); + } else { + ustring1 = Tcl_GetUnicodeFromObj(valuePtr, NULL); + ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL); + memcpy(ustring1 + fromIdx, ustring2, + length3 * sizeof(Tcl_UniChar)); + + /* + * Magic! Flush the info in the string internal rep that + * refers to the about-to-be-invalidated UTF-8 rep. This + * sets the 'allocated' field of the String structure to 0 + * to indicate that a new buffer needs to be allocated. + * This is safe; we know we've got a tclStringTypePtr set + * at this point (post Tcl_GetUnicodeFromObj). + */ + + ((int *) objResultPtr->internalRep.otherValuePtr)[1] = 0; + } + Tcl_InvalidateStringRep(valuePtr); + TRACE_APPEND(("%.30s\n", O2S(valuePtr))); + NEXT_INST_F(1, 0, 0); + } + } + + /* + * Get the unicode representation; this is where we guarantee to lose + * bytearrays. + */ + + ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length); + length--; + + /* + * Remove substring using copying. + */ + + if (length3 == 0) { + if (fromIdx > 0) { + objResultPtr = Tcl_NewUnicodeObj(ustring1, fromIdx); + if (toIdx < length) { + Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1, + length - toIdx); + } + } else { + objResultPtr = Tcl_NewUnicodeObj(ustring1 + toIdx + 1, + length - toIdx); + } + TclDecrRefCount(value3Ptr); + TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); + NEXT_INST_F(1, 1, 1); + } + + /* + * Splice string pieces by full copying. + */ + + if (fromIdx > 0) { + objResultPtr = Tcl_NewUnicodeObj(ustring1, fromIdx); + Tcl_AppendObjToObj(objResultPtr, value3Ptr); + if (toIdx < length) { + Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1, + length - toIdx); + } + } else if (Tcl_IsShared(value3Ptr)) { + objResultPtr = Tcl_DuplicateObj(value3Ptr); + if (toIdx < length) { + Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1, + length - toIdx); + } + } else { + objResultPtr = value3Ptr; + if (toIdx < length) { + Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1, + length - toIdx); + } + } + TclDecrRefCount(value3Ptr); + TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); + NEXT_INST_F(1, 1, 1); + case INST_STR_MAP: valuePtr = OBJ_AT_TOS; /* "Main" string. */ value3Ptr = OBJ_UNDER_TOS; /* "Target" string. */ @@ -5260,6 +5565,65 @@ TEBCresume( objResultPtr = TCONST(match); NEXT_INST_F(0, 2, 1); + { + const char *string1, *string2; + int trim1, trim2; + + case INST_STR_TRIM: + valuePtr = OBJ_UNDER_TOS; /* String */ + value2Ptr = OBJ_AT_TOS; /* TrimSet */ + string2 = TclGetStringFromObj(value2Ptr, &length2); + string1 = TclGetStringFromObj(valuePtr, &length); + trim1 = TclTrimLeft(string1, length, string2, length2); + if (trim1 < length) { + trim2 = TclTrimRight(string1, length, string2, length2); + } else { + trim2 = 0; + } + if (trim1 == 0 && trim2 == 0) { + TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ", + O2S(valuePtr), O2S(value2Ptr)), valuePtr); + NEXT_INST_F(1, 1, 0); + } else { + objResultPtr = Tcl_NewStringObj(string1+trim1, length-trim1-trim2); + TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ", + O2S(valuePtr), O2S(value2Ptr)), objResultPtr); + NEXT_INST_F(1, 2, 1); + } + case INST_STR_TRIM_LEFT: + valuePtr = OBJ_UNDER_TOS; /* String */ + value2Ptr = OBJ_AT_TOS; /* TrimSet */ + string2 = TclGetStringFromObj(value2Ptr, &length2); + string1 = TclGetStringFromObj(valuePtr, &length); + trim1 = TclTrimLeft(string1, length, string2, length2); + if (trim1 == 0) { + TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ", + O2S(valuePtr), O2S(value2Ptr)), valuePtr); + NEXT_INST_F(1, 1, 0); + } else { + objResultPtr = Tcl_NewStringObj(string1+trim1, length-trim1); + TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ", + O2S(valuePtr), O2S(value2Ptr)), objResultPtr); + NEXT_INST_F(1, 2, 1); + } + case INST_STR_TRIM_RIGHT: + valuePtr = OBJ_UNDER_TOS; /* String */ + value2Ptr = OBJ_AT_TOS; /* TrimSet */ + string2 = TclGetStringFromObj(value2Ptr, &length2); + string1 = TclGetStringFromObj(valuePtr, &length); + trim2 = TclTrimRight(string1, length, string2, length2); + if (trim2 == 0) { + TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ", + O2S(valuePtr), O2S(value2Ptr)), valuePtr); + NEXT_INST_F(1, 1, 0); + } else { + objResultPtr = Tcl_NewStringObj(string1, length-trim2); + TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ", + O2S(valuePtr), O2S(value2Ptr)), objResultPtr); + NEXT_INST_F(1, 2, 1); + } + } + case INST_REGEXP: cflags = TclGetInt1AtPtr(pc+1); /* RE compile flages like NOCASE */ valuePtr = OBJ_AT_TOS; /* String */ @@ -5722,7 +6086,7 @@ TEBCresume( w1 = (Tcl_WideInt) l1; w2 = (Tcl_WideInt) l2; wResult = w1 + w2; -#ifdef NO_WIDE_TYPE +#ifdef TCL_WIDE_INT_IS_LONG /* * Check for overflow. */ @@ -5737,7 +6101,7 @@ TEBCresume( w1 = (Tcl_WideInt) l1; w2 = (Tcl_WideInt) l2; wResult = w1 - w2; -#ifdef NO_WIDE_TYPE +#ifdef TCL_WIDE_INT_IS_LONG /* * Must check for overflow. The macro tests for overflows in * sums by looking at the sign bits. As we have a subtraction @@ -6033,7 +6397,7 @@ TEBCresume( int varIndex, valIndex, continueLoop, j, iterTmpIndex; long i; - case INST_FOREACH_START4: + case INST_FOREACH_START4: /* DEPRECATED */ /* * Initialize the temporary local var that holds the count of the * number of iterations of the loop body to -1. @@ -6066,7 +6430,7 @@ TEBCresume( NEXT_INST_F(5, 0, 0); #endif - case INST_FOREACH_STEP4: + case INST_FOREACH_STEP4: /* DEPRECATED */ /* * "Step" a foreach loop (i.e., begin its next iteration) by assigning * the next value list element to each loop var. @@ -6184,6 +6548,190 @@ TEBCresume( } else { NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0); } + + } + { + ForeachInfo *infoPtr; + Tcl_Obj *listPtr, **elements, *tmpPtr; + ForeachVarList *varListPtr; + int numLists, iterMax, listLen, numVars; + int iterTmp, iterNum, listTmpDepth; + int varIndex, valIndex, j; + long i; + + case INST_FOREACH_START: + /* + * Initialize the data for the looping construct, pushing the + * corresponding Tcl_Objs to the stack. + */ + + opnd = TclGetUInt4AtPtr(pc+1); + infoPtr = codePtr->auxDataArrayPtr[opnd].clientData; + numLists = infoPtr->numLists; + + /* + * Compute the number of iterations that will be run: iterMax + */ + + iterMax = 0; + listTmpDepth = numLists-1; + for (i = 0; i < numLists; i++) { + varListPtr = infoPtr->varLists[i]; + numVars = varListPtr->numVars; + listPtr = OBJ_AT_DEPTH(listTmpDepth); + if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) { + TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ", + opnd, i, O2S(listPtr)), Tcl_GetObjResult(interp)); + goto gotError; + } + if (Tcl_IsShared(listPtr)) { + objPtr = TclListObjCopy(NULL, listPtr); + Tcl_IncrRefCount(objPtr); + Tcl_DecrRefCount(listPtr); + OBJ_AT_DEPTH(listTmpDepth) = objPtr; + } + iterTmp = (listLen + (numVars - 1))/numVars; + if (iterTmp > iterMax) { + iterMax = iterTmp; + } + listTmpDepth--; + } + + /* + * Store the iterNum and iterMax in a single Tcl_Obj; we keep a + * nul-string obj with the pointer stored in the ptrValue so that the + * thing is properly garbage collected. THIS OBJ MAKES NO SENSE, but + * it will never leave this scope and is read-only. + */ + + TclNewObj(tmpPtr); + tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(0); + tmpPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(iterMax); + PUSH_OBJECT(tmpPtr); /* iterCounts object */ + + /* + * Store a pointer to the ForeachInfo struct; same dirty trick + * as above + */ + + TclNewObj(tmpPtr); + tmpPtr->internalRep.otherValuePtr = infoPtr; + PUSH_OBJECT(tmpPtr); /* infoPtr object */ + + /* + * Jump directly to the INST_FOREACH_STEP instruction; the C code just + * falls through. + */ + + pc += 5 - infoPtr->loopCtTemp; + + case INST_FOREACH_STEP: + /* + * "Step" a foreach loop (i.e., begin its next iteration) by assigning + * the next value list element to each loop var. + */ + + tmpPtr = OBJ_AT_TOS; + infoPtr = tmpPtr->internalRep.otherValuePtr; + numLists = infoPtr->numLists; + + tmpPtr = OBJ_AT_DEPTH(1); + iterNum = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr1); + iterMax = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr2); + + /* + * If some list still has a remaining list element iterate one more + * time. Assign to var the next element from its value list. + */ + + if (iterNum < iterMax) { + /* + * Set the variables and jump back to run the body + */ + + tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(iterNum + 1); + + listTmpDepth = numLists + 1; + + for (i = 0; i < numLists; i++) { + varListPtr = infoPtr->varLists[i]; + numVars = varListPtr->numVars; + + listPtr = OBJ_AT_DEPTH(listTmpDepth); + TclListObjGetElements(interp, listPtr, &listLen, &elements); + + valIndex = (iterNum * numVars); + for (j = 0; j < numVars; j++) { + if (valIndex >= listLen) { + TclNewObj(valuePtr); + } else { + valuePtr = elements[valIndex]; + } + + varIndex = varListPtr->varIndexes[j]; + varPtr = LOCAL(varIndex); + while (TclIsVarLink(varPtr)) { + varPtr = varPtr->value.linkPtr; + } + if (TclIsVarDirectWritable(varPtr)) { + value2Ptr = varPtr->value.objPtr; + if (valuePtr != value2Ptr) { + if (value2Ptr != NULL) { + TclDecrRefCount(value2Ptr); + } + varPtr->value.objPtr = valuePtr; + Tcl_IncrRefCount(valuePtr); + } + } else { + DECACHE_STACK_INFO(); + if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL, + valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){ + CACHE_STACK_INFO(); + TRACE_WITH_OBJ(( + "%u => ERROR init. index temp %d: ", + opnd,varIndex), Tcl_GetObjResult(interp)); + goto gotError; + } + CACHE_STACK_INFO(); + } + valIndex++; + } + listTmpDepth--; + } + /* loopCtTemp being 'misused' for storing the jump size */ + NEXT_INST_F(infoPtr->loopCtTemp, 0, 0); + } + + /* + * FALL THROUGH + */ + pc++; + + case INST_FOREACH_END: + /* THIS INSTRUCTION IS ONLY CALLED AS A BREAK TARGET */ + tmpPtr = OBJ_AT_TOS; + infoPtr = tmpPtr->internalRep.otherValuePtr; + numLists = infoPtr->numLists; + NEXT_INST_V(1, numLists+2, 0); + + case INST_LMAP_COLLECT: + /* + * This instruction is only issued by lmap. The stack is: + * - result + * - infoPtr + * - loop counters + * - valLists + * - collecting obj (unshared) + * The instruction lappends the result to the collecting obj. + */ + + tmpPtr = OBJ_AT_DEPTH(1); + infoPtr = tmpPtr->internalRep.otherValuePtr; + numLists = infoPtr->numLists; + + objPtr = OBJ_AT_DEPTH(3 + numLists); + Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS); + NEXT_INST_F(1, 1, 0); } case INST_BEGIN_CATCH4: @@ -6639,7 +7187,7 @@ TEBCresume( } #endif - TRACE_APPEND(("\"%.30s\" \"%.30s\" %d", + TRACE_APPEND(("\"%.30s\" \"%.30s\" %d\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done)); objResultPtr = TCONST(done); /* TODO: consider opt like INST_FOREACH_STEP4 */ @@ -6653,7 +7201,7 @@ TEBCresume( while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } - TRACE(("%u => ", opnd)); + TRACE(("%u => \n", opnd)); if (TclIsVarDirectReadable(varPtr)) { dictPtr = varPtr->value.objPtr; } else { @@ -6782,6 +7330,7 @@ TEBCresume( O2S(dictPtr), O2S(listPtr)), Tcl_GetObjResult(interp)); goto gotError; } + TRACE((" => ")); TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); @@ -6869,7 +7418,7 @@ TEBCresume( */ processExceptionReturn: -#if TCL_COMPILE_DEBUG +#ifdef TCL_COMPILE_DEBUG switch (*pc) { case INST_INVOKE_STK1: opnd = TclGetUInt1AtPtr(pc+1); @@ -6926,7 +7475,7 @@ TEBCresume( rangePtr->codeOffset, rangePtr->continueOffset)); NEXT_INST_F(0, 0, 0); } -#if TCL_COMPILE_DEBUG +#ifdef TCL_COMPILE_DEBUG if (traceInstructions) { objPtr = Tcl_GetObjResult(interp); if ((result != TCL_ERROR) && (result != TCL_RETURN)) { @@ -6988,7 +7537,7 @@ TEBCresume( if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { const unsigned char *pcBeg; - bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg); + bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg, NULL); DECACHE_STACK_INFO(); TclLogCommandInfo(interp, codePtr->source, bytes, bytes ? length : 0, pcBeg, tosPtr); @@ -7140,6 +7689,42 @@ TEBCresume( TclStackFree(interp, TD); /* free my stack */ return result; + + /* + * INST_START_CMD failure case removed where it doesn't bother that much + * + * Remark that if the interpreter is marked for deletion its + * compileEpoch is modified, so that the epoch check also verifies + * that the interp is not deleted. If no outside call has been made + * since the last check, it is safe to omit the check. + + * case INST_START_CMD: + */ + + instStartCmdFailed: + { + const char *bytes; + + checkInterp = 1; + length = 0; + + /* + * We used to switch to direct eval; for NRE-awareness we now + * compile and eval the command so that this evaluation does not + * add a new TEBC instance. [Bug 2910748] + */ + + if (TclInterpReady(interp) == TCL_ERROR) { + goto gotError; + } + + codePtr->flags |= TCL_BYTECODE_RECOMPILE; + bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL, NULL); + opnd = TclGetUInt4AtPtr(pc+1); + pc += (opnd-1); + PUSH_OBJECT(Tcl_NewStringObj(bytes, length)); + goto instEvalStk; + } } #undef codePtr @@ -7246,7 +7831,7 @@ ExecuteExtendedBinaryMathOp( return constants[0]; } } -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG if (type1 == TCL_NUMBER_WIDE) { w1 = *((const Tcl_WideInt *)ptr1); if (type2 != TCL_NUMBER_BIG) { @@ -7321,7 +7906,7 @@ ExecuteExtendedBinaryMathOp( case TCL_NUMBER_LONG: invalid = (*((const long *)ptr2) < 0L); break; -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0); break; @@ -7405,7 +7990,7 @@ ExecuteExtendedBinaryMathOp( case TCL_NUMBER_LONG: zero = (*(const long *)ptr1 > 0L); break; -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0); break; @@ -7426,7 +8011,7 @@ ExecuteExtendedBinaryMathOp( } shift = (int)(*(const long *)ptr2); -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG /* * Handle shifts within the native wide range. */ @@ -7609,7 +8194,7 @@ ExecuteExtendedBinaryMathOp( BIG_RESULT(&bigResult); } -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) { TclGetWideIntFromObj(NULL, valuePtr, &w1); TclGetWideIntFromObj(NULL, value2Ptr, &w2); @@ -7687,7 +8272,7 @@ ExecuteExtendedBinaryMathOp( negativeExponent = (l2 < 0); oddExponent = (int) (l2 & 1); break; -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: w2 = *((const Tcl_WideInt *)ptr2); negativeExponent = (w2 < 0); @@ -7879,7 +8464,7 @@ ExecuteExtendedBinaryMathOp( #if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG) if (type1 == TCL_NUMBER_LONG) { w1 = l1; -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG } else if (type1 == TCL_NUMBER_WIDE) { w1 = *((const Tcl_WideInt *) ptr1); #endif @@ -8082,7 +8667,7 @@ ExecuteExtendedBinaryMathOp( switch (opcode) { case INST_ADD: wResult = w1 + w2; -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) #endif { @@ -8098,7 +8683,7 @@ ExecuteExtendedBinaryMathOp( case INST_SUB: wResult = w1 - w2; -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) #endif { @@ -8224,7 +8809,7 @@ ExecuteExtendedUnaryMathOp( switch (opcode) { case INST_BITNOT: -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG if (type == TCL_NUMBER_WIDE) { w = *((const Tcl_WideInt *) ptr); WIDE_RESULT(~w); @@ -8246,7 +8831,7 @@ ExecuteExtendedUnaryMathOp( } TclBNInitBignumFromLong(&big, *(const long *) ptr); break; -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: w = *((const Tcl_WideInt *) ptr); if (w != LLONG_MIN) { @@ -8298,7 +8883,7 @@ TclCompareTwoNumbers( mp_int big1, big2; double d1, d2, tmp; long l1, l2; -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG Tcl_WideInt w1, w2; #endif @@ -8313,7 +8898,7 @@ TclCompareTwoNumbers( l2 = *((const long *)ptr2); longCompare: return (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ); -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: w2 = *((const Tcl_WideInt *)ptr2); w1 = (Tcl_WideInt)l1; @@ -8365,7 +8950,7 @@ TclCompareTwoNumbers( return compare; } -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: w1 = *((const Tcl_WideInt *)ptr1); switch (type2) { @@ -8426,7 +9011,7 @@ TclCompareTwoNumbers( } l1 = (long) d1; goto longCompare; -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: w2 = *((const Tcl_WideInt *)ptr2); d2 = (double) w2; @@ -8470,7 +9055,7 @@ TclCompareTwoNumbers( case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); switch (type2) { -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG case TCL_NUMBER_WIDE: #endif case TCL_NUMBER_LONG: @@ -8603,11 +9188,10 @@ ValidatePcAndStackTop( int stackTop, /* Current stack top. Must be between * stackLowerBound and stackUpperBound * (inclusive). */ - int stackLowerBound, /* Smallest legal value for stackTop. */ int checkStack) /* 0 if the stack depth check should be * skipped. */ { - int stackUpperBound = stackLowerBound + codePtr->maxStackDepth; + int stackUpperBound = codePtr->maxStackDepth; /* Greatest legal value for stackTop. */ unsigned relativePc = (unsigned) (pc - codePtr->codeStart); unsigned long codeStart = (unsigned long) codePtr->codeStart; @@ -8625,13 +9209,13 @@ ValidatePcAndStackTop( (unsigned) opCode, relativePc); Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode"); } - if (checkStack && - ((stackTop < stackLowerBound) || (stackTop > stackUpperBound))) { + if (checkStack && + ((stackTop < 0) || (stackTop > stackUpperBound))) { int numChars; - const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL); + const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL); - fprintf(stderr, "\nBad stack top %d at pc %u in TclNRExecuteByteCode (min %i, max %i)", - stackTop, relativePc, stackLowerBound, stackUpperBound); + fprintf(stderr, "\nBad stack top %d at pc %u in TclNRExecuteByteCode (min 0, max %i)", + stackTop, relativePc, stackUpperBound); if (cmd != NULL) { Tcl_Obj *message; @@ -8712,7 +9296,7 @@ IllegalExprOperandType( /* *---------------------------------------------------------------------- * - * TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSrcInfoForCmd -- + * TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSourceFromFrame -- * * Given a program counter value, finds the closest command in the * bytecode code unit's CmdLocation array and returns information about @@ -8733,16 +9317,26 @@ IllegalExprOperandType( *---------------------------------------------------------------------- */ -const char * -TclGetSrcInfoForCmd( - Interp *iPtr, - int *lenPtr) +Tcl_Obj * +TclGetSourceFromFrame( + CmdFrame *cfPtr, + int objc, + Tcl_Obj *const objv[]) { - CmdFrame *cfPtr = iPtr->cmdFramePtr; - ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr; - - return GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc, - codePtr, lenPtr, NULL); + if (cfPtr == NULL) { + return Tcl_NewListObj(objc, objv); + } + if (cfPtr->cmdObj == NULL) { + if (cfPtr->cmd == NULL) { + ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr; + + cfPtr->cmd = GetSrcInfoForPc((unsigned char *) + cfPtr->data.tebc.pc, codePtr, &cfPtr->len, NULL, NULL); + } + cfPtr->cmdObj = Tcl_NewStringObj(cfPtr->cmd, cfPtr->len); + Tcl_IncrRefCount(cfPtr->cmdObj); + } + return cfPtr->cmdObj; } void @@ -8751,13 +9345,16 @@ TclGetSrcInfoForPc( { ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr; - if (cfPtr->cmd.str.cmd == NULL) { - cfPtr->cmd.str.cmd = GetSrcInfoForPc( + assert(cfPtr->type == TCL_LOCATION_BC); + + if (cfPtr->cmd == NULL) { + + cfPtr->cmd = GetSrcInfoForPc( (unsigned char *) cfPtr->data.tebc.pc, codePtr, - &cfPtr->cmd.str.len, NULL); + &cfPtr->len, NULL, NULL); } - if (cfPtr->cmd.str.cmd != NULL) { + if (cfPtr->cmd != NULL) { /* * We now have the command. We can get the srcOffset back and from * there find the list of word locations for this command. @@ -8774,7 +9371,7 @@ TclGetSrcInfoForPc( return; } - srcOffset = cfPtr->cmd.str.cmd - codePtr->source; + srcOffset = cfPtr->cmd - codePtr->source; eclPtr = Tcl_GetHashValue(hePtr); for (i=0; i < eclPtr->nuloc; i++) { @@ -8814,9 +9411,12 @@ GetSrcInfoForPc( int *lengthPtr, /* If non-NULL, the location where the length * of the command's source should be stored. * If NULL, no length is stored. */ - const unsigned char **pcBeg)/* If non-NULL, the bytecode location + const unsigned char **pcBeg,/* If non-NULL, the bytecode location * where the current instruction starts. * If NULL; no pointer is stored. */ + int *cmdIdxPtr) /* If non-NULL, the location where the index + * of the command containing the pc should + * be stored. */ { register int pcOffset = (pc - codePtr->codeStart); int numCmds = codePtr->numCommands; @@ -8826,6 +9426,7 @@ GetSrcInfoForPc( int bestDist = INT_MAX; /* Distance of pc to best cmd's start pc. */ int bestSrcOffset = -1; /* Initialized to avoid compiler warning. */ int bestSrcLength = -1; /* Initialized to avoid compiler warning. */ + int bestCmdIdx = -1; if ((pcOffset < 0) || (pcOffset >= codePtr->numCodeBytes)) { if (pcBeg != NULL) *pcBeg = NULL; @@ -8893,6 +9494,7 @@ GetSrcInfoForPc( bestDist = dist; bestSrcOffset = srcOffset; bestSrcLength = srcLen; + bestCmdIdx = i; } } } @@ -8922,6 +9524,10 @@ GetSrcInfoForPc( *lengthPtr = bestSrcLength; } + if (cmdIdxPtr != NULL) { + *cmdIdxPtr = bestCmdIdx; + } + return (codePtr->source + bestSrcOffset); } diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index 33c1496..13377d3 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -734,17 +734,14 @@ CopyRenameOneFile( */ errfile = target; - - /* - * We now need to reset the result, because the above call, if it - * failed, may have put an error message in place. (Ideally we - * would prefer not to pass an interpreter in above, but the - * channel IO code used by TclCrossFilesystemCopy currently - * requires one). - */ - - Tcl_ResetResult(interp); } + /* + * We now need to reset the result, because the above call, + * may have left set it. (Ideally we would prefer not to pass + * an interpreter in above, but the channel IO code used by + * TclCrossFilesystemCopy currently requires one) + */ + Tcl_ResetResult(interp); } if ((copyFlag == 0) && (result == TCL_OK)) { if (S_ISDIR(sourceStatBuf.st_mode)) { diff --git a/generic/tclGet.c b/generic/tclGet.c index 4c19b55..97e8c7b 100644 --- a/generic/tclGet.c +++ b/generic/tclGet.c @@ -137,7 +137,7 @@ Tcl_GetBoolean( obj.length = strlen(src); obj.typePtr = NULL; - code = Tcl_ConvertToType(interp, &obj, &tclBooleanType); + code = TclSetBooleanFromAny(interp, &obj); if (obj.refCount > 1) { Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); } diff --git a/generic/tclIO.c b/generic/tclIO.c index 715c1ef..f1d85bf 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -16,6 +16,108 @@ #include <assert.h> /* + * For each channel handler registered in a call to Tcl_CreateChannelHandler, + * there is one record of the following type. All of records for a specific + * channel are chained together in a singly linked list which is stored in + * the channel structure. + */ + +typedef struct ChannelHandler { + Channel *chanPtr; /* The channel structure for this channel. */ + int mask; /* Mask of desired events. */ + Tcl_ChannelProc *proc; /* Procedure to call in the type of + * Tcl_CreateChannelHandler. */ + ClientData clientData; /* Argument to pass to procedure. */ + struct ChannelHandler *nextPtr; + /* Next one in list of registered handlers. */ +} ChannelHandler; + +/* + * This structure keeps track of the current ChannelHandler being invoked in + * the current invocation of ChannelHandlerEventProc. There is a potential + * problem if a ChannelHandler is deleted while it is the current one, since + * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this + * problem, structures of the type below indicate the next handler to be + * processed for any (recursively nested) dispatches in progress. The + * nextHandlerPtr field is updated if the handler being pointed to is deleted. + * The nextPtr field is used to chain together all recursive invocations, so + * that Tcl_DeleteChannelHandler can find all the recursively nested + * invocations of ChannelHandlerEventProc and compare the handler being + * deleted against the NEXT handler to be invoked in that invocation; when it + * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr + * field of the structure to the next handler. + */ + +typedef struct NextChannelHandler { + ChannelHandler *nextHandlerPtr; /* The next handler to be invoked in + * this invocation. */ + struct NextChannelHandler *nestedHandlerPtr; + /* Next nested invocation of + * ChannelHandlerEventProc. */ +} NextChannelHandler; + +/* + * The following structure describes the event that is added to the Tcl + * event queue by the channel handler check procedure. + */ + +typedef struct ChannelHandlerEvent { + Tcl_Event header; /* Standard header for all events. */ + Channel *chanPtr; /* The channel that is ready. */ + int readyMask; /* Events that have occurred. */ +} ChannelHandlerEvent; + +/* + * The following structure is used by Tcl_GetsObj() to encapsulates the + * state for a "gets" operation. + */ + +typedef struct GetsState { + Tcl_Obj *objPtr; /* The object to which UTF-8 characters + * will be appended. */ + char **dstPtr; /* Pointer into objPtr's string rep where + * next character should be stored. */ + Tcl_Encoding encoding; /* The encoding to use to convert raw bytes + * to UTF-8. */ + ChannelBuffer *bufPtr; /* The current buffer of raw bytes being + * emptied. */ + Tcl_EncodingState state; /* The encoding state just before the last + * external to UTF-8 conversion in + * FilterInputBytes(). */ + int rawRead; /* The number of bytes removed from bufPtr + * in the last call to FilterInputBytes(). */ + int bytesWrote; /* The number of bytes of UTF-8 data + * appended to objPtr during the last call to + * FilterInputBytes(). */ + int charsWrote; /* The corresponding number of UTF-8 + * characters appended to objPtr during the + * last call to FilterInputBytes(). */ + int totalChars; /* The total number of UTF-8 characters + * appended to objPtr so far, just before the + * last call to FilterInputBytes(). */ +} GetsState; + +/* + * The following structure encapsulates the state for a background channel + * copy. Note that the data buffer for the copy will be appended to this + * structure. + */ + +typedef struct CopyState { + struct Channel *readPtr; /* Pointer to input channel. */ + struct Channel *writePtr; /* Pointer to output channel. */ + int readFlags; /* Original read channel flags. */ + int writeFlags; /* Original write channel flags. */ + Tcl_WideInt toRead; /* Number of bytes to copy, or -1. */ + Tcl_WideInt total; /* Total bytes transferred (written). */ + Tcl_Interp *interp; /* Interp that started the copy. */ + Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */ + int bufSize; /* Size of appended buffer. */ + char buffer[1]; /* Copy buffer, this must be the last + * field. */ +} CopyState; + +/* * All static variables used in this file are collected into a single instance * of the following structure. For multi-threaded implementations, there is * one instance of this structure for each thread. @@ -44,6 +146,18 @@ typedef struct ThreadSpecificData { static Tcl_ThreadDataKey dataKey; /* + * Structure to record a close callback. One such record exists for + * each close callback registered for a channel. + */ + +typedef struct CloseCallback { + Tcl_CloseProc *proc; /* The procedure to call. */ + ClientData clientData; /* Arbitrary one-word data to pass + * to the callback. */ + struct CloseCallback *nextPtr; /* For chaining close callbacks. */ +} CloseCallback; + +/* * Static functions in this file: */ @@ -221,9 +335,9 @@ static const Tcl_ObjType tclChannelType = { }; #define GET_CHANNELSTATE(objPtr) \ - ((ChannelState *) (objPtr)->internalRep.otherValuePtr) + ((ChannelState *) (objPtr)->internalRep.twoPtrValue.ptr1) #define SET_CHANNELSTATE(objPtr, storePtr) \ - ((objPtr)->internalRep.otherValuePtr = (void *) (storePtr)) + ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (storePtr)) #define GET_CHANNELINTERP(objPtr) \ ((Interp *) (objPtr)->internalRep.twoPtrValue.ptr2) #define SET_CHANNELINTERP(objPtr, storePtr) \ @@ -695,6 +809,8 @@ Tcl_DeleteCloseHandler( if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) { if (cbPrevPtr == NULL) { statePtr->closeCbPtr = cbPtr->nextPtr; + } else { + cbPrevPtr->nextPtr = cbPtr->nextPtr; } ckfree(cbPtr); break; diff --git a/generic/tclIO.h b/generic/tclIO.h index 1e89878..e84f300 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -30,26 +30,6 @@ #endif /* - * The following structure encapsulates the state for a background channel - * copy. Note that the data buffer for the copy will be appended to this - * structure. - */ - -typedef struct CopyState { - struct Channel *readPtr; /* Pointer to input channel. */ - struct Channel *writePtr; /* Pointer to output channel. */ - int readFlags; /* Original read channel flags. */ - int writeFlags; /* Original write channel flags. */ - Tcl_WideInt toRead; /* Number of bytes to copy, or -1. */ - Tcl_WideInt total; /* Total bytes transferred (written). */ - Tcl_Interp *interp; /* Interp that started the copy. */ - Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */ - int bufSize; /* Size of appended buffer. */ - char buffer[1]; /* Copy buffer, this must be the last - * field. */ -} CopyState; - -/* * struct ChannelBuffer: * * Buffers data being sent to or from a channel. @@ -86,19 +66,6 @@ typedef struct ChannelBuffer { #define CHANNELBUFFER_DEFAULT_SIZE (1024 * 4) /* - * Structure to record a close callback. One such record exists for each close - * callback registered for a channel. - */ - -typedef struct CloseCallback { - Tcl_CloseProc *proc; /* The procedure to call. */ - ClientData clientData; /* Arbitrary one-word data to pass to the - * callback. */ - struct CloseCallback *nextPtr; - /* For chaining close callbacks. */ -} CloseCallback; - -/* * The following structure describes the information saved from a call to * "fileevent". This is used later when the event being waited for to invoke * the saved script in the interpreter designed in this record. @@ -195,7 +162,8 @@ typedef struct ChannelState { * value is the POSIX error code. */ int refCount; /* How many interpreters hold references to * this IO channel? */ - CloseCallback *closeCbPtr; /* Callbacks registered to be called when the + struct CloseCallback *closeCbPtr; + /* Callbacks registered to be called when the * channel is closed. */ char *outputStage; /* Temporary staging buffer used when * translating EOL before converting from @@ -217,8 +185,10 @@ typedef struct ChannelState { * handlers ("fileevent") on this channel. */ int bufSize; /* What size buffers to allocate? */ Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */ - CopyState *csPtrR; /* State of background copy for which channel is input, or NULL. */ - CopyState *csPtrW; /* State of background copy for which channel is output, or NULL. */ + struct CopyState *csPtrR; /* State of background copy for which channel + * is input, or NULL. */ + struct CopyState *csPtrW; /* State of background copy for which channel + * is output, or NULL. */ Channel *topChanPtr; /* Refers to topmost channel in a stack. Never * NULL. */ Channel *bottomChanPtr; /* Refers to bottommost channel in a stack. @@ -342,89 +312,6 @@ typedef struct ChannelState { * the channel is allowed. */ /* - * For each channel handler registered in a call to Tcl_CreateChannelHandler, - * there is one record of the following type. All of records for a specific - * channel are chained together in a singly linked list which is stored in the - * channel structure. - */ - -typedef struct ChannelHandler { - Channel *chanPtr; /* The channel structure for this channel. */ - int mask; /* Mask of desired events. */ - Tcl_ChannelProc *proc; /* Procedure to call in the type of - * Tcl_CreateChannelHandler. */ - ClientData clientData; /* Argument to pass to procedure. */ - struct ChannelHandler *nextPtr; - /* Next one in list of registered handlers. */ -} ChannelHandler; - -/* - * This structure keeps track of the current ChannelHandler being invoked in - * the current invocation of ChannelHandlerEventProc. There is a potential - * problem if a ChannelHandler is deleted while it is the current one, since - * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this - * problem, structures of the type below indicate the next handler to be - * processed for any (recursively nested) dispatches in progress. The - * nextHandlerPtr field is updated if the handler being pointed to is deleted. - * The nextPtr field is used to chain together all recursive invocations, so - * that Tcl_DeleteChannelHandler can find all the recursively nested - * invocations of ChannelHandlerEventProc and compare the handler being - * deleted against the NEXT handler to be invoked in that invocation; when it - * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr - * field of the structure to the next handler. - */ - -typedef struct NextChannelHandler { - ChannelHandler *nextHandlerPtr; - /* The next handler to be invoked in this - * invocation. */ - struct NextChannelHandler *nestedHandlerPtr; - /* Next nested invocation of - * ChannelHandlerEventProc. */ -} NextChannelHandler; - -/* - * The following structure describes the event that is added to the Tcl event - * queue by the channel handler check procedure. - */ - -typedef struct ChannelHandlerEvent { - Tcl_Event header; /* Standard header for all events. */ - Channel *chanPtr; /* The channel that is ready. */ - int readyMask; /* Events that have occurred. */ -} ChannelHandlerEvent; - -/* - * The following structure is used by Tcl_GetsObj() to encapsulates the state - * for a "gets" operation. - */ - -typedef struct GetsState { - Tcl_Obj *objPtr; /* The object to which UTF-8 characters will - * be appended. */ - char **dstPtr; /* Pointer into objPtr's string rep where next - * character should be stored. */ - Tcl_Encoding encoding; /* The encoding to use to convert raw bytes to - * UTF-8. */ - ChannelBuffer *bufPtr; /* The current buffer of raw bytes being - * emptied. */ - Tcl_EncodingState state; /* The encoding state just before the last - * external to UTF-8 conversion in - * FilterInputBytes(). */ - int rawRead; /* The number of bytes removed from bufPtr in - * the last call to FilterInputBytes(). */ - int bytesWrote; /* The number of bytes of UTF-8 data appended - * to objPtr during the last call to - * FilterInputBytes(). */ - int charsWrote; /* The corresponding number of UTF-8 - * characters appended to objPtr during the - * last call to FilterInputBytes(). */ - int totalChars; /* The total number of UTF-8 characters - * appended to objPtr so far, just before the - * last call to FilterInputBytes(). */ -} GetsState; - -/* * The length of time to wait between synthetic timer events. Must be zero or * bad things tend to happen. */ diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 005713d..1673bce 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -1952,25 +1952,25 @@ TclInitChanCmd( * function at the moment. */ static const EnsembleImplMap initMap[] = { - {"blocked", Tcl_FblockedObjCmd, NULL, NULL, NULL, 0}, - {"close", Tcl_CloseObjCmd, NULL, NULL, NULL, 0}, - {"copy", Tcl_FcopyObjCmd, NULL, NULL, NULL, 0}, - {"create", TclChanCreateObjCmd, NULL, NULL, NULL, 0}, /* TIP #219 */ - {"eof", Tcl_EofObjCmd, NULL, NULL, NULL, 0}, - {"event", Tcl_FileEventObjCmd, NULL, NULL, NULL, 0}, - {"flush", Tcl_FlushObjCmd, NULL, NULL, NULL, 0}, - {"gets", Tcl_GetsObjCmd, NULL, NULL, NULL, 0}, - {"names", TclChannelNamesCmd, NULL, NULL, NULL, 0}, - {"pending", ChanPendingObjCmd, NULL, NULL, NULL, 0}, /* TIP #287 */ - {"pop", TclChanPopObjCmd, NULL, NULL, NULL, 0}, /* TIP #230 */ - {"postevent", TclChanPostEventObjCmd, NULL, NULL, NULL, 0}, /* TIP #219 */ - {"push", TclChanPushObjCmd, NULL, NULL, NULL, 0}, /* TIP #230 */ - {"puts", Tcl_PutsObjCmd, NULL, NULL, NULL, 0}, - {"read", Tcl_ReadObjCmd, NULL, NULL, NULL, 0}, - {"seek", Tcl_SeekObjCmd, NULL, NULL, NULL, 0}, - {"pipe", ChanPipeObjCmd, NULL, NULL, NULL, 0}, /* TIP #304 */ - {"tell", Tcl_TellObjCmd, NULL, NULL, NULL, 0}, - {"truncate", ChanTruncateObjCmd, NULL, NULL, NULL, 0}, /* TIP #208 */ + {"blocked", Tcl_FblockedObjCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"close", Tcl_CloseObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, + {"copy", Tcl_FcopyObjCmd, NULL, NULL, NULL, 0}, + {"create", TclChanCreateObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, /* TIP #219 */ + {"eof", Tcl_EofObjCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"event", Tcl_FileEventObjCmd, TclCompileBasic2Or3ArgCmd, NULL, NULL, 0}, + {"flush", Tcl_FlushObjCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"gets", Tcl_GetsObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, + {"names", TclChannelNamesCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"pending", ChanPendingObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, /* TIP #287 */ + {"pipe", ChanPipeObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, /* TIP #304 */ + {"pop", TclChanPopObjCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, /* TIP #230 */ + {"postevent", TclChanPostEventObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, /* TIP #219 */ + {"push", TclChanPushObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, /* TIP #230 */ + {"puts", Tcl_PutsObjCmd, NULL, NULL, NULL, 0}, + {"read", Tcl_ReadObjCmd, NULL, NULL, NULL, 0}, + {"seek", Tcl_SeekObjCmd, TclCompileBasic2Or3ArgCmd, NULL, NULL, 0}, + {"tell", Tcl_TellObjCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"truncate", ChanTruncateObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, /* TIP #208 */ {NULL, NULL, NULL, NULL, NULL, 0} }; static const char *const extras[] = { diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c index bfe6a10..825f408 100644 --- a/generic/tclIOGT.c +++ b/generic/tclIOGT.c @@ -661,12 +661,13 @@ TransformInputProc( * had some data before we report that instead of the request to * re-try. */ + int error = Tcl_GetErrno(); - if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) { + if ((error == EAGAIN) && (gotBytes > 0)) { return gotBytes; } - *errorCodePtr = Tcl_GetErrno(); + *errorCodePtr = error; return -1; } else if (read == 0) { /* diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index ab08353..6259216 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -18,9 +18,6 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#if defined(HAVE_SYS_STAT_H) && !defined _WIN32 -# include <sys/stat.h> -#endif #include "tclInt.h" #ifdef __WIN32__ # include "tclWinInt.h" @@ -3228,6 +3225,9 @@ Tcl_LoadFile( */ copyToPtr = TclpTempFileNameForLibrary(interp, pathPtr); + if (copyToPtr == NULL) { + return TCL_ERROR; + } Tcl_IncrRefCount(copyToPtr); copyFsPtr = Tcl_FSGetFileSystemForPath(copyToPtr); diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index cb345e2..ce8b9fb 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -53,7 +53,7 @@ static const Tcl_ObjType indexType = { /* * The definition of the internal representation of the "index" object; The - * internalRep.otherValuePtr field of an object of "index" type will be a + * internalRep.twoPtrValue.ptr1 field of an object of "index" type will be a * pointer to one of these structures. * * Keep this structure declaration in sync with tclTestObj.c @@ -69,12 +69,12 @@ typedef struct { * The following macros greatly simplify moving through a table... */ -#define STRING_AT(table, offset, index) \ - (*((const char *const *)(((char *)(table)) + ((offset) * (index))))) +#define STRING_AT(table, offset) \ + (*((const char *const *)(((char *)(table)) + (offset)))) #define NEXT_ENTRY(table, offset) \ - (&(STRING_AT(table, offset, 1))) + (&(STRING_AT(table, offset))) #define EXPAND_OF(indexRep) \ - STRING_AT((indexRep)->tablePtr, (indexRep)->offset, (indexRep)->index) + STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index) /* *---------------------------------------------------------------------- @@ -101,6 +101,7 @@ typedef struct { *---------------------------------------------------------------------- */ +#undef Tcl_GetIndexFromObj int Tcl_GetIndexFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ @@ -121,7 +122,7 @@ Tcl_GetIndexFromObj( */ if (objPtr->typePtr == &indexType) { - IndexRep *indexRep = objPtr->internalRep.otherValuePtr; + IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1; /* * Here's hoping we don't get hit by unfortunate packing constraints @@ -238,7 +239,7 @@ GetIndexFromObjList( * a proper match, then TCL_ERROR is returned and an error message is * left in interp's result (unless interp is NULL). The msg argument is * used in the error message; for example, if msg has the value "option" - * then the error message will say something flag 'bad option "foo": must + * then the error message will say something like 'bad option "foo": must * be ...' * * Side effects: @@ -270,12 +271,16 @@ Tcl_GetIndexFromObjStruct( Tcl_Obj *resultPtr; IndexRep *indexRep; + /* Protect against invalid values, like -1 or 0. */ + if (offset < (int)sizeof(char *)) { + offset = (int)sizeof(char *); + } /* * See if there is a valid cached result from a previous lookup. */ if (objPtr->typePtr == &indexType) { - indexRep = objPtr->internalRep.otherValuePtr; + indexRep = objPtr->internalRep.twoPtrValue.ptr1; if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) { *indexPtr = indexRep->index; return TCL_OK; @@ -336,11 +341,11 @@ Tcl_GetIndexFromObjStruct( */ if (objPtr->typePtr == &indexType) { - indexRep = objPtr->internalRep.otherValuePtr; + indexRep = objPtr->internalRep.twoPtrValue.ptr1; } else { TclFreeIntRep(objPtr); indexRep = ckalloc(sizeof(IndexRep)); - objPtr->internalRep.otherValuePtr = indexRep; + objPtr->internalRep.twoPtrValue.ptr1 = indexRep; objPtr->typePtr = &indexType; } indexRep->tablePtr = (void *) tablePtr; @@ -443,7 +448,7 @@ static void UpdateStringOfIndex( Tcl_Obj *objPtr) { - IndexRep *indexRep = objPtr->internalRep.otherValuePtr; + IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1; register char *buf; register unsigned len; register const char *indexStr = EXPAND_OF(indexRep); @@ -478,11 +483,11 @@ DupIndex( Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) { - IndexRep *srcIndexRep = srcPtr->internalRep.otherValuePtr; + IndexRep *srcIndexRep = srcPtr->internalRep.twoPtrValue.ptr1; IndexRep *dupIndexRep = ckalloc(sizeof(IndexRep)); memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep)); - dupPtr->internalRep.otherValuePtr = dupIndexRep; + dupPtr->internalRep.twoPtrValue.ptr1 = dupIndexRep; dupPtr->typePtr = &indexType; } @@ -507,7 +512,7 @@ static void FreeIndex( Tcl_Obj *objPtr) { - ckfree(objPtr->internalRep.otherValuePtr); + ckfree(objPtr->internalRep.twoPtrValue.ptr1); objPtr->typePtr = NULL; } @@ -533,9 +538,9 @@ TclInitPrefixCmd( Tcl_Interp *interp) /* Current interpreter. */ { static const EnsembleImplMap prefixImplMap[] = { - {"all", PrefixAllObjCmd, NULL, NULL, NULL, 0}, - {"longest", PrefixLongestObjCmd, NULL, NULL, NULL, 0}, - {"match", PrefixMatchObjCmd, NULL, NULL, NULL, 0}, + {"all", PrefixAllObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, + {"longest", PrefixLongestObjCmd,TclCompileBasic2ArgCmd, NULL, NULL, 0}, + {"match", PrefixMatchObjCmd, TclCompileBasicMin2ArgCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; Tcl_Command prefixCmd; @@ -948,13 +953,13 @@ Tcl_WrongNumArgs( if (origObjv[i]->typePtr == &indexType) { register IndexRep *indexRep = - origObjv[i]->internalRep.otherValuePtr; + origObjv[i]->internalRep.twoPtrValue.ptr1; elementStr = EXPAND_OF(indexRep); elemLen = strlen(elementStr); } else if (origObjv[i]->typePtr == &tclEnsembleCmdType) { register EnsembleCmdRep *ecrPtr = - origObjv[i]->internalRep.otherValuePtr; + origObjv[i]->internalRep.twoPtrValue.ptr1; elementStr = ecrPtr->fullSubcmdName; elemLen = strlen(elementStr); @@ -1003,12 +1008,12 @@ Tcl_WrongNumArgs( */ if (objv[i]->typePtr == &indexType) { - register IndexRep *indexRep = objv[i]->internalRep.otherValuePtr; + register IndexRep *indexRep = objv[i]->internalRep.twoPtrValue.ptr1; Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL); } else if (objv[i]->typePtr == &tclEnsembleCmdType) { register EnsembleCmdRep *ecrPtr = - objv[i]->internalRep.otherValuePtr; + objv[i]->internalRep.twoPtrValue.ptr1; Tcl_AppendStringsToObj(objPtr, ecrPtr->fullSubcmdName, NULL); } else { diff --git a/generic/tclInt.decls b/generic/tclInt.decls index f215d32..9f7b106 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -626,14 +626,14 @@ declare 156 { declare 157 { Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName) } -# REMOVED - use public Tcl_SetStartupScript() -#declare 158 { -# void TclSetStartupScriptFileName(const char *filename) -#} -# REMOVED - use public Tcl_GetStartupScript() -#declare 159 { -# const char *TclGetStartupScriptFileName(void) -#} +# REMOVED (except from stub table) - use public Tcl_SetStartupScript() +declare 158 { + void TclSetStartupScriptFileName(const char *filename) +} +# REMOVED (except from stub table) - use public Tcl_GetStartupScript() +declare 159 { + const char *TclGetStartupScriptFileName(void) +} #declare 160 { # int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators, # Tcl_DString *dirPtr, char *pattern, char *tail, @@ -678,14 +678,14 @@ declare 166 { } # VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above) -# REMOVED - use public Tcl_SetStartupScript() -#declare 167 { -# void TclSetStartupScriptPath(Tcl_Obj *pathPtr) -#} -# REMOVED - use public Tcl_GetStartupScript() -#declare 168 { -# Tcl_Obj *TclGetStartupScriptPath(void) -#} +# REMOVED (except from stub table) - use public Tcl_SetStartupScript() +declare 167 { + void TclSetStartupScriptPath(Tcl_Obj *pathPtr) +} +# REMOVED (except from stub table) - use public Tcl_GetStartupScript() +declare 168 { + Tcl_Obj *TclGetStartupScriptPath(void) +} # variant of Tcl_UtfNCmp that takes n as bytes, not chars declare 169 { int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n) @@ -731,13 +731,13 @@ declare 177 { void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason) } -# TIP 338 made these public - now declared in tcl.h -#declare 178 { -# void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName) -#} -#declare 179 { -# Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr) -#} +# TIP 338 made these public - now declared in tcl.h too +declare 178 { + void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName) +} +declare 179 { + Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr) +} # REMOVED # Allocate lists without copying arrays @@ -941,9 +941,9 @@ declare 235 { # TIP 337 made this one public -#declare 236 { -# void TclBackgroundException(Tcl_Interp *interp, int code) -#} +declare 236 { + void TclBackgroundException(Tcl_Interp *interp, int code) +} # TIP #285: Script cancellation support. declare 237 { @@ -1006,6 +1006,12 @@ declare 249 { declare 250 { void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force) } + +# Allow extensions for optimization +declare 251 { + int TclRegisterLiteral(void *envPtr, + char *bytes, int length, int flags) +} ############################################################################## diff --git a/generic/tclInt.h b/generic/tclInt.h index 4f4268a..f10beae 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -23,7 +23,6 @@ * Some numerics configuration options. */ -#undef NO_WIDE_TYPE #undef ACCEPT_NAN /* @@ -31,8 +30,7 @@ * here, so that system-dependent personalizations for the include files only * have to be made in once place. This results in a few extra includes, but * greater modularity. The order of the three groups of #includes is - * important. For example, stdio.h is needed by tcl.h, and the _ANSI_ARGS_ - * declaration in tcl.h is needed by stdlib.h in some configurations. + * important. For example, stdio.h is needed by tcl.h. */ #include "tclPort.h" @@ -96,14 +94,6 @@ typedef int ptrdiff_t; #endif /* - * When Tcl_WideInt and long are the same type, there's no value in - * having a tclWideIntType separate from the tclIntType. - */ -#ifdef TCL_WIDE_INT_IS_LONG -#define NO_WIDE_TYPE -#endif - -/* * Macros used to cast between pointers and integers (e.g. when storing an int * in ClientData), on 64-bit architectures they avoid gcc warning about "cast * to/from pointer from/to integer of different size". @@ -128,6 +118,10 @@ typedef int ptrdiff_t; # endif #endif +#if defined(_WIN32) && defined(_MSC_VER) +# define vsnprintf _vsnprintf +#endif + /* * The following procedures allow namespaces to be customized to support * special name resolution rules for commands/variables. @@ -396,7 +390,7 @@ struct NamespacePathEntry { /* * The data cached in an ensemble subcommand's Tcl_Obj rep (reference in - * otherValuePtr field). This structure is not shared between Tcl_Objs + * twoPtrValue.ptr1 field). This structure is not shared between Tcl_Objs * referring to the same subcommand, even where one is a duplicate of another. */ @@ -589,30 +583,6 @@ typedef struct ActiveVarTrace { } ActiveVarTrace; /* - * The following structure describes an enumerative search in progress on an - * array variable; this are invoked with options to the "array" command. - */ - -typedef struct ArraySearch { - int id; /* Integer id used to distinguish among - * multiple concurrent searches for the same - * array. */ - struct Var *varPtr; /* Pointer to array variable that's being - * searched. */ - Tcl_HashSearch search; /* Info kept by the hash module about progress - * through the array. */ - Tcl_HashEntry *nextEntry; /* Non-null means this is the next element to - * be enumerated (it's leftover from the - * Tcl_FirstHashEntry call or from an "array - * anymore" command). NULL means must call - * Tcl_NextHashEntry to get value to - * return. */ - struct ArraySearch *nextPtr;/* Next in list of all active searches for - * this variable, or NULL if this is the last - * one. */ -} ArraySearch; - -/* * The structure below defines a variable, which associates a string name with * a Tcl_Obj value. These structures are kept in procedure call frames (for * local variables recognized by the compiler) or in the heap (for global @@ -1154,7 +1124,7 @@ typedef struct CallFrame { * meaning of the value is, which we do not * specify. */ LocalCache *localCachePtr; - struct NRE_callback *tailcallPtr; + Tcl_Obj *tailcallPtr; /* NULL if no tailcall is scheduled */ } CallFrame; @@ -1205,29 +1175,27 @@ typedef struct CmdFrame { * * EXECUTION CONTEXTS and usage of CmdFrame * - * Field TEBC EvalEx EvalObjEx - * ======= ==== ====== ========= - * level yes yes yes - * type BC/PREBC SRC/EVAL EVAL_LIST - * line0 yes yes yes - * framePtr yes yes yes - * ======= ==== ====== ========= + * Field TEBC EvalEx + * ======= ==== ====== + * level yes yes + * type BC/PREBC SRC/EVAL + * line0 yes yes + * framePtr yes yes + * ======= ==== ====== * - * ======= ==== ====== ========= union data - * line1 - yes - - * line3 - yes - - * path - yes - - * ------- ---- ------ --------- - * codePtr yes - - - * pc yes - - - * ======= ==== ====== ========= + * ======= ==== ========= union data + * line1 - yes + * line3 - yes + * path - yes + * ------- ---- ------ + * codePtr yes - + * pc yes - + * ======= ==== ====== * - * ======= ==== ====== ========= | union cmd - * listPtr - - yes | - * ------- ---- ------ --------- | - * cmd yes yes - | - * cmdlen yes yes - | - * ------- ---- ------ --------- | + * ======= ==== ========= union cmd + * str.cmd yes yes + * str.len yes yes + * ------- ---- ------ */ union { @@ -1240,15 +1208,9 @@ typedef struct CmdFrame { const char *pc; /* ... and instruction pointer. */ } tebc; } data; - union { - struct { - const char *cmd; /* The executed command, if possible... */ - int len; /* ... and its length. */ - } str; - Tcl_Obj *listPtr; /* Tcl_EvalObjEx, cmd list. */ - } cmd; - int numLevels; /* Value of interp's numLevels when the frame - * was pushed. */ + Tcl_Obj *cmdObj; + const char *cmd; /* The executed command, if possible... */ + int len; /* ... and its length. */ const struct CFWordBC *litarg; /* Link to set of literal arguments which have * ben pushed on the lineLABCPtr stack by @@ -1312,8 +1274,6 @@ typedef struct ContLineLoc { * location data referenced via the 'baseLocPtr'. * * TCL_LOCATION_EVAL : Frame is for a script evaluated by EvalEx. - * TCL_LOCATION_EVAL_LIST : Frame is for a script evaluated by the list - * optimization path of EvalObjEx. * TCL_LOCATION_BC : Frame is for bytecode. * TCL_LOCATION_PREBC : Frame is for precompiled bytecode. * TCL_LOCATION_SOURCE : Frame is for a script evaluated by EvalEx, from a @@ -1325,8 +1285,6 @@ typedef struct ContLineLoc { */ #define TCL_LOCATION_EVAL (0) /* Location in a dynamic eval script. */ -#define TCL_LOCATION_EVAL_LIST (1) /* Location in a dynamic eval script, - * list-path. */ #define TCL_LOCATION_BC (2) /* Location in byte code. */ #define TCL_LOCATION_PREBC (3) /* Location in precompiled byte code, no * location. */ @@ -1714,6 +1672,9 @@ typedef struct Command { * CMD_HAS_EXEC_TRACES - 1 means that this command has at least one * execution trace (as opposed to simple * delete/rename traces) in its tracePtr list. + * CMD_COMPILES_EXPANDED - 1 means that this command has a compiler that + * can handle expansion (provided it is not the + * first word). * TCL_TRACE_RENAME - A rename trace is in progress. Further * recursive renames will not be traced. * TCL_TRACE_DELETE - A delete trace is in progress. Further @@ -1724,6 +1685,7 @@ typedef struct Command { #define CMD_IS_DELETED 0x1 #define CMD_TRACE_ACTIVE 0x2 #define CMD_HAS_EXEC_TRACES 0x4 +#define CMD_COMPILES_EXPANDED 0x8 /* *---------------------------------------------------------------- @@ -1847,7 +1809,14 @@ typedef struct Interp { ClientData interpInfo; /* Information used by tclInterp.c to keep * track of master/slave interps on a * per-interp basis. */ - Tcl_HashTable unused2; /* No longer used (was mathFuncTable) */ + union { + void (*optimizer)(void *envPtr); + Tcl_HashTable unused2; /* No longer used (was mathFuncTable). The + * unused space in interp was repurposed for + * pluggable bytecode optimizers. The core + * contains one optimizer, which can be + * selectively overriden by extensions. */ + } extra; /* * Information related to procedures and variables. See tclProc.c and @@ -2202,17 +2171,6 @@ typedef struct Interp { (iPtr)->flags &= (~(CANCELED | TCL_CANCEL_UNWIND)) /* - * General list of interpreters. Doubly linked for easier removal of items - * deep in the list. - */ - -typedef struct InterpList { - Interp *interpPtr; - struct InterpList *prevPtr; - struct InterpList *nextPtr; -} InterpList; - -/* * Macros for splicing into and out of doubly linked lists. They assume * existence of struct items 'prevPtr' and 'nextPtr'. * @@ -2247,10 +2205,10 @@ typedef struct InterpList { * other than these should be turned into errors. */ -#define TCL_ALLOW_EXCEPTIONS 4 -#define TCL_EVAL_FILE 2 -#define TCL_EVAL_CTX 8 -#define TCL_EVAL_REDIRECT 16 +#define TCL_ALLOW_EXCEPTIONS 0x04 +#define TCL_EVAL_FILE 0x02 +#define TCL_EVAL_SOURCE_IN_FRAME 0x10 +#define TCL_EVAL_NORESOLVE 0x20 /* * Flag bits for Interp structures: @@ -2318,35 +2276,6 @@ typedef struct InterpList { #define MAX_NESTING_DEPTH 1000 /* - * TIP#143 limit handler internal representation. - */ - -struct LimitHandler { - int flags; /* The state of this particular handler. */ - Tcl_LimitHandlerProc *handlerProc; - /* The handler callback. */ - ClientData clientData; /* Opaque argument to the handler callback. */ - Tcl_LimitHandlerDeleteProc *deleteProc; - /* How to delete the clientData. */ - LimitHandler *prevPtr; /* Previous item in linked list of - * handlers. */ - LimitHandler *nextPtr; /* Next item in linked list of handlers. */ -}; - -/* - * Values for the LimitHandler flags field. - * LIMIT_HANDLER_ACTIVE - Whether the handler is currently being - * processed; handlers are never to be entered reentrantly. - * LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This - * should not normally be observed because when a handler is - * deleted it is also spliced out of the list of handlers, but - * even so we will be careful. - */ - -#define LIMIT_HANDLER_ACTIVE 0x01 -#define LIMIT_HANDLER_DELETED 0x02 - -/* * The macro below is used to modify a "char" value (e.g. by casting it to an * unsigned character) so that it can be used safely with macros such as * isspace. @@ -2736,7 +2665,7 @@ MODULE_SCOPE const Tcl_ObjType tclProcBodyType; MODULE_SCOPE const Tcl_ObjType tclStringType; MODULE_SCOPE const Tcl_ObjType tclArraySearchType; MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType; -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG MODULE_SCOPE const Tcl_ObjType tclWideIntType; #endif MODULE_SCOPE const Tcl_ObjType tclRegexpType; @@ -2804,10 +2733,15 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke; MODULE_SCOPE Tcl_NRPostProc TclOONextRestoreFrame; -MODULE_SCOPE void TclSpliceTailcall(Tcl_Interp *interp, - struct NRE_callback *tailcallPtr); +MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr); +MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp); + +/* These two can be considered for the public api */ +MODULE_SCOPE void TclMarkTailcall(Tcl_Interp *interp); +MODULE_SCOPE void TclSkipTailcall(Tcl_Interp *interp); /* * This structure holds the data for the various iteration callbacks used to @@ -2882,7 +2816,6 @@ MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr, const unsigned char *bytes, int len); MODULE_SCOPE int TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); -MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp); MODULE_SCOPE void TclAdvanceContinuations(int *line, int **next, int loc); MODULE_SCOPE void TclAdvanceLines(int *line, const char *start, @@ -2893,7 +2826,7 @@ MODULE_SCOPE void TclArgumentRelease(Tcl_Interp *interp, Tcl_Obj *objv[], int objc); MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, Tcl_Obj *objv[], int objc, - void *codePtr, CmdFrame *cfPtr, int pc); + void *codePtr, CmdFrame *cfPtr, int cmd, int pc); MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp, CmdFrame *cfPtr); MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj, @@ -2984,7 +2917,8 @@ 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 Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc, + Tcl_Obj *const objv[]); MODULE_SCOPE int TclGlob(Tcl_Interp *interp, char *pattern, Tcl_Obj *unquotedPrefix, int globFlags, Tcl_GlobTypeData *types); @@ -3133,6 +3067,7 @@ MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp, Tcl_Obj *cmdPrefix); MODULE_SCOPE void TclSetBignumIntRep(Tcl_Obj *objPtr, mp_int *bignumValue); +MODULE_SCOPE int TclSetBooleanFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); MODULE_SCOPE void TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Command *cmdPtr); MODULE_SCOPE void TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr); @@ -3161,6 +3096,7 @@ MODULE_SCOPE int TclTrimLeft(const char *bytes, int numBytes, const char *trim, int numTrim); MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes, const char *trim, int numTrim); +MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct); MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData); MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr); MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr, @@ -3507,6 +3443,9 @@ MODULE_SCOPE int TclCompileBreakCmd(Tcl_Interp *interp, MODULE_SCOPE int TclCompileCatchCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileConcatCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileContinueCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); @@ -3606,6 +3545,9 @@ MODULE_SCOPE int TclCompileLassignCmd(Tcl_Interp *interp, MODULE_SCOPE int TclCompileLindexCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileLinsertCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileListCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); @@ -3630,6 +3572,9 @@ MODULE_SCOPE int TclCompileNamespaceCodeCmd(Tcl_Interp *interp, MODULE_SCOPE int TclCompileNamespaceCurrentCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileNamespaceOriginCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileNamespaceQualifiersCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); @@ -3690,6 +3635,27 @@ MODULE_SCOPE int TclCompileStringMatchCmd(Tcl_Interp *interp, MODULE_SCOPE int TclCompileStringRangeCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringReplaceCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringToLowerCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringToTitleCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringToUpperCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringTrimCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringTrimLCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringTrimRCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileSubstCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); @@ -3720,6 +3686,42 @@ MODULE_SCOPE int TclCompileWhileCmd(Tcl_Interp *interp, MODULE_SCOPE int TclCompileYieldCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasic0ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasic1ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasic2ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasic3ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasic0Or1ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasic1Or2ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasic2Or3ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasic0To2ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasic1To3ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasicMin0ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasicMin1ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileBasicMin2ArgCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclInvertOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, @@ -3897,6 +3899,8 @@ MODULE_SCOPE int TclPtrUnsetVar(Tcl_Interp *interp, Var *varPtr, Tcl_Obj *part2Ptr, const int flags, int index); MODULE_SCOPE void TclInvalidateNsPath(Namespace *nsPtr); +MODULE_SCOPE void TclFindArrayPtrElements(Var *arrayPtr, + Tcl_HashTable *tablePtr); /* * The new extended interface to the variable traces. @@ -4018,6 +4022,7 @@ typedef const char *TclDTraceStr; ckfree((char *) (objPtr)) #undef USE_THREAD_ALLOC +#undef USE_TCLALLOC #elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) /* @@ -4053,7 +4058,7 @@ MODULE_SCOPE void TclpFreeAllocCache(void *); (objPtr) = TclThreadAllocObj(); \ } else { \ (objPtr) = cachePtr->firstObjPtr; \ - cachePtr->firstObjPtr = (objPtr)->internalRep.otherValuePtr; \ + cachePtr->firstObjPtr = (objPtr)->internalRep.twoPtrValue.ptr1; \ --cachePtr->numObjects; \ } \ } while (0) @@ -4066,7 +4071,7 @@ MODULE_SCOPE void TclpFreeAllocCache(void *); (cachePtr->numObjects >= ALLOC_NOBJHIGH))) { \ TclThreadFreeObj(objPtr); \ } else { \ - (objPtr)->internalRep.otherValuePtr = cachePtr->firstObjPtr; \ + (objPtr)->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr; \ cachePtr->firstObjPtr = objPtr; \ ++cachePtr->numObjects; \ } \ @@ -4094,14 +4099,14 @@ MODULE_SCOPE Tcl_Mutex tclObjMutex; } \ (objPtr) = tclFreeObjList; \ tclFreeObjList = (Tcl_Obj *) \ - tclFreeObjList->internalRep.otherValuePtr; \ + tclFreeObjList->internalRep.twoPtrValue.ptr1; \ Tcl_MutexUnlock(&tclObjMutex); \ } while (0) # define TclFreeObjStorageEx(interp, objPtr) \ do { \ Tcl_MutexLock(&tclObjMutex); \ - (objPtr)->internalRep.otherValuePtr = (void *) tclFreeObjList; \ + (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) tclFreeObjList; \ tclFreeObjList = (objPtr); \ Tcl_MutexUnlock(&tclObjMutex); \ } while (0) @@ -4436,7 +4441,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; *---------------------------------------------------------------- */ -#define TclSetIntObj(objPtr, i) \ +#define TclSetLongObj(objPtr, i) \ do { \ TclInvalidateStringRep(objPtr); \ TclFreeIntRep(objPtr); \ @@ -4444,8 +4449,8 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; (objPtr)->typePtr = &tclIntType; \ } while (0) -#define TclSetLongObj(objPtr, l) \ - TclSetIntObj((objPtr), (l)) +#define TclSetIntObj(objPtr, l) \ + TclSetLongObj(objPtr, l) /* * NOTE: There is to be no such thing as a "pure" boolean. Boolean values set @@ -4455,9 +4460,9 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; */ #define TclSetBooleanObj(objPtr, b) \ - TclSetIntObj((objPtr), ((b)? 1 : 0)); + TclSetLongObj(objPtr, (b)!=0); -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG #define TclSetWideIntObj(objPtr, w) \ do { \ TclInvalidateStringRep(objPtr); \ @@ -4493,7 +4498,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; */ #ifndef TCL_MEM_DEBUG -#define TclNewIntObj(objPtr, i) \ +#define TclNewLongObj(objPtr, i) \ do { \ TclIncrObjsAllocated(); \ TclAllocObjStorage(objPtr); \ @@ -4504,15 +4509,15 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) -#define TclNewLongObj(objPtr, l) \ - TclNewIntObj((objPtr), (l)) +#define TclNewIntObj(objPtr, l) \ + TclNewLongObj(objPtr, l) /* * NOTE: There is to be no such thing as a "pure" boolean. * See comment above TclSetBooleanObj macro above. */ #define TclNewBooleanObj(objPtr, b) \ - TclNewIntObj((objPtr), ((b)? 1 : 0)) + TclNewLongObj((objPtr), (b)!=0) #define TclNewDoubleObj(objPtr, d) \ do { \ @@ -4775,35 +4780,6 @@ typedef struct NRE_callback { TOP_CB(interp) = callbackPtr; \ } while (0) -#define TclNRDeferCallback(interp,postProcPtr,data0,data1,data2,data3) \ - do { \ - NRE_callback *callbackPtr; \ - TCLNR_ALLOC((interp), (callbackPtr)); \ - callbackPtr->procPtr = (postProcPtr); \ - callbackPtr->data[0] = (ClientData)(data0); \ - callbackPtr->data[1] = (ClientData)(data1); \ - callbackPtr->data[2] = (ClientData)(data2); \ - callbackPtr->data[3] = (ClientData)(data3); \ - callbackPtr->nextPtr = ((Interp *)interp)->deferredCallbacks; \ - ((Interp *)interp)->deferredCallbacks = callbackPtr; \ - } while (0) - -#define TclNRSpliceCallbacks(interp, topPtr) \ - do { \ - NRE_callback *bottomPtr = topPtr; \ - while (bottomPtr->nextPtr) { \ - bottomPtr = bottomPtr->nextPtr; \ - } \ - bottomPtr->nextPtr = TOP_CB(interp); \ - TOP_CB(interp) = topPtr; \ - } while (0) - -#define TclNRSpliceDeferred(interp) \ - if (((Interp *)interp)->deferredCallbacks) { \ - TclNRSpliceCallbacks(interp, ((Interp *)interp)->deferredCallbacks); \ - ((Interp *)interp)->deferredCallbacks = NULL; \ - } - #if NRE_USE_SMALL_ALLOC #define TCLNR_ALLOC(interp, ptr) \ TclSmallAllocEx(interp, sizeof(NRE_callback), (ptr)) diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index df5ac97..f95f999 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -29,19 +29,20 @@ #endif /* [Bug #803489] Tcl_FindNamespace problem in the Stubs table */ -#undef Tcl_AppendExportList #undef Tcl_CreateNamespace #undef Tcl_DeleteNamespace +#undef Tcl_AppendExportList #undef Tcl_Export -#undef Tcl_FindCommand -#undef Tcl_FindNamespace -#undef Tcl_FindNamespaceVar +#undef Tcl_Import #undef Tcl_ForgetImport -#undef Tcl_GetCommandFromObj -#undef Tcl_GetCommandFullName #undef Tcl_GetCurrentNamespace #undef Tcl_GetGlobalNamespace -#undef Tcl_Import +#undef Tcl_FindNamespace +#undef Tcl_FindCommand +#undef Tcl_GetCommandFromObj +#undef Tcl_GetCommandFullName +#undef Tcl_SetStartupScript +#undef Tcl_GetStartupScript /* * WARNING: This file is automatically generated by the tools/genStubs.tcl @@ -51,6 +52,10 @@ /* !BEGIN!: Do not edit below this line. */ +#ifdef __cplusplus +extern "C" { +#endif + /* * Exported function declarations: */ @@ -395,8 +400,10 @@ EXTERN void TclRegError(Tcl_Interp *interp, const char *msg, /* 157 */ EXTERN Var * TclVarTraceExists(Tcl_Interp *interp, const char *varName); -/* Slot 158 is reserved */ -/* Slot 159 is reserved */ +/* 158 */ +EXTERN void TclSetStartupScriptFileName(const char *filename); +/* 159 */ +EXTERN const char * TclGetStartupScriptFileName(void); /* Slot 160 is reserved */ /* 161 */ EXTERN int TclChannelTransform(Tcl_Interp *interp, @@ -414,8 +421,10 @@ EXTERN void TclpSetInitialEncodings(void); EXTERN int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); -/* Slot 167 is reserved */ -/* Slot 168 is reserved */ +/* 167 */ +EXTERN void TclSetStartupScriptPath(Tcl_Obj *pathPtr); +/* 168 */ +EXTERN Tcl_Obj * TclGetStartupScriptPath(void); /* 169 */ EXTERN int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n); @@ -447,8 +456,11 @@ EXTERN void TclCleanupVar(Var *varPtr, Var *arrayPtr); EXTERN void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); -/* Slot 178 is reserved */ -/* Slot 179 is reserved */ +/* 178 */ +EXTERN void Tcl_SetStartupScript(Tcl_Obj *pathPtr, + const char *encodingName); +/* 179 */ +EXTERN Tcl_Obj * Tcl_GetStartupScript(const char **encodingNamePtr); /* Slot 180 is reserved */ /* Slot 181 is reserved */ /* 182 */ @@ -557,7 +569,8 @@ EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr, /* 235 */ EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr); -/* Slot 236 is reserved */ +/* 236 */ +EXTERN void TclBackgroundException(Tcl_Interp *interp, int code); /* 237 */ EXTERN int TclResetCancellation(Tcl_Interp *interp, int force); /* 238 */ @@ -601,6 +614,9 @@ EXTERN char * TclDoubleDigits(double dv, int ndigits, int flags, /* 250 */ EXTERN void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force); +/* 251 */ +EXTERN int TclRegisterLiteral(void *envPtr, char *bytes, + int length, int flags); typedef struct TclIntStubs { int magic; @@ -764,8 +780,8 @@ typedef struct TclIntStubs { void (*reserved155)(void); void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */ Var * (*tclVarTraceExists) (Tcl_Interp *interp, const char *varName); /* 157 */ - void (*reserved158)(void); - void (*reserved159)(void); + void (*tclSetStartupScriptFileName) (const char *filename); /* 158 */ + const char * (*tclGetStartupScriptFileName) (void); /* 159 */ void (*reserved160)(void); int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */ void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */ @@ -773,8 +789,8 @@ typedef struct TclIntStubs { void (*tclExpandCodeArray) (void *envPtr); /* 164 */ void (*tclpSetInitialEncodings) (void); /* 165 */ int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */ - void (*reserved167)(void); - void (*reserved168)(void); + void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */ + Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */ int (*tclpUtfNcmp2) (const char *s1, const char *s2, unsigned long n); /* 169 */ int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */ int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */ @@ -784,8 +800,8 @@ typedef struct TclIntStubs { int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 175 */ void (*tclCleanupVar) (Var *varPtr, Var *arrayPtr); /* 176 */ void (*tclVarErrMsg) (Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 177 */ - void (*reserved178)(void); - void (*reserved179)(void); + void (*tcl_SetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */ + Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingNamePtr); /* 179 */ void (*reserved180)(void); void (*reserved181)(void); struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */ @@ -842,7 +858,7 @@ typedef struct TclIntStubs { void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */ Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */ void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */ - void (*reserved236)(void); + void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */ int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */ int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */ int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */ @@ -857,12 +873,11 @@ typedef struct TclIntStubs { int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */ char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */ void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */ + int (*tclRegisterLiteral) (void *envPtr, char *bytes, int length, int flags); /* 251 */ } TclIntStubs; -#ifdef __cplusplus -extern "C" { -#endif extern const TclIntStubs *tclIntStubsPtr; + #ifdef __cplusplus } #endif @@ -1130,8 +1145,10 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclRegError) /* 156 */ #define TclVarTraceExists \ (tclIntStubsPtr->tclVarTraceExists) /* 157 */ -/* Slot 158 is reserved */ -/* Slot 159 is reserved */ +#define TclSetStartupScriptFileName \ + (tclIntStubsPtr->tclSetStartupScriptFileName) /* 158 */ +#define TclGetStartupScriptFileName \ + (tclIntStubsPtr->tclGetStartupScriptFileName) /* 159 */ /* Slot 160 is reserved */ #define TclChannelTransform \ (tclIntStubsPtr->tclChannelTransform) /* 161 */ @@ -1145,8 +1162,10 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclpSetInitialEncodings) /* 165 */ #define TclListObjSetElement \ (tclIntStubsPtr->tclListObjSetElement) /* 166 */ -/* Slot 167 is reserved */ -/* Slot 168 is reserved */ +#define TclSetStartupScriptPath \ + (tclIntStubsPtr->tclSetStartupScriptPath) /* 167 */ +#define TclGetStartupScriptPath \ + (tclIntStubsPtr->tclGetStartupScriptPath) /* 168 */ #define TclpUtfNcmp2 \ (tclIntStubsPtr->tclpUtfNcmp2) /* 169 */ #define TclCheckInterpTraces \ @@ -1164,8 +1183,10 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclCleanupVar) /* 176 */ #define TclVarErrMsg \ (tclIntStubsPtr->tclVarErrMsg) /* 177 */ -/* Slot 178 is reserved */ -/* Slot 179 is reserved */ +#define Tcl_SetStartupScript \ + (tclIntStubsPtr->tcl_SetStartupScript) /* 178 */ +#define Tcl_GetStartupScript \ + (tclIntStubsPtr->tcl_GetStartupScript) /* 179 */ /* Slot 180 is reserved */ /* Slot 181 is reserved */ #define TclpLocaltime \ @@ -1252,7 +1273,8 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclVarHashCreateVar) /* 234 */ #define TclInitVarHashTable \ (tclIntStubsPtr->tclInitVarHashTable) /* 235 */ -/* Slot 236 is reserved */ +#define TclBackgroundException \ + (tclIntStubsPtr->tclBackgroundException) /* 236 */ #define TclResetCancellation \ (tclIntStubsPtr->tclResetCancellation) /* 237 */ #define TclNRInterpProc \ @@ -1281,6 +1303,8 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclDoubleDigits) /* 249 */ #define TclSetSlaveCancelFlags \ (tclIntStubsPtr->tclSetSlaveCancelFlags) /* 250 */ +#define TclRegisterLiteral \ + (tclIntStubsPtr->tclRegisterLiteral) /* 251 */ #endif /* defined(USE_TCL_STUBS) */ @@ -1289,4 +1313,58 @@ extern const TclIntStubs *tclIntStubsPtr; #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT +#undef TclGetStartupScriptFileName +#undef TclSetStartupScriptFileName +#undef TclGetStartupScriptPath +#undef TclSetStartupScriptPath +#undef TclBackgroundException + +#if defined(USE_TCL_STUBS) && defined(TCL_NO_DEPRECATED) +# undef Tcl_SetStartupScript +# define Tcl_SetStartupScript \ + (tclStubsPtr->tcl_SetStartupScript) /* 622 */ +# undef Tcl_GetStartupScript +# define Tcl_GetStartupScript \ + (tclStubsPtr->tcl_GetStartupScript) /* 623 */ +# undef Tcl_CreateNamespace +# define Tcl_CreateNamespace \ + (tclStubsPtr->tcl_CreateNamespace) /* 506 */ +# undef Tcl_DeleteNamespace +# define Tcl_DeleteNamespace \ + (tclStubsPtr->tcl_DeleteNamespace) /* 507 */ +# undef Tcl_AppendExportList +# define Tcl_AppendExportList \ + (tclStubsPtr->tcl_AppendExportList) /* 508 */ +# undef Tcl_Export +# define Tcl_Export \ + (tclStubsPtr->tcl_Export) /* 509 */ +# undef Tcl_Import +# define Tcl_Import \ + (tclStubsPtr->tcl_Import) /* 510 */ +# undef Tcl_ForgetImport +# define Tcl_ForgetImport \ + (tclStubsPtr->tcl_ForgetImport) /* 511 */ +# undef Tcl_GetCurrentNamespace +# define Tcl_GetCurrentNamespace \ + (tclStubsPtr->tcl_GetCurrentNamespace) /* 512 */ +# undef Tcl_GetGlobalNamespace +# define Tcl_GetGlobalNamespace \ + (tclStubsPtr->tcl_GetGlobalNamespace) /* 513 */ +# undef Tcl_FindNamespace +# define Tcl_FindNamespace \ + (tclStubsPtr->tcl_FindNamespace) /* 514 */ +# undef Tcl_FindCommand +# define Tcl_FindCommand \ + (tclStubsPtr->tcl_FindCommand) /* 515 */ +# undef Tcl_GetCommandFromObj +# define Tcl_GetCommandFromObj \ + (tclStubsPtr->tcl_GetCommandFromObj) /* 516 */ +# undef Tcl_GetCommandFullName +# define Tcl_GetCommandFullName \ + (tclStubsPtr->tcl_GetCommandFullName) /* 517 */ +#endif + +#undef TclCopyChannelOld +#undef TclSockMinimumBuffersOld + #endif /* _TCLINTDECLS */ diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index dcf1753..72719fe 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -37,6 +37,10 @@ /* !BEGIN!: Do not edit below this line. */ +#ifdef __cplusplus +extern "C" { +#endif + /* * Exported function declarations: */ @@ -355,10 +359,8 @@ typedef struct TclIntPlatStubs { #endif /* MACOSX */ } TclIntPlatStubs; -#ifdef __cplusplus -extern "C" { -#endif extern const TclIntPlatStubs *tclIntPlatStubsPtr; + #ifdef __cplusplus } #endif @@ -545,6 +547,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; #undef TclpGmtime_unix #undef TclWinConvertWSAError #define TclWinConvertWSAError TclWinConvertError +#undef TclpInetNtoa +#define TclpInetNtoa inet_ntoa #if defined(__WIN32__) || defined(__CYGWIN__) # undef TclWinNToHS diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 0b0f652..0da5d47 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -179,6 +179,37 @@ typedef struct ScriptLimitCallbackKey { } ScriptLimitCallbackKey; /* + * TIP#143 limit handler internal representation. + */ + +struct LimitHandler { + int flags; /* The state of this particular handler. */ + Tcl_LimitHandlerProc *handlerProc; + /* The handler callback. */ + ClientData clientData; /* Opaque argument to the handler callback. */ + Tcl_LimitHandlerDeleteProc *deleteProc; + /* How to delete the clientData. */ + LimitHandler *prevPtr; /* Previous item in linked list of + * handlers. */ + LimitHandler *nextPtr; /* Next item in linked list of handlers. */ +}; + +/* + * Values for the LimitHandler flags field. + * LIMIT_HANDLER_ACTIVE - Whether the handler is currently being + * processed; handlers are never to be entered reentrantly. + * LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This + * should not normally be observed because when a handler is + * deleted it is also spliced out of the list of handlers, but + * even so we will be careful. + */ + +#define LIMIT_HANDLER_ACTIVE 0x01 +#define LIMIT_HANDLER_DELETED 0x02 + + + +/* * Prototypes for local static functions: */ @@ -248,6 +279,12 @@ static void DeleteScriptLimitCallback(ClientData clientData); static void RunLimitHandlers(LimitHandler *handlerPtr, Tcl_Interp *interp); static void TimeLimitCallback(ClientData clientData); + +/* NRE enabling */ +static Tcl_NRPostProc NRPostInvokeHidden; +static Tcl_ObjCmdProc NRInterpCmd; +static Tcl_ObjCmdProc NRSlaveCmd; + /* *---------------------------------------------------------------------- @@ -450,7 +487,8 @@ TclInterpInit( slavePtr->interpCmd = NULL; Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS); - Tcl_CreateObjCommand(interp, "interp", Tcl_InterpObjCmd, NULL, NULL); + Tcl_NRCreateCommand(interp, "interp", Tcl_InterpObjCmd, NRInterpCmd, + NULL, NULL); Tcl_CallWhenDeleted(interp, InterpInfoDeleteProc, NULL); return TCL_OK; @@ -559,6 +597,16 @@ Tcl_InterpObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { + return Tcl_NRCallObjProc(interp, NRInterpCmd, clientData, objc, objv); +} + +static int +NRInterpCmd( + ClientData clientData, /* Unused. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ Tcl_Interp *slaveInterp; int index; static const char *const options[] = { @@ -1798,9 +1846,9 @@ AliasNRCmd( */ if (isRootEnsemble) { - TclNRDeferCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); + TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); } - iPtr->evalFlags |= TCL_EVAL_REDIRECT; + TclSkipTailcall(interp); return Tcl_NREvalObj(interp, listPtr, flags); } @@ -2341,8 +2389,8 @@ SlaveCreate( slavePtr->masterInterp = masterInterp; slavePtr->slaveEntryPtr = hPtr; slavePtr->slaveInterp = slaveInterp; - slavePtr->interpCmd = Tcl_CreateObjCommand(masterInterp, path, - SlaveObjCmd, slaveInterp, SlaveObjCmdDeleteProc); + slavePtr->interpCmd = Tcl_NRCreateCommand(masterInterp, path, + SlaveObjCmd, NRSlaveCmd, slaveInterp, SlaveObjCmdDeleteProc); Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS); Tcl_SetHashValue(hPtr, slavePtr); Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY); @@ -2431,6 +2479,16 @@ SlaveObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { + return Tcl_NRCallObjProc(interp, NRSlaveCmd, clientData, objc, objv); +} + +static int +NRSlaveCmd( + ClientData clientData, /* Slave interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ Tcl_Interp *slaveInterp = clientData; int index; static const char *const options[] = { @@ -3021,7 +3079,11 @@ SlaveInvokeHidden( Tcl_AllowExceptions(slaveInterp); if (namespaceName == NULL) { - result = TclObjInvoke(slaveInterp, objc, objv, TCL_INVOKE_HIDDEN); + NRE_callback *rootPtr = TOP_CB(slaveInterp); + + Tcl_NRAddCallback(interp, NRPostInvokeHidden, slaveInterp, + rootPtr, NULL, NULL); + return TclNRInvoke(NULL, slaveInterp, objc, objv); } else { Namespace *nsPtr, *dummy1, *dummy2; const char *tail; @@ -3040,6 +3102,23 @@ SlaveInvokeHidden( Tcl_Release(slaveInterp); return result; } + +static int +NRPostInvokeHidden( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + Tcl_Interp *slaveInterp = (Tcl_Interp *)data[0]; + NRE_callback *rootPtr = (NRE_callback *)data[1]; + + if (interp != slaveInterp) { + result = TclNRRunCallbacks(slaveInterp, result, rootPtr); + Tcl_TransferResult(slaveInterp, result, interp); + } + Tcl_Release(slaveInterp); + return result; +} /* *---------------------------------------------------------------------- diff --git a/generic/tclLink.c b/generic/tclLink.c index a3b42bd..2735256 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -112,8 +112,8 @@ Tcl_LinkVar( Link *linkPtr; int code; - linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY, - LinkTraceProc, (ClientData) NULL); + linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL, + TCL_GLOBAL_ONLY, LinkTraceProc, (ClientData) NULL); if (linkPtr != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "variable '%s' is already linked", varName)); @@ -138,8 +138,9 @@ Tcl_LinkVar( ckfree(linkPtr); return TCL_ERROR; } - code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS - |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc, linkPtr); + code = Tcl_TraceVar2(interp, varName, NULL, + TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + LinkTraceProc, linkPtr); if (code != TCL_OK) { Tcl_DecrRefCount(linkPtr->varName); ckfree(linkPtr); @@ -170,13 +171,13 @@ Tcl_UnlinkVar( Tcl_Interp *interp, /* Interpreter containing variable to unlink */ const char *varName) /* Global variable in interp to unlink. */ { - Link *linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, + Link *linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL, TCL_GLOBAL_ONLY, LinkTraceProc, NULL); if (linkPtr == NULL) { return; } - Tcl_UntraceVar(interp, varName, + Tcl_UntraceVar2(interp, varName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc, linkPtr); Tcl_DecrRefCount(linkPtr->varName); @@ -207,7 +208,7 @@ Tcl_UpdateLinkedVar( Tcl_Interp *interp, /* Interpreter containing variable. */ const char *varName) /* Name of global variable that is linked. */ { - Link *linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, + Link *linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL, TCL_GLOBAL_ONLY, LinkTraceProc, NULL); int savedFlag; @@ -221,8 +222,8 @@ Tcl_UpdateLinkedVar( /* * Callback may have unlinked the variable. [Bug 1740631] */ - linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY, - LinkTraceProc, NULL); + linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL, + TCL_GLOBAL_ONLY, LinkTraceProc, NULL); if (linkPtr != NULL) { linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag; } @@ -278,7 +279,7 @@ LinkTraceProc( } else if (flags & TCL_TRACE_DESTROYED) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - Tcl_TraceVar(interp, Tcl_GetString(linkPtr->varName), + Tcl_TraceVar2(interp, Tcl_GetString(linkPtr->varName), NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES |TCL_TRACE_UNSETS, LinkTraceProc, linkPtr); } diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 2d1defa..bd2dbc4 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -237,7 +237,7 @@ Tcl_NewListObj( * Now create the object. */ - Tcl_InvalidateStringRep(listPtr); + TclInvalidateStringRep(listPtr); ListSetIntRep(listPtr, listRepPtr); return listPtr; } @@ -302,7 +302,7 @@ Tcl_DbNewListObj( * Now create the object. */ - Tcl_InvalidateStringRep(listPtr); + TclInvalidateStringRep(listPtr); ListSetIntRep(listPtr, listRepPtr); return listPtr; @@ -362,7 +362,7 @@ Tcl_SetListObj( */ TclFreeIntRep(objPtr); - Tcl_InvalidateStringRep(objPtr); + TclInvalidateStringRep(objPtr); /* * Set the object's type to "list" and initialize the internal rep. @@ -697,7 +697,7 @@ Tcl_ListObjAppendElement( * representation has changed. */ - Tcl_InvalidateStringRep(listPtr); + TclInvalidateStringRep(listPtr); return TCL_OK; } @@ -1057,7 +1057,7 @@ Tcl_ListObjReplace( * reflects the list's internal representation. */ - Tcl_InvalidateStringRep(listPtr); + TclInvalidateStringRep(listPtr); return TCL_OK; } @@ -1523,7 +1523,7 @@ TclLsetFlat( * containing lists. */ - Tcl_InvalidateStringRep(objPtr); + TclInvalidateStringRep(objPtr); } /* @@ -1559,7 +1559,7 @@ TclLsetFlat( } else { TclListObjSetElement(NULL, subListPtr, index, valuePtr); } - Tcl_InvalidateStringRep(subListPtr); + TclInvalidateStringRep(subListPtr); Tcl_IncrRefCount(retValuePtr); return retValuePtr; } @@ -1736,8 +1736,6 @@ FreeListInternalRep( ckfree(listRepPtr); } - listPtr->internalRep.twoPtrValue.ptr1 = NULL; - listPtr->internalRep.twoPtrValue.ptr2 = NULL; listPtr->typePtr = NULL; } diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 441ea91..2b0cc7e 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -32,6 +32,10 @@ static int AddLocalLiteralEntry(CompileEnv *envPtr, Tcl_Obj *objPtr, int localHash); static void ExpandLocalLiteralArray(CompileEnv *envPtr); static unsigned HashString(const char *string, int length); +#ifdef TCL_COMPILE_DEBUG +static LiteralEntry * LookupLiteralEntry(Tcl_Interp *interp, + Tcl_Obj *objPtr); +#endif static void RebuildLiteralTable(LiteralTable *tablePtr); /* @@ -239,7 +243,7 @@ TclCreateLiteral( } #ifdef TCL_COMPILE_DEBUG - if (TclLookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) { + if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) { Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be", "TclRegisterLiteral", (length>60? 60 : length), bytes); } @@ -301,6 +305,33 @@ TclCreateLiteral( /* *---------------------------------------------------------------------- * + * TclFetchLiteral -- + * + * Fetch from a CompileEnv the literal value identified by an index + * value, as returned by a prior call to TclRegisterLiteral(). + * + * Results: + * The literal value, or NULL if the index is out of range. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TclFetchLiteral( + CompileEnv *envPtr, /* Points to the CompileEnv from which to + * fetch the registered literal value. */ + unsigned int index) /* Index of the desired literal, as returned + * by prior call to TclRegisterLiteral() */ +{ + if (index >= (unsigned int) envPtr->literalArrayNext) { + return NULL; + } + return envPtr->literalArrayPtr[index].objPtr; +} + +/* + *---------------------------------------------------------------------- + * * TclRegisterLiteral -- * * Find, or if necessary create, an object in a CompileEnv literal array @@ -327,7 +358,7 @@ TclCreateLiteral( int TclRegisterLiteral( - CompileEnv *envPtr, /* Points to the CompileEnv in whose object + void *ePtr, /* 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 @@ -341,6 +372,7 @@ TclRegisterLiteral( * the literal should not be shared accross * namespaces. */ { + CompileEnv *envPtr = ePtr; Interp *iPtr = envPtr->iPtr; LiteralTable *localTablePtr = &envPtr->localLitTable; LiteralEntry *globalPtr, *localPtr; @@ -414,10 +446,11 @@ TclRegisterLiteral( return objIndex; } +#ifdef TCL_COMPILE_DEBUG /* *---------------------------------------------------------------------- * - * TclLookupLiteralEntry -- + * LookupLiteralEntry -- * * Finds the LiteralEntry that corresponds to a literal Tcl object * holding a literal. @@ -431,8 +464,8 @@ TclRegisterLiteral( *---------------------------------------------------------------------- */ -LiteralEntry * -TclLookupLiteralEntry( +static LiteralEntry * +LookupLiteralEntry( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ register Tcl_Obj *objPtr) /* Points to a Tcl object holding a literal @@ -456,6 +489,7 @@ TclLookupLiteralEntry( return NULL; } +#endif /* *---------------------------------------------------------------------- * @@ -750,11 +784,16 @@ TclReleaseLiteral( * TclRegisterLiteral. */ { Interp *iPtr = (Interp *) interp; - LiteralTable *globalTablePtr = &iPtr->literalTable; + LiteralTable *globalTablePtr; register LiteralEntry *entryPtr, *prevPtr; const char *bytes; int length, index; + if (iPtr == NULL) { + goto done; + } + + globalTablePtr = &iPtr->literalTable; bytes = TclGetStringFromObj(objPtr, &length); index = (HashString(bytes, length) & globalTablePtr->mask); @@ -798,6 +837,7 @@ TclReleaseLiteral( * Remove the reference corresponding to the local literal table entry. */ + done: Tcl_DecrRefCount(objPtr); } @@ -971,8 +1011,13 @@ TclInvalidateCmdLiteral( Tcl_Obj *literalObjPtr = TclCreateLiteral(iPtr, (char *) name, strlen(name), -1, NULL, nsPtr, 0, NULL); - if (literalObjPtr != NULL && literalObjPtr->typePtr == &tclCmdNameType) { - TclFreeIntRep(literalObjPtr); + if (literalObjPtr != NULL) { + if (literalObjPtr->typePtr == &tclCmdNameType) { + TclFreeIntRep(literalObjPtr); + } + /* Balance the refcount effects of TclCreateLiteral() above */ + Tcl_IncrRefCount(literalObjPtr); + TclReleaseLiteral(interp, literalObjPtr); } } @@ -1090,7 +1135,7 @@ TclVerifyLocalLiteralTable( "TclVerifyLocalLiteralTable", (length>60? 60 : length), bytes, localPtr->refCount); } - if (TclLookupLiteralEntry((Tcl_Interp *) envPtr->iPtr, + if (LookupLiteralEntry((Tcl_Interp *) envPtr->iPtr, localPtr->objPtr) == NULL) { bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length); Tcl_Panic("%s: local literal \"%.*s\" is not global", diff --git a/generic/tclLoadNone.c b/generic/tclLoadNone.c index f030d89..c22c4c4 100644 --- a/generic/tclLoadNone.c +++ b/generic/tclLoadNone.c @@ -82,6 +82,39 @@ TclGuessPackageName( } /* + * These functions are fallbacks if we somehow determine that the platform can + * do loading from memory but the user wishes to disable it. They just report + * (gracefully) that they fail. + */ + +#ifdef TCL_LOAD_FROM_MEMORY + +MODULE_SCOPE void * +TclpLoadMemoryGetBuffer( + Tcl_Interp *interp, /* Dummy: unused by this implementation */ + int size) /* Dummy: unused by this implementation */ +{ + return NULL; +} + +MODULE_SCOPE int +TclpLoadMemory( + Tcl_Interp *interp, /* Used for error reporting. */ + void *buffer, /* Dummy: unused by this implementation */ + int size, /* Dummy: unused by this implementation */ + int codeSize, /* Dummy: unused by this implementation */ + Tcl_LoadHandle *loadHandle, /* Dummy: unused by this implementation */ + Tcl_FSUnloadFileProc **unloadProcPtr) + /* Dummy: unused by this implementation */ +{ + Tcl_SetObjResult(interp, Tcl_NewStringObj("dynamic loading from memory " + "is not available on this system", -1)); + return TCL_ERROR; +} + +#endif /* TCL_LOAD_FROM_MEMORY */ + +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/generic/tclMain.c b/generic/tclMain.c index f445383..faea75a 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -313,6 +313,9 @@ Tcl_MainEx( Tcl_Channel chan; InteractiveState is; + TclpSetInitialEncodings(); + TclpFindExecutable((const char *)argv[0]); + Tcl_InitMemory(interp); is.interp = interp; @@ -640,7 +643,6 @@ Tcl_Main( * function to call after most initialization * but before starting to execute commands. */ { - Tcl_FindExecutable(argv[0]); Tcl_MainEx(argc, argv, appInitProc, Tcl_CreateInterp()); } #endif /* TCL_MAJOR_VERSION == 8 && !UNICODE */ diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 02d517f..8f2f10e 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -160,23 +160,23 @@ static const Tcl_ObjType nsNameType = { */ static const EnsembleImplMap defaultNamespaceMap[] = { - {"children", NamespaceChildrenCmd, NULL, NULL, NULL, 0}, + {"children", NamespaceChildrenCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 0}, {"code", NamespaceCodeCmd, TclCompileNamespaceCodeCmd, NULL, NULL, 0}, {"current", NamespaceCurrentCmd, TclCompileNamespaceCurrentCmd, NULL, NULL, 0}, - {"delete", NamespaceDeleteCmd, NULL, NULL, NULL, 0}, + {"delete", NamespaceDeleteCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, {"ensemble", TclNamespaceEnsembleCmd, NULL, NULL, NULL, 0}, {"eval", NamespaceEvalCmd, NULL, NRNamespaceEvalCmd, NULL, 0}, - {"exists", NamespaceExistsCmd, NULL, NULL, NULL, 0}, - {"export", NamespaceExportCmd, NULL, NULL, NULL, 0}, - {"forget", NamespaceForgetCmd, NULL, NULL, NULL, 0}, - {"import", NamespaceImportCmd, NULL, NULL, NULL, 0}, + {"exists", NamespaceExistsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"export", NamespaceExportCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, + {"forget", NamespaceForgetCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, + {"import", NamespaceImportCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, {"inscope", NamespaceInscopeCmd, NULL, NRNamespaceInscopeCmd, NULL, 0}, - {"origin", NamespaceOriginCmd, NULL, NULL, NULL, 0}, - {"parent", NamespaceParentCmd, NULL, NULL, NULL, 0}, - {"path", NamespacePathCmd, NULL, NULL, NULL, 0}, + {"origin", NamespaceOriginCmd, TclCompileNamespaceOriginCmd, NULL, NULL, 0}, + {"parent", NamespaceParentCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"path", NamespacePathCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"qualifiers", NamespaceQualifiersCmd, TclCompileNamespaceQualifiersCmd, NULL, NULL, 0}, {"tail", NamespaceTailCmd, TclCompileNamespaceTailCmd, NULL, NULL, 0}, - {"unknown", NamespaceUnknownCmd, NULL, NULL, NULL, 0}, + {"unknown", NamespaceUnknownCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"upvar", NamespaceUpvarCmd, TclCompileNamespaceUpvarCmd, NULL, NULL, 0}, {"which", NamespaceWhichCmd, TclCompileNamespaceWhichCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} @@ -423,7 +423,7 @@ Tcl_PopCallFrame( framePtr->nsPtr = NULL; if (framePtr->tailcallPtr) { - TclSpliceTailcall(interp, framePtr->tailcallPtr); + TclSetTailcall(interp, framePtr->tailcallPtr); } } @@ -505,9 +505,9 @@ EstablishErrorCodeTraces( const char *name2, int flags) { - Tcl_TraceVar(interp, "errorCode", TCL_GLOBAL_ONLY | TCL_TRACE_READS, + Tcl_TraceVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS, ErrorCodeRead, NULL); - Tcl_TraceVar(interp, "errorCode", TCL_GLOBAL_ONLY | TCL_TRACE_UNSETS, + Tcl_TraceVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_UNSETS, EstablishErrorCodeTraces, NULL); return NULL; } @@ -579,9 +579,9 @@ EstablishErrorInfoTraces( const char *name2, int flags) { - Tcl_TraceVar(interp, "errorInfo", TCL_GLOBAL_ONLY | TCL_TRACE_READS, + Tcl_TraceVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS, ErrorInfoRead, NULL); - Tcl_TraceVar(interp, "errorInfo", TCL_GLOBAL_ONLY | TCL_TRACE_UNSETS, + Tcl_TraceVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_UNSETS, EstablishErrorInfoTraces, NULL); return NULL; } @@ -673,6 +673,10 @@ Tcl_CreateNamespace( Tcl_DString *namePtr, *buffPtr; int newEntry, nameLen; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + const char *nameStr; + Tcl_DString tmpBuffer; + + Tcl_DStringInit(&tmpBuffer); /* * If there is no active namespace, the interpreter is being initialized. @@ -686,50 +690,78 @@ Tcl_CreateNamespace( parentPtr = NULL; simpleName = ""; - } else if (*name == '\0') { + goto doCreate; + } + + /* + * Ensure that there are no trailing colons as that causes chaos when a + * deleteProc is specified. [Bug d614d63989] + */ + + if (deleteProc != NULL) { + nameStr = name + strlen(name) - 2; + if (nameStr >= name && nameStr[1] == ':' && nameStr[0] == ':') { + Tcl_DStringAppend(&tmpBuffer, name, -1); + while ((nameLen = Tcl_DStringLength(&tmpBuffer)) > 0 + && Tcl_DStringValue(&tmpBuffer)[nameLen-1] == ':') { + Tcl_DStringSetLength(&tmpBuffer, nameLen-1); + } + name = Tcl_DStringValue(&tmpBuffer); + } + } + + /* + * If we've ended up with an empty string now, we're attempting to create + * the global namespace despite the global namespace existing. That's + * naughty! + */ + + if (*name == '\0') { Tcl_SetObjResult(interp, Tcl_NewStringObj("can't create namespace" " \"\": only global namespace can have empty name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE", "CREATEGLOBAL", NULL); + Tcl_DStringFree(&tmpBuffer); return NULL; - } else { - /* - * Find the parent for the new namespace. - */ + } - TclGetNamespaceForQualName(interp, name, NULL, - /*flags*/ (TCL_CREATE_NS_IF_UNKNOWN | TCL_LEAVE_ERR_MSG), - &parentPtr, &dummy1Ptr, &dummy2Ptr, &simpleName); + /* + * Find the parent for the new namespace. + */ - /* - * If the unqualified name at the end is empty, there were trailing - * "::"s after the namespace's name which we ignore. The new namespace - * was already (recursively) created and is pointed to by parentPtr. - */ + TclGetNamespaceForQualName(interp, name, NULL, TCL_CREATE_NS_IF_UNKNOWN, + &parentPtr, &dummy1Ptr, &dummy2Ptr, &simpleName); - if (*simpleName == '\0') { - return (Tcl_Namespace *) parentPtr; - } + /* + * If the unqualified name at the end is empty, there were trailing "::"s + * after the namespace's name which we ignore. The new namespace was + * already (recursively) created and is pointed to by parentPtr. + */ - /* - * Check for a bad namespace name and make sure that the name does not - * already exist in the parent namespace. - */ + if (*simpleName == '\0') { + Tcl_DStringFree(&tmpBuffer); + return (Tcl_Namespace *) parentPtr; + } - if ( + /* + * Check for a bad namespace name and make sure that the name does not + * already exist in the parent namespace. + */ + + if ( #ifndef BREAK_NAMESPACE_COMPAT - Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL + Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL #else - parentPtr->childTablePtr != NULL && - Tcl_FindHashEntry(parentPtr->childTablePtr, simpleName) != NULL + parentPtr->childTablePtr != NULL && + Tcl_FindHashEntry(parentPtr->childTablePtr, simpleName) != NULL #endif - ) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't create namespace \"%s\": already exists", name)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE", - "CREATEEXISTING", NULL); - return NULL; - } + ) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't create namespace \"%s\": already exists", name)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE", + "CREATEEXISTING", NULL); + Tcl_DStringFree(&tmpBuffer); + return NULL; } /* @@ -737,6 +769,7 @@ Tcl_CreateNamespace( * of namespaces created. */ + doCreate: nsPtr = ckalloc(sizeof(Namespace)); nameLen = strlen(simpleName) + 1; nsPtr->name = ckalloc(nameLen); @@ -832,6 +865,7 @@ Tcl_CreateNamespace( Tcl_DStringFree(&buffer1); Tcl_DStringFree(&buffer2); + Tcl_DStringFree(&tmpBuffer); /* * If compilation of commands originating from the parent NS is @@ -1330,8 +1364,7 @@ Tcl_Export( * Check that the pattern doesn't have namespace qualifiers. */ - TclGetNamespaceForQualName(interp, pattern, nsPtr, - /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY), + TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY, &exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern); if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) { @@ -1545,8 +1578,7 @@ Tcl_Import( Tcl_SetErrorCode(interp, "TCL", "IMPORT", "EMPTY", NULL); return TCL_ERROR; } - TclGetNamespaceForQualName(interp, pattern, nsPtr, - /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY), + TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY, &importNsPtr, &dummyPtr, &dummyPtr, &simplePattern); if (importNsPtr == NULL) { @@ -1791,8 +1823,7 @@ Tcl_ForgetImport( * simple pattern. */ - TclGetNamespaceForQualName(interp, pattern, nsPtr, - /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY), + TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY, &sourceNsPtr, &dummyPtr, &dummyPtr, &simplePattern); if (sourceNsPtr == NULL) { @@ -1945,8 +1976,8 @@ InvokeImportedNRCmd( ImportedCmdData *dataPtr = clientData; Command *realCmdPtr = dataPtr->realCmdPtr; - ((Interp *) interp)->evalFlags |= TCL_EVAL_REDIRECT; - return Tcl_NRCmdSwap(interp, (Tcl_Command) realCmdPtr, objc, objv, 0); + TclSkipTailcall(interp); + return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, realCmdPtr); } static int @@ -3435,10 +3466,7 @@ NamespaceExportCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); - const char *pattern, *string; - int resetListFirst = 0; - int firstArg, patternCt, i, result; + int firstArg, i; if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?-clear? ?pattern pattern...?"); @@ -3446,42 +3474,27 @@ NamespaceExportCmd( } /* - * Process the optional "-clear" argument. + * If no pattern arguments are given, and "-clear" isn't specified, return + * the namespace's current export pattern list. */ - firstArg = 1; - if (firstArg < objc) { - string = TclGetString(objv[firstArg]); - if (strcmp(string, "-clear") == 0) { - resetListFirst = 1; - firstArg++; - } + if (objc == 1) { + Tcl_Obj *listPtr = Tcl_NewObj(); + + (void) Tcl_AppendExportList(interp, NULL, listPtr); + Tcl_SetObjResult(interp, listPtr); + return TCL_OK; } /* - * If no pattern arguments are given, and "-clear" isn't specified, return - * the namespace's current export pattern list. + * Process the optional "-clear" argument. */ - patternCt = objc - firstArg; - if (patternCt == 0) { - if (firstArg > 1) { - return TCL_OK; - } else { - /* - * Create list with export patterns. - */ - - Tcl_Obj *listPtr = Tcl_NewListObj(0, NULL); - - result = Tcl_AppendExportList(interp, (Tcl_Namespace *) currNsPtr, - listPtr); - if (result != TCL_OK) { - return result; - } - Tcl_SetObjResult(interp, listPtr); - return TCL_OK; - } + firstArg = 1; + if (strcmp("-clear", Tcl_GetString(objv[firstArg])) == 0) { + Tcl_Export(interp, NULL, "::", 1); + Tcl_ResetResult(interp); + firstArg++; } /* @@ -3489,9 +3502,7 @@ NamespaceExportCmd( */ for (i = firstArg; i < objc; i++) { - pattern = TclGetString(objv[i]); - result = Tcl_Export(interp, (Tcl_Namespace *) currNsPtr, pattern, - ((i == firstArg)? resetListFirst : 0)); + int result = Tcl_Export(interp, NULL, Tcl_GetString(objv[i]), 0); if (result != TCL_OK) { return result; } diff --git a/generic/tclNotify.c b/generic/tclNotify.c index a6523fc..e76bca8 100644 --- a/generic/tclNotify.c +++ b/generic/tclNotify.c @@ -813,11 +813,7 @@ Tcl_SetMaxBlockTime( */ if (!tsdPtr->inTraversal) { - if (tsdPtr->blockTimeSet) { - Tcl_SetTimer(&tsdPtr->blockTime); - } else { - Tcl_SetTimer(NULL); - } + Tcl_SetTimer(&tsdPtr->blockTime); } } diff --git a/generic/tclOO.c b/generic/tclOO.c index 68ed766..9a0682d 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -271,7 +271,7 @@ TclOOInit( return TCL_ERROR; } - return Tcl_PkgProvideEx(interp, "TclOO", TCLOO_VERSION, + return Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL, (ClientData) &tclOOStubs); } @@ -844,7 +844,7 @@ ObjectRenamedTrace( result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr, 0, NULL); if (result != TCL_OK) { - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, result); } Tcl_RestoreInterpState(interp, state); TclOODeleteContext(contextPtr); diff --git a/generic/tclOO.decls b/generic/tclOO.decls index 31d1113..5d6f2c2 100644 --- a/generic/tclOO.decls +++ b/generic/tclOO.decls @@ -1,12 +1,23 @@ +# tclOO.decls -- +# +# This file contains the declarations for all supported public functions +# that are exported by the TclOO package that is embedded within the Tcl +# library via the stubs table. This file is used to generate the +# tclOODecls.h, tclOOIntDecls.h and tclOOStubInit.c files. +# +# Copyright (c) 2008-2013 by Donal K. Fellows. +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. + library tclOO ###################################################################### -# public API +# Public API, exposed for general users of TclOO. # interface tclOO hooks tclOOInt -scspec TCLOOAPI declare 0 { Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp, @@ -116,7 +127,9 @@ declare 28 { } ###################################################################### -# private API, exposed to support advanced OO systems that plug in on top +# Private API, exposed to support advanced OO systems that plug in on top of +# TclOO; not intended for general use and does not have any commitment to +# long-term support. # interface tclOOInt diff --git a/generic/tclOO.h b/generic/tclOO.h index cf253b1..a6e8a22 100644 --- a/generic/tclOO.h +++ b/generic/tclOO.h @@ -12,21 +12,6 @@ #ifndef TCLOO_H_INCLUDED #define TCLOO_H_INCLUDED -#include "tcl.h" - -#ifndef TCLOOAPI -# if defined(BUILD_tcl) || defined(BUILD_TclOO) -# define TCLOOAPI MODULE_SCOPE -# else -# define TCLOOAPI extern -# undef USE_TCLOO_STUBS -# define USE_TCLOO_STUBS 1 -# endif -#endif - -extern const char *TclOOInitializeStubs( - Tcl_Interp *, const char *version); -#define Tcl_OOInitStubs(interp) TclOOInitializeStubs((interp), TCLOO_VERSION) /* * Be careful when it comes to versioning; need to make sure that the @@ -39,9 +24,27 @@ extern const char *TclOOInitializeStubs( * win/tclooConfig.sh */ -#define TCLOO_VERSION "1.0" +#define TCLOO_VERSION "1.0.1" #define TCLOO_PATCHLEVEL TCLOO_VERSION +#include "tcl.h" + +/* + * For C++ compilers, use extern "C" + */ + +#ifdef __cplusplus +extern "C" { +#endif + +extern const char *TclOOInitializeStubs( + Tcl_Interp *, const char *version); +#define Tcl_OOInitStubs(interp) \ + TclOOInitializeStubs((interp), TCLOO_VERSION) +#ifndef USE_TCL_STUBS +# define TclOOInitializeStubs(interp, version) (TCLOO_PATCHLEVEL) +#endif + /* * These are opaque types. */ @@ -130,6 +133,9 @@ typedef struct { #include "tclOODecls.h" +#ifdef __cplusplus +} +#endif #endif /* diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index cd57063..49c917b 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -4,7 +4,7 @@ * This file contains implementations of the "simple" commands and * methods from the object-system core. * - * Copyright (c) 2005-2012 by Donal K. Fellows + * Copyright (c) 2005-2013 by Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -86,7 +86,7 @@ TclOO_Class_Constructor( Tcl_Obj *const *objv) { Object *oPtr = (Object *) Tcl_ObjectContextObject(context); - Tcl_Obj *invoke[3]; + Tcl_Obj **invoke; if (objc-1 > Tcl_ObjectContextSkippedArgs(context)) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, @@ -100,6 +100,7 @@ TclOO_Class_Constructor( * Delegate to [oo::define] to do the work. */ + invoke = ckalloc(3 * sizeof(Tcl_Obj *)); invoke[0] = oPtr->fPtr->defineName; invoke[1] = TclOOObjectName(interp, oPtr); invoke[2] = objv[objc-1]; @@ -113,7 +114,7 @@ TclOO_Class_Constructor( Tcl_IncrRefCount(invoke[1]); Tcl_IncrRefCount(invoke[2]); TclNRAddCallback(interp, DecrRefsPostClassConstructor, - invoke[0], invoke[1], invoke[2], NULL); + invoke, NULL, NULL, NULL); /* * Tricky point: do not want the extra reported level in the Tcl stack @@ -129,9 +130,12 @@ DecrRefsPostClassConstructor( Tcl_Interp *interp, int result) { - TclDecrRefCount((Tcl_Obj *) data[0]); - TclDecrRefCount((Tcl_Obj *) data[1]); - TclDecrRefCount((Tcl_Obj *) data[2]); + Tcl_Obj **invoke = data[0]; + + TclDecrRefCount(invoke[0]); + TclDecrRefCount(invoke[1]); + TclDecrRefCount(invoke[2]); + ckfree(invoke); return result; } @@ -685,52 +689,51 @@ TclOO_Object_VarName( int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* The actual arguments. */ { - Interp *iPtr = (Interp *) interp; Var *varPtr, *aryVar; - Tcl_Obj *varNamePtr; + Tcl_Obj *varNamePtr, *argPtr; + const char *arg; if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "varName"); return TCL_ERROR; } + argPtr = objv[objc-1]; + arg = Tcl_GetString(argPtr); /* - * Switch to the object's namespace for the duration of this call. Like - * this, the variable is looked up in the namespace of the object, and not - * in the namespace of the caller. Otherwise this would only work if the - * caller was a method of the object itself, which might not be true if - * the method was exported. This is a bit of a hack, but the simplest way - * to do this (pushing a stack frame would be horribly expensive by - * comparison, and is only done when we'd otherwise interfere with the - * global namespace). + * Convert the variable name to fully-qualified form if it wasn't already. + * This has to be done prior to lookup because we can run into problems + * with resolvers otherwise. [Bug 3603695] + * + * We still need to do the lookup; the variable could be linked to another + * variable and we want the target's name. */ - if (iPtr->varFramePtr == NULL) { - Tcl_CallFrame *dummyFrame; - - TclPushStackFrame(interp, &dummyFrame, - Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context)),0); - varPtr = TclObjLookupVar(interp, objv[objc-1], NULL, - TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG, "refer to",1,1,&aryVar); - TclPopStackFrame(interp); + if (arg[0] == ':' && arg[1] == ':') { + varNamePtr = argPtr; } else { - Namespace *savedNsPtr; - - savedNsPtr = iPtr->varFramePtr->nsPtr; - iPtr->varFramePtr->nsPtr = (Namespace *) + Tcl_Namespace *namespacePtr = Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context)); - varPtr = TclObjLookupVar(interp, objv[objc-1], NULL, - TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG, "refer to",1,1,&aryVar); - iPtr->varFramePtr->nsPtr = savedNsPtr; - } + varNamePtr = Tcl_NewStringObj(namespacePtr->fullName, -1); + Tcl_AppendToObj(varNamePtr, "::", 2); + Tcl_AppendObjToObj(varNamePtr, argPtr); + } + Tcl_IncrRefCount(varNamePtr); + varPtr = TclObjLookupVar(interp, varNamePtr, NULL, + TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG, "refer to", 1, 1, &aryVar); + Tcl_DecrRefCount(varNamePtr); if (varPtr == NULL) { - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", - TclGetString(objv[objc-1]), NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", arg, NULL); return TCL_ERROR; } + /* + * Now that we've pinned down what variable we're really talking about + * (including traversing variable links), convert back to a name. + */ + varNamePtr = Tcl_NewObj(); if (aryVar != NULL) { Tcl_HashEntry *hPtr; diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index a79e4fa..26fd09f 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -178,7 +178,7 @@ StashCallChain( callPtr->refCount++; TclFreeIntRep(objPtr); objPtr->typePtr = &methodNameType; - objPtr->internalRep.otherValuePtr = callPtr; + objPtr->internalRep.twoPtrValue.ptr1 = callPtr; } void @@ -205,10 +205,10 @@ DupMethodNameRep( Tcl_Obj *srcPtr, Tcl_Obj *dstPtr) { - register CallChain *callPtr = srcPtr->internalRep.otherValuePtr; + register CallChain *callPtr = srcPtr->internalRep.twoPtrValue.ptr1; dstPtr->typePtr = &methodNameType; - dstPtr->internalRep.otherValuePtr = callPtr; + dstPtr->internalRep.twoPtrValue.ptr1 = callPtr; callPtr->refCount++; } @@ -216,10 +216,9 @@ static void FreeMethodNameRep( Tcl_Obj *objPtr) { - register CallChain *callPtr = objPtr->internalRep.otherValuePtr; + register CallChain *callPtr = objPtr->internalRep.twoPtrValue.ptr1; TclOODeleteChain(callPtr); - objPtr->internalRep.otherValuePtr = NULL; objPtr->typePtr = NULL; } @@ -952,7 +951,7 @@ TclOOGetCallContext( const int reuseMask = ((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD); if (cacheInThisObj->typePtr == &methodNameType) { - callPtr = cacheInThisObj->internalRep.otherValuePtr; + callPtr = cacheInThisObj->internalRep.twoPtrValue.ptr1; if (IsStillValid(callPtr, oPtr, flags, reuseMask)) { callPtr->refCount++; goto returnContext; diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h index 58871c6..d3b9e59 100644 --- a/generic/tclOODecls.h +++ b/generic/tclOODecls.h @@ -5,99 +5,116 @@ #ifndef _TCLOODECLS #define _TCLOODECLS +#undef TCL_STORAGE_CLASS +#ifdef BUILD_tcl +# define TCL_STORAGE_CLASS DLLEXPORT +#else +# ifdef USE_TCL_STUBS +# undef USE_TCLOO_STUBS +# define USE_TCLOO_STUBS +# define TCL_STORAGE_CLASS +# else +# define TCL_STORAGE_CLASS DLLIMPORT +# endif +#endif + /* !BEGIN!: Do not edit below this line. */ +#ifdef __cplusplus +extern "C" { +#endif + /* * Exported function declarations: */ /* 0 */ -TCLOOAPI Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp, +EXTERN Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp, Tcl_Object sourceObject, const char *targetName, const char *targetNamespaceName); /* 1 */ -TCLOOAPI Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz); +EXTERN Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz); /* 2 */ -TCLOOAPI Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object); +EXTERN Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object); /* 3 */ -TCLOOAPI Tcl_Command Tcl_GetObjectCommand(Tcl_Object object); +EXTERN Tcl_Command Tcl_GetObjectCommand(Tcl_Object object); /* 4 */ -TCLOOAPI Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp, +EXTERN Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 5 */ -TCLOOAPI Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object); +EXTERN Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object); /* 6 */ -TCLOOAPI Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method); +EXTERN Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method); /* 7 */ -TCLOOAPI Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method); +EXTERN Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method); /* 8 */ -TCLOOAPI int Tcl_MethodIsPublic(Tcl_Method method); +EXTERN int Tcl_MethodIsPublic(Tcl_Method method); /* 9 */ -TCLOOAPI int Tcl_MethodIsType(Tcl_Method method, +EXTERN int Tcl_MethodIsType(Tcl_Method method, const Tcl_MethodType *typePtr, ClientData *clientDataPtr); /* 10 */ -TCLOOAPI Tcl_Obj * Tcl_MethodName(Tcl_Method method); +EXTERN Tcl_Obj * Tcl_MethodName(Tcl_Method method); /* 11 */ -TCLOOAPI Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, +EXTERN Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 12 */ -TCLOOAPI Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, +EXTERN Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 13 */ -TCLOOAPI Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, +EXTERN Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip); /* 14 */ -TCLOOAPI int Tcl_ObjectDeleted(Tcl_Object object); +EXTERN int Tcl_ObjectDeleted(Tcl_Object object); /* 15 */ -TCLOOAPI int Tcl_ObjectContextIsFiltering( +EXTERN int Tcl_ObjectContextIsFiltering( Tcl_ObjectContext context); /* 16 */ -TCLOOAPI Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context); +EXTERN Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context); /* 17 */ -TCLOOAPI Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context); +EXTERN Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context); /* 18 */ -TCLOOAPI int Tcl_ObjectContextSkippedArgs( +EXTERN int Tcl_ObjectContextSkippedArgs( Tcl_ObjectContext context); /* 19 */ -TCLOOAPI ClientData Tcl_ClassGetMetadata(Tcl_Class clazz, +EXTERN ClientData Tcl_ClassGetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 20 */ -TCLOOAPI void Tcl_ClassSetMetadata(Tcl_Class clazz, +EXTERN void Tcl_ClassSetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 21 */ -TCLOOAPI ClientData Tcl_ObjectGetMetadata(Tcl_Object object, +EXTERN ClientData Tcl_ObjectGetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 22 */ -TCLOOAPI void Tcl_ObjectSetMetadata(Tcl_Object object, +EXTERN void Tcl_ObjectSetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 23 */ -TCLOOAPI int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, +EXTERN int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); /* 24 */ -TCLOOAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper( +EXTERN Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper( Tcl_Object object); /* 25 */ -TCLOOAPI void Tcl_ObjectSetMethodNameMapper(Tcl_Object object, +EXTERN void Tcl_ObjectSetMethodNameMapper(Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 26 */ -TCLOOAPI void Tcl_ClassSetConstructor(Tcl_Interp *interp, +EXTERN void Tcl_ClassSetConstructor(Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */ -TCLOOAPI void Tcl_ClassSetDestructor(Tcl_Interp *interp, +EXTERN void Tcl_ClassSetDestructor(Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 28 */ -TCLOOAPI Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp, +EXTERN Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp, Tcl_Object object); typedef struct { @@ -139,10 +156,8 @@ typedef struct TclOOStubs { Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */ } TclOOStubs; -#ifdef __cplusplus -extern "C" { -#endif extern const TclOOStubs *tclOOStubsPtr; + #ifdef __cplusplus } #endif @@ -215,4 +230,7 @@ extern const TclOOStubs *tclOOStubsPtr; #endif /* defined(USE_TCLOO_STUBS) */ /* !END!: Do not edit above this line. */ + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLIMPORT #endif /* _TCLOODECLS */ diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index bacab38..5a6c0ad 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -4,7 +4,7 @@ * This file contains the implementation of the ::oo::define command, * part of the object-system core (NB: not Tcl_Obj, but ::oo). * - * Copyright (c) 2006-2012 by Donal K. Fellows + * Copyright (c) 2006-2013 by Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -2206,29 +2206,42 @@ ClassSuperSet( /* * Parse the arguments to get the class to use as superclasses. + * + * Note that zero classes is special, as it is equivalent to just the + * class of objects. [Bug 9d61624b3d] */ - for (i=0 ; i<superc ; i++) { - superclasses[i] = GetClassInOuterContext(interp, superv[i], - "only a class can be a superclass"); - if (superclasses[i] == NULL) { - goto failedAfterAlloc; + if (superc == 0) { + superclasses = ckrealloc(superclasses, sizeof(Class *)); + superclasses[0] = oPtr->fPtr->objectCls; + superc = 1; + if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) { + superclasses[0] = oPtr->fPtr->classCls; } - for (j=0 ; j<i ; j++) { - if (superclasses[j] == superclasses[i]) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "class should only be a direct superclass once", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS", NULL); + } else { + for (i=0 ; i<superc ; i++) { + superclasses[i] = GetClassInOuterContext(interp, superv[i], + "only a class can be a superclass"); + if (superclasses[i] == NULL) { goto failedAfterAlloc; } - } - if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to form circular dependency graph", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL); - failedAfterAlloc: - ckfree((char *) superclasses); - return TCL_ERROR; + for (j=0 ; j<i ; j++) { + if (superclasses[j] == superclasses[i]) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "class should only be a direct superclass once", + -1)); + Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",NULL); + goto failedAfterAlloc; + } + } + if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "attempt to form circular dependency graph", -1)); + Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL); + failedAfterAlloc: + ckfree((char *) superclasses); + return TCL_ERROR; + } } } diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c index 5be9b01..3217f98 100644 --- a/generic/tclOOInfo.c +++ b/generic/tclOOInfo.c @@ -48,18 +48,18 @@ static Tcl_ObjCmdProc InfoClassVariablesCmd; */ static const EnsembleImplMap infoObjectCmds[] = { - {"call", InfoObjectCallCmd, NULL, NULL, NULL, 0}, + {"call", InfoObjectCallCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"class", InfoObjectClassCmd, TclCompileInfoObjectClassCmd, NULL, NULL, 0}, - {"definition", InfoObjectDefnCmd, NULL, NULL, NULL, 0}, - {"filters", InfoObjectFiltersCmd, NULL, NULL, NULL, 0}, - {"forward", InfoObjectForwardCmd, NULL, NULL, NULL, 0}, + {"definition", InfoObjectDefnCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, + {"filters", InfoObjectFiltersCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"forward", InfoObjectForwardCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"isa", InfoObjectIsACmd, TclCompileInfoObjectIsACmd, NULL, NULL, 0}, - {"methods", InfoObjectMethodsCmd, NULL, NULL, NULL, 0}, - {"methodtype", InfoObjectMethodTypeCmd, NULL, NULL, NULL, 0}, - {"mixins", InfoObjectMixinsCmd, NULL, NULL, NULL, 0}, + {"methods", InfoObjectMethodsCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, + {"methodtype", InfoObjectMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, + {"mixins", InfoObjectMixinsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"namespace", InfoObjectNsCmd, TclCompileInfoObjectNamespaceCmd, NULL, NULL, 0}, - {"variables", InfoObjectVariablesCmd, NULL, NULL, NULL, 0}, - {"vars", InfoObjectVarsCmd, NULL, NULL, NULL, 0}, + {"variables", InfoObjectVariablesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"vars", InfoObjectVarsCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; @@ -68,19 +68,19 @@ static const EnsembleImplMap infoObjectCmds[] = { */ static const EnsembleImplMap infoClassCmds[] = { - {"call", InfoClassCallCmd, NULL, NULL, NULL, 0}, - {"constructor", InfoClassConstrCmd, NULL, NULL, NULL, 0}, - {"definition", InfoClassDefnCmd, NULL, NULL, NULL, 0}, - {"destructor", InfoClassDestrCmd, NULL, NULL, NULL, 0}, - {"filters", InfoClassFiltersCmd, NULL, NULL, NULL, 0}, - {"forward", InfoClassForwardCmd, NULL, NULL, NULL, 0}, - {"instances", InfoClassInstancesCmd, NULL, NULL, NULL, 0}, - {"methods", InfoClassMethodsCmd, NULL, NULL, NULL, 0}, - {"methodtype", InfoClassMethodTypeCmd, NULL, NULL, NULL, 0}, - {"mixins", InfoClassMixinsCmd, NULL, NULL, NULL, 0}, - {"subclasses", InfoClassSubsCmd, NULL, NULL, NULL, 0}, - {"superclasses", InfoClassSupersCmd, NULL, NULL, NULL, 0}, - {"variables", InfoClassVariablesCmd, NULL, NULL, NULL, 0}, + {"call", InfoClassCallCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, + {"constructor", InfoClassConstrCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"definition", InfoClassDefnCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, + {"destructor", InfoClassDestrCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"filters", InfoClassFiltersCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"forward", InfoClassForwardCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, + {"instances", InfoClassInstancesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, + {"methods", InfoClassMethodsCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, + {"methodtype", InfoClassMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, + {"mixins", InfoClassMixinsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"subclasses", InfoClassSubsCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, + {"superclasses", InfoClassSupersCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"variables", InfoClassVariablesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index ab54964..c0e4022 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -122,12 +122,6 @@ typedef struct ForwardMethod { Tcl_Obj *prefixObj; /* The list of values to use to replace the * object and method name with. Will be a * non-empty list. */ - int fullyQualified; /* If 1, the command name is fully qualified - * and we should let the default Tcl mechanism - * handle the command lookup because it is - * more efficient. If 0, we need to do a - * specialized lookup based on the current - * object's namespace. */ } ForwardMethod; /* diff --git a/generic/tclOOIntDecls.h b/generic/tclOOIntDecls.h index acafb18..4f70e5b 100644 --- a/generic/tclOOIntDecls.h +++ b/generic/tclOOIntDecls.h @@ -5,53 +5,68 @@ #ifndef _TCLOOINTDECLS #define _TCLOOINTDECLS +#undef TCL_STORAGE_CLASS +#ifdef BUILD_tcl +# define TCL_STORAGE_CLASS DLLEXPORT +#else +# ifdef USE_TCL_STUBS +# define TCL_STORAGE_CLASS +# else +# define TCL_STORAGE_CLASS DLLIMPORT +# endif +#endif + /* !BEGIN!: Do not edit below this line. */ +#ifdef __cplusplus +extern "C" { +#endif + /* * Exported function declarations: */ /* 0 */ -TCLOOAPI Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp); +EXTERN Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp); /* 1 */ -TCLOOAPI Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, +EXTERN Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 2 */ -TCLOOAPI Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, +EXTERN Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 3 */ -TCLOOAPI Method * TclOONewProcInstanceMethod(Tcl_Interp *interp, +EXTERN Method * TclOONewProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 4 */ -TCLOOAPI Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr, +EXTERN Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 5 */ -TCLOOAPI int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, +EXTERN int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 6 */ -TCLOOAPI int TclOOIsReachable(Class *targetPtr, Class *startPtr); +EXTERN int TclOOIsReachable(Class *targetPtr, Class *startPtr); /* 7 */ -TCLOOAPI Method * TclOONewForwardMethod(Tcl_Interp *interp, +EXTERN Method * TclOONewForwardMethod(Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 8 */ -TCLOOAPI Method * TclOONewForwardInstanceMethod(Tcl_Interp *interp, +EXTERN Method * TclOONewForwardInstanceMethod(Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 9 */ -TCLOOAPI Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, +EXTERN Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, @@ -60,7 +75,7 @@ TCLOOAPI Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */ -TCLOOAPI Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, +EXTERN Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, @@ -69,22 +84,22 @@ TCLOOAPI Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 11 */ -TCLOOAPI int TclOOInvokeObject(Tcl_Interp *interp, +EXTERN int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, int objc, Tcl_Obj *const *objv); /* 12 */ -TCLOOAPI void TclOOObjectSetFilters(Object *oPtr, int numFilters, +EXTERN void TclOOObjectSetFilters(Object *oPtr, int numFilters, Tcl_Obj *const *filters); /* 13 */ -TCLOOAPI void TclOOClassSetFilters(Tcl_Interp *interp, +EXTERN void TclOOClassSetFilters(Tcl_Interp *interp, Class *classPtr, int numFilters, Tcl_Obj *const *filters); /* 14 */ -TCLOOAPI void TclOOObjectSetMixins(Object *oPtr, int numMixins, +EXTERN void TclOOObjectSetMixins(Object *oPtr, int numMixins, Class *const *mixins); /* 15 */ -TCLOOAPI void TclOOClassSetMixins(Tcl_Interp *interp, +EXTERN void TclOOClassSetMixins(Tcl_Interp *interp, Class *classPtr, int numMixins, Class *const *mixins); @@ -110,10 +125,8 @@ typedef struct TclOOIntStubs { void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, int numMixins, Class *const *mixins); /* 15 */ } TclOOIntStubs; -#ifdef __cplusplus -extern "C" { -#endif extern const TclOOIntStubs *tclOOIntStubsPtr; + #ifdef __cplusplus } #endif @@ -160,4 +173,7 @@ extern const TclOOIntStubs *tclOOIntStubsPtr; #endif /* defined(USE_TCLOO_STUBS) */ /* !END!: Do not edit above this line. */ + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLIMPORT #endif /* _TCLOOINTDECLS */ diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 28820e0..61215de 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -513,8 +513,8 @@ TclOOMakeProcInstanceMethod( cfPtr->data.eval.path = context.data.eval.path; Tcl_IncrRefCount(cfPtr->data.eval.path); - cfPtr->cmd.str.cmd = NULL; - cfPtr->cmd.str.len = 0; + cfPtr->cmd = NULL; + cfPtr->len = 0; hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr, (char *) procPtr, &isNew); @@ -626,8 +626,8 @@ TclOOMakeProcMethod( cfPtr->data.eval.path = context.data.eval.path; Tcl_IncrRefCount(cfPtr->data.eval.path); - cfPtr->cmd.str.cmd = NULL; - cfPtr->cmd.str.len = 0; + cfPtr->cmd = NULL; + cfPtr->len = 0; hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr, (char *) procPtr, &isNew); @@ -860,7 +860,7 @@ PushMethodCallFrame( if (pmPtr->procPtr->bodyPtr->typePtr == &tclByteCodeType) { ByteCode *codePtr = - pmPtr->procPtr->bodyPtr->internalRep.otherValuePtr; + pmPtr->procPtr->bodyPtr->internalRep.twoPtrValue.ptr1; codePtr->nsPtr = nsPtr; } @@ -1290,11 +1290,57 @@ CloneProcedureMethod( ClientData *newClientData) { ProcedureMethod *pmPtr = clientData; - ProcedureMethod *pm2Ptr = ckalloc(sizeof(ProcedureMethod)); + ProcedureMethod *pm2Ptr; + Tcl_Obj *bodyObj, *argsObj; + CompiledLocal *localPtr; + /* + * Copy the argument list. + */ + + argsObj = Tcl_NewObj(); + for (localPtr=pmPtr->procPtr->firstLocalPtr; localPtr!=NULL; + localPtr=localPtr->nextPtr) { + if (TclIsVarArgument(localPtr)) { + Tcl_Obj *argObj = Tcl_NewObj(); + + Tcl_ListObjAppendElement(NULL, argObj, + Tcl_NewStringObj(localPtr->name, -1)); + if (localPtr->defValuePtr != NULL) { + Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr); + } + Tcl_ListObjAppendElement(NULL, argsObj, argObj); + } + } + + /* + * Must strip the internal representation in order to ensure that any + * bound references to instance variables are removed. [Bug 3609693] + */ + + bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr); + TclFreeIntRep(bodyObj); + + /* + * Create the actual copy of the method record, manufacturing a new proc + * record. + */ + + pm2Ptr = ckalloc(sizeof(ProcedureMethod)); memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod)); pm2Ptr->refCount = 1; - pm2Ptr->procPtr->refCount++; + Tcl_IncrRefCount(argsObj); + Tcl_IncrRefCount(bodyObj); + if (TclCreateProc(interp, NULL, "", argsObj, bodyObj, + &pm2Ptr->procPtr) != TCL_OK) { + Tcl_DecrRefCount(argsObj); + Tcl_DecrRefCount(bodyObj); + ckfree(pm2Ptr); + return TCL_ERROR; + } + Tcl_DecrRefCount(argsObj); + Tcl_DecrRefCount(bodyObj); + if (pmPtr->cloneClientdataProc) { pm2Ptr->clientData = pmPtr->cloneClientdataProc(pmPtr->clientData); } @@ -1338,7 +1384,6 @@ TclOONewForwardInstanceMethod( fmPtr = ckalloc(sizeof(ForwardMethod)); fmPtr->prefixObj = prefixObj; Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj); - fmPtr->fullyQualified = (strncmp(TclGetString(cmdObj), "::", 2) == 0); Tcl_IncrRefCount(prefixObj); return (Method *) Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags, &fwdMethodType, fmPtr); @@ -1380,7 +1425,6 @@ TclOONewForwardMethod( fmPtr = ckalloc(sizeof(ForwardMethod)); fmPtr->prefixObj = prefixObj; Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj); - fmPtr->fullyQualified = (strncmp(TclGetString(cmdObj), "::", 2) == 0); Tcl_IncrRefCount(prefixObj); return (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, &fwdMethodType, fmPtr); @@ -1409,7 +1453,6 @@ InvokeForwardMethod( ForwardMethod *fmPtr = clientData; Tcl_Obj **argObjs, **prefixObjs; int numPrefixes, len, skip = contextPtr->skip; - Command *cmdPtr; /* * Build the real list of arguments to use. Note that we know that the @@ -1421,15 +1464,10 @@ InvokeForwardMethod( Tcl_ListObjGetElements(NULL, fmPtr->prefixObj, &numPrefixes, &prefixObjs); argObjs = InitEnsembleRewrite(interp, objc, objv, skip, numPrefixes, prefixObjs, &len); - - if (fmPtr->fullyQualified) { - cmdPtr = NULL; - } else { - cmdPtr = (Command *) Tcl_FindCommand(interp, TclGetString(argObjs[0]), - contextPtr->oPtr->namespacePtr, 0 /* normal lookup */); - } Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL); - return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_INVOKE, cmdPtr); + ((Interp *)interp)->lookupNsPtr + = (Namespace *) contextPtr->oPtr->namespacePtr; + return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_NOERR, NULL); } static int @@ -1474,7 +1512,6 @@ CloneForwardMethod( ForwardMethod *fm2Ptr = ckalloc(sizeof(ForwardMethod)); fm2Ptr->prefixObj = fmPtr->prefixObj; - fm2Ptr->fullyQualified = fmPtr->fullyQualified; Tcl_IncrRefCount(fm2Ptr->prefixObj); *newClientData = fm2Ptr; return TCL_OK; diff --git a/generic/tclOOStubLib.c b/generic/tclOOStubLib.c index 55f2378..a9fa212 100644 --- a/generic/tclOOStubLib.c +++ b/generic/tclOOStubLib.c @@ -2,19 +2,6 @@ * ORIGINAL SOURCE: tk/generic/tkStubLib.c, version 1.9 2004/03/17 */ -/* - * We need to ensure that we use the tcl stub macros so that this file - * contains no references to any of the tcl stub functions. - */ - -#undef USE_TCL_STUBS -#define USE_TCL_STUBS - -#ifdef HAVE_CONFIG_H -#include "config.h" -#endif - -#define USE_TCLOO_STUBS 1 #include "tclOOInt.h" MODULE_SCOPE const TclOOStubs *tclOOStubsPtr; @@ -35,51 +22,50 @@ const TclOOIntStubs *tclOOIntStubsPtr = NULL; * to indicate that an error occurred. * * Side effects: - * Sets the stub table pointer. + * Sets the stub table pointers. * *---------------------------------------------------------------------- */ +#undef TclOOInitializeStubs + MODULE_SCOPE const char * TclOOInitializeStubs( - Tcl_Interp *interp, const char *version) + Tcl_Interp *interp, + const char *version) { int exact = 0; const char *packageName = "TclOO"; const char *errMsg = NULL; - ClientData clientData = NULL; - const char *actualVersion = - Tcl_PkgRequireEx(interp, packageName,version, exact, &clientData); + TclOOStubs *stubsPtr = NULL; + const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp, + packageName, version, exact, &stubsPtr); - if (clientData == NULL) { - Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "error loading %s package; package not present or incomplete", - packageName)); + if (actualVersion == NULL) { return NULL; + } + if (stubsPtr == NULL) { + errMsg = "missing stub table pointer"; } else { - const TclOOStubs * const stubsPtr = clientData; - const TclOOIntStubs * const intStubsPtr = stubsPtr->hooks ? - stubsPtr->hooks->tclOOIntStubs : NULL; - - if (!actualVersion) { - return NULL; - } - - if (!stubsPtr || !intStubsPtr) { - errMsg = "missing stub table pointer"; - goto error; - } - tclOOStubsPtr = stubsPtr; - tclOOIntStubsPtr = intStubsPtr; + if (stubsPtr->hooks) { + tclOOIntStubsPtr = stubsPtr->hooks->tclOOIntStubs; + } else { + tclOOIntStubsPtr = NULL; + } return actualVersion; - - error: - Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error loading %s package" - " (requested version '%s', loaded version '%s'): %s", - packageName, version, actualVersion, errMsg)); - return NULL; } + tclStubsPtr->tcl_ResetResult(interp); + tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName, + " (requested version ", version, ", actual version ", + actualVersion, "): ", errMsg, NULL); + return NULL; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tclObj.c b/generic/tclObj.c index 74cb29e..930e1fd 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -97,7 +97,6 @@ typedef struct ThreadSpecificData { static Tcl_ThreadDataKey dataKey; -static void ContLineLocFree(char *clientData); static void TclThreadFinalizeContLines(ClientData clientData); static ThreadSpecificData *TclGetContLineTable(void); @@ -208,12 +207,11 @@ static Tcl_ThreadDataKey pendingObjDataKey; */ static int ParseBoolean(Tcl_Obj *objPtr); -static int SetBooleanFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfDouble(Tcl_Obj *objPtr); static void UpdateStringOfInt(Tcl_Obj *objPtr); -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG static void UpdateStringOfWideInt(Tcl_Obj *objPtr); static int SetWideIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); #endif @@ -250,14 +248,14 @@ static const Tcl_ObjType oldBooleanType = { NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ NULL, /* updateStringProc */ - SetBooleanFromAny /* setFromAnyProc */ + TclSetBooleanFromAny /* setFromAnyProc */ }; const Tcl_ObjType tclBooleanType = { "booleanString", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ NULL, /* updateStringProc */ - SetBooleanFromAny /* setFromAnyProc */ + TclSetBooleanFromAny /* setFromAnyProc */ }; const Tcl_ObjType tclDoubleType = { "double", /* name */ @@ -273,7 +271,7 @@ const Tcl_ObjType tclIntType = { UpdateStringOfInt, /* updateStringProc */ SetIntFromAny /* setFromAnyProc */ }; -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG const Tcl_ObjType tclWideIntType = { "wideInt", /* name */ NULL, /* freeIntRepProc */ @@ -411,7 +409,7 @@ TclInitObjSubsystem(void) /* For backward compatibility only ... */ Tcl_RegisterObjType(&oldBooleanType); -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG Tcl_RegisterObjType(&tclWideIntType); #endif @@ -806,14 +804,7 @@ TclThreadFinalizeContLines( for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { - /* - * We are not using Tcl_EventuallyFree (as in TclFreeObj()) because - * here we can be sure that the compiler will not hold references to - * the data in the hashtable, and using TEF might bork the - * finalization sequence. - */ - - ContLineLocFree(Tcl_GetHashValue(hPtr)); + ckfree(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(tsdPtr->lineCLPtr); @@ -822,30 +813,6 @@ TclThreadFinalizeContLines( } /* - *---------------------------------------------------------------------- - * - * ContLineLocFree -- - * - * The freProc for continuation line location tables. - * - * Results: - * None. - * - * Side effects: - * Releases memory. - * - * TIP #280 - *---------------------------------------------------------------------- - */ - -static void -ContLineLocFree( - char *clientData) -{ - ckfree(clientData); -} - -/* *-------------------------------------------------------------- * * Tcl_RegisterObjType -- @@ -1006,7 +973,12 @@ Tcl_ConvertToType( */ if (typePtr->setFromAnyProc == NULL) { - Tcl_Panic("may not convert object to type %s", typePtr->name); + if (interp) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't convert value to type %s", typePtr->name)); + Tcl_SetErrorCode(interp, "TCL", "API_ABUSE", NULL); + } + return TCL_ERROR; } return typePtr->setFromAnyProc(interp, objPtr); @@ -1255,7 +1227,7 @@ Tcl_DbNewObj( * Side effects: * tclFreeObjList, the head of the list of free Tcl_Objs, is set to the * first of a number of free Tcl_Obj's linked together by their - * internalRep.otherValuePtrs. + * internalRep.twoPtrValue.ptr1's. * *---------------------------------------------------------------------- */ @@ -1284,7 +1256,7 @@ TclAllocateFreeObjects(void) prevPtr = NULL; objPtr = (Tcl_Obj *) basePtr; for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) { - objPtr->internalRep.otherValuePtr = prevPtr; + objPtr->internalRep.twoPtrValue.ptr1 = prevPtr; prevPtr = objPtr; objPtr++; } @@ -1329,9 +1301,21 @@ TclFreeObj( ObjInitDeletionContext(context); + /* + * Check for a double free of the same value. This is slightly tricky + * because it is customary to free a Tcl_Obj when its refcount falls + * either from 1 to 0, or from 0 to -1. Falling from -1 to -2, though, + * and so on, is always a sign of a botch in the caller. + */ if (objPtr->refCount < -1) { Tcl_Panic("Reference count for %p was negative", objPtr); } + /* + * Now, in case we just approved drop from 1 to 0 as acceptable, make + * sure we do not accept a second free when falling from 0 to -1. + * Skip that possibility so any double free will trigger the panic. + */ + objPtr->refCount = -1; /* * Invalidate the string rep first so we can use the bytes value for our @@ -1389,7 +1373,7 @@ TclFreeObj( if (tsdPtr->lineCLPtr) { hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { - Tcl_EventuallyFree(Tcl_GetHashValue(hPtr), ContLineLocFree); + ckfree(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } } @@ -1480,7 +1464,7 @@ TclFreeObj( if (tsdPtr->lineCLPtr) { hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { - Tcl_EventuallyFree(Tcl_GetHashValue(hPtr), ContLineLocFree); + ckfree(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } } @@ -1729,8 +1713,8 @@ Tcl_InvalidateStringRep( *---------------------------------------------------------------------- */ -#ifdef TCL_MEM_DEBUG #undef Tcl_NewBooleanObj +#ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_NewBooleanObj( @@ -1778,6 +1762,7 @@ Tcl_NewBooleanObj( *---------------------------------------------------------------------- */ +#undef Tcl_DbNewBooleanObj #ifdef TCL_MEM_DEBUG Tcl_Obj * @@ -1830,6 +1815,7 @@ Tcl_DbNewBooleanObj( *---------------------------------------------------------------------- */ +#undef Tcl_SetBooleanObj void Tcl_SetBooleanObj( register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ @@ -1897,7 +1883,7 @@ Tcl_GetBooleanFromObj( *boolPtr = 1; return TCL_OK; } -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { *boolPtr = (objPtr->internalRep.wideValue != 0); return TCL_OK; @@ -1911,7 +1897,7 @@ Tcl_GetBooleanFromObj( /* *---------------------------------------------------------------------- * - * SetBooleanFromAny -- + * TclSetBooleanFromAny -- * * Attempt to generate a boolean internal form for the Tcl object * "objPtr". @@ -1928,8 +1914,8 @@ Tcl_GetBooleanFromObj( *---------------------------------------------------------------------- */ -static int -SetBooleanFromAny( +int +TclSetBooleanFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ register Tcl_Obj *objPtr) /* The object to convert. */ { @@ -1952,7 +1938,7 @@ SetBooleanFromAny( goto badBoolean; } -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { goto badBoolean; } @@ -2284,7 +2270,7 @@ Tcl_GetDoubleFromObj( *dblPtr = TclBignumToDouble(&big); return TCL_OK; } -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { *dblPtr = (double) objPtr->internalRep.wideValue; return TCL_OK; @@ -2389,8 +2375,8 @@ UpdateStringOfDouble( *---------------------------------------------------------------------- */ -#ifdef TCL_MEM_DEBUG #undef Tcl_NewIntObj +#ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_NewIntObj( @@ -2430,6 +2416,7 @@ Tcl_NewIntObj( *---------------------------------------------------------------------- */ +#undef Tcl_SetIntObj void Tcl_SetIntObj( register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ @@ -2741,7 +2728,7 @@ Tcl_GetLongFromObj( *longPtr = objPtr->internalRep.longValue; return TCL_OK; } -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { /* * We return any integer in the range -ULONG_MAX to ULONG_MAX @@ -2799,7 +2786,7 @@ Tcl_GetLongFromObj( return TCL_OK; } } -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG tooLarge: #endif if (interp != NULL) { @@ -2815,7 +2802,7 @@ Tcl_GetLongFromObj( TCL_PARSE_INTEGER_ONLY)==TCL_OK); return TCL_ERROR; } -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG /* *---------------------------------------------------------------------- @@ -2857,7 +2844,7 @@ UpdateStringOfWideInt( memcpy(objPtr->bytes, buffer, len + 1); objPtr->length = len; } -#endif /* !NO_WIDE_TYPE */ +#endif /* !TCL_WIDE_INT_IS_LONG */ /* *---------------------------------------------------------------------- @@ -3012,7 +2999,7 @@ Tcl_SetWideIntObj( && (wideValue <= (Tcl_WideInt) LONG_MAX)) { TclSetLongObj(objPtr, (long) wideValue); } else { -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG TclSetWideIntObj(objPtr, wideValue); #else mp_int big; @@ -3052,7 +3039,7 @@ Tcl_GetWideIntFromObj( /* Place to store resulting long. */ { do { -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { *wideIntPtr = objPtr->internalRep.wideValue; return TCL_OK; @@ -3112,7 +3099,7 @@ Tcl_GetWideIntFromObj( TCL_PARSE_INTEGER_ONLY)==TCL_OK); return TCL_ERROR; } -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG /* *---------------------------------------------------------------------- @@ -3138,7 +3125,7 @@ SetWideIntFromAny( Tcl_WideInt w; return Tcl_GetWideIntFromObj(interp, objPtr, &w); } -#endif /* !NO_WIDE_TYPE */ +#endif /* !TCL_WIDE_INT_IS_LONG */ /* *---------------------------------------------------------------------- @@ -3386,7 +3373,7 @@ GetBignumFromObj( TclBNInitBignumFromLong(bignumValue, objPtr->internalRep.longValue); return TCL_OK; } -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { TclBNInitBignumFromWideInt(bignumValue, objPtr->internalRep.wideValue); @@ -3525,7 +3512,7 @@ Tcl_SetBignumObj( return; } tooLargeForLong: -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG if ((size_t) bignumValue->used <= (CHAR_BIT * sizeof(Tcl_WideInt) + DIGIT_BIT - 1) / DIGIT_BIT) { Tcl_WideUInt value = 0; @@ -3637,7 +3624,7 @@ TclGetNumberFromObj( *clientDataPtr = &objPtr->internalRep.longValue; return TCL_OK; } -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { *typePtr = TCL_NUMBER_WIDE; *clientDataPtr = &objPtr->internalRep.wideValue; @@ -4171,7 +4158,7 @@ Tcl_GetCommandFromObj( * had is invalid one way or another. */ - if (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) { + if (SetCmdNameFromAny(interp, objPtr) != TCL_OK) { return NULL; } resPtr = objPtr->internalRep.twoPtrValue.ptr1; @@ -4390,7 +4377,7 @@ SetCmdNameFromAny( if (cmdPtr) { cmdPtr->refCount++; - resPtr = objPtr->internalRep.otherValuePtr; + resPtr = objPtr->internalRep.twoPtrValue.ptr1; if ((objPtr->typePtr == &tclCmdNameType) && resPtr && (resPtr->refCount == 1)) { /* diff --git a/generic/tclOptimize.c b/generic/tclOptimize.c new file mode 100644 index 0000000..827d89d --- /dev/null +++ b/generic/tclOptimize.c @@ -0,0 +1,444 @@ +/* + * tclOptimize.c -- + * + * This file contains the bytecode optimizer. + * + * Copyright (c) 2013 by Donal Fellows. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "tclInt.h" +#include "tclCompile.h" +#include <assert.h> + +/* + * Forward declarations. + */ + +static void AdvanceJumps(CompileEnv *envPtr); +static void ConvertZeroEffectToNOP(CompileEnv *envPtr); +static void LocateTargetAddresses(CompileEnv *envPtr, + Tcl_HashTable *tablePtr); +static void TrimUnreachable(CompileEnv *envPtr); + +/* + * Helper macros. + */ + +#define DefineTargetAddress(tablePtr, address) \ + ((void) Tcl_CreateHashEntry((tablePtr), (void *) (address), &isNew)) +#define IsTargetAddress(tablePtr, address) \ + (Tcl_FindHashEntry((tablePtr), (void *) (address)) != NULL) +#define AddrLength(address) \ + (tclInstructionTable[*(unsigned char *)(address)].numBytes) +#define InstLength(instruction) \ + (tclInstructionTable[(unsigned char)(instruction)].numBytes) + +/* + * ---------------------------------------------------------------------- + * + * LocateTargetAddresses -- + * + * Populate a hash table with places that we need to be careful around + * because they're the targets of various kinds of jumps and other + * non-local behavior. + * + * ---------------------------------------------------------------------- + */ + +static void +LocateTargetAddresses( + CompileEnv *envPtr, + Tcl_HashTable *tablePtr) +{ + unsigned char *currentInstPtr, *targetInstPtr; + int isNew, i; + Tcl_HashEntry *hPtr; + Tcl_HashSearch hSearch; + + Tcl_InitHashTable(tablePtr, TCL_ONE_WORD_KEYS); + + /* + * The starts of commands represent target addresses. + */ + + for (i=0 ; i<envPtr->numCommands ; i++) { + DefineTargetAddress(tablePtr, + envPtr->codeStart + envPtr->cmdMapPtr[i].codeOffset); + } + + /* + * Find places where we should be careful about replacing instructions + * because they are the targets of various types of jumps. + */ + + for (currentInstPtr = envPtr->codeStart ; + currentInstPtr < envPtr->codeNext ; + currentInstPtr += AddrLength(currentInstPtr)) { + switch (*currentInstPtr) { + case INST_JUMP1: + case INST_JUMP_TRUE1: + case INST_JUMP_FALSE1: + targetInstPtr = currentInstPtr+TclGetInt1AtPtr(currentInstPtr+1); + goto storeTarget; + case INST_JUMP4: + case INST_JUMP_TRUE4: + case INST_JUMP_FALSE4: + case INST_START_CMD: + targetInstPtr = currentInstPtr+TclGetInt4AtPtr(currentInstPtr+1); + goto storeTarget; + case INST_BEGIN_CATCH4: + targetInstPtr = envPtr->codeStart + envPtr->exceptArrayPtr[ + TclGetUInt4AtPtr(currentInstPtr+1)].codeOffset; + storeTarget: + DefineTargetAddress(tablePtr, targetInstPtr); + break; + case INST_JUMP_TABLE: + hPtr = Tcl_FirstHashEntry( + &JUMPTABLEINFO(envPtr, currentInstPtr+1)->hashTable, + &hSearch); + for (; hPtr ; hPtr = Tcl_NextHashEntry(&hSearch)) { + targetInstPtr = currentInstPtr + + PTR2INT(Tcl_GetHashValue(hPtr)); + DefineTargetAddress(tablePtr, targetInstPtr); + } + break; + case INST_RETURN_CODE_BRANCH: + for (i=TCL_ERROR ; i<TCL_CONTINUE+1 ; i++) { + DefineTargetAddress(tablePtr, currentInstPtr + 2*i - 1); + } + break; + } + } + + /* + * Add a marker *after* the last bytecode instruction. WARNING: points to + * one past the end! + */ + + DefineTargetAddress(tablePtr, currentInstPtr); + + /* + * Enter in the targets of exception ranges. + */ + + for (i=0 ; i<envPtr->exceptArrayNext ; i++) { + ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[i]; + + if (rangePtr->type == CATCH_EXCEPTION_RANGE) { + targetInstPtr = envPtr->codeStart + rangePtr->catchOffset; + DefineTargetAddress(tablePtr, targetInstPtr); + } else { + targetInstPtr = envPtr->codeStart + rangePtr->breakOffset; + DefineTargetAddress(tablePtr, targetInstPtr); + if (rangePtr->continueOffset >= 0) { + targetInstPtr = envPtr->codeStart + rangePtr->continueOffset; + DefineTargetAddress(tablePtr, targetInstPtr); + } + } + } +} + +/* + * ---------------------------------------------------------------------- + * + * TrimUnreachable -- + * + * Converts code that provably can't be executed into NOPs and reduces + * the overall reported length of the bytecode where that is possible. + * + * ---------------------------------------------------------------------- + */ + +static void +TrimUnreachable( + CompileEnv *envPtr) +{ + unsigned char *currentInstPtr; + Tcl_HashTable targets; + + LocateTargetAddresses(envPtr, &targets); + + for (currentInstPtr = envPtr->codeStart ; + currentInstPtr < envPtr->codeNext-1 ; + currentInstPtr += AddrLength(currentInstPtr)) { + int clear = 0; + + if (*currentInstPtr != INST_DONE) { + continue; + } + + while (!IsTargetAddress(&targets, currentInstPtr + 1 + clear)) { + clear += AddrLength(currentInstPtr + 1 + clear); + } + if (currentInstPtr + 1 + clear == envPtr->codeNext) { + envPtr->codeNext -= clear; + } else { + while (clear --> 0) { + *(currentInstPtr + 1 + clear) = INST_NOP; + } + } + } + + Tcl_DeleteHashTable(&targets); +} + +/* + * ---------------------------------------------------------------------- + * + * ConvertZeroEffectToNOP -- + * + * Replace PUSH/POP sequences (when non-hazardous) with NOPs. Also + * replace PUSH empty/STR_CONCAT and TRY_CVT_NUMERIC (when followed by an + * operation that guarantees the check for arithmeticity) and eliminate + * LNOT when we can invert the following JUMP condition. + * + * ---------------------------------------------------------------------- + */ + +static void +ConvertZeroEffectToNOP( + CompileEnv *envPtr) +{ + unsigned char *currentInstPtr; + int size; + Tcl_HashTable targets; + + LocateTargetAddresses(envPtr, &targets); + for (currentInstPtr = envPtr->codeStart ; + currentInstPtr < envPtr->codeNext ; currentInstPtr += size) { + int blank = 0, i, nextInst; + + size = AddrLength(currentInstPtr); + while ((currentInstPtr + size < envPtr->codeNext) + && *(currentInstPtr+size) == INST_NOP) { + if (IsTargetAddress(&targets, currentInstPtr + size)) { + break; + } + size += InstLength(INST_NOP); + } + if (IsTargetAddress(&targets, currentInstPtr + size)) { + continue; + } + nextInst = *(currentInstPtr + size); + switch (*currentInstPtr) { + case INST_PUSH1: + if (nextInst == INST_POP) { + blank = size + InstLength(nextInst); + } else if (nextInst == INST_STR_CONCAT1 + && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) { + Tcl_Obj *litPtr = TclFetchLiteral(envPtr, + TclGetUInt1AtPtr(currentInstPtr + 1)); + int numBytes; + + (void) Tcl_GetStringFromObj(litPtr, &numBytes); + if (numBytes == 0) { + blank = size + InstLength(nextInst); + } + } + break; + case INST_PUSH4: + if (nextInst == INST_POP) { + blank = size + 1; + } else if (nextInst == INST_STR_CONCAT1 + && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) { + Tcl_Obj *litPtr = TclFetchLiteral(envPtr, + TclGetUInt4AtPtr(currentInstPtr + 1)); + int numBytes; + + (void) Tcl_GetStringFromObj(litPtr, &numBytes); + if (numBytes == 0) { + blank = size + InstLength(nextInst); + } + } + break; + + case INST_LNOT: + switch (nextInst) { + case INST_JUMP_TRUE1: + blank = size; + *(currentInstPtr + size) = INST_JUMP_FALSE1; + break; + case INST_JUMP_FALSE1: + blank = size; + *(currentInstPtr + size) = INST_JUMP_TRUE1; + break; + case INST_JUMP_TRUE4: + blank = size; + *(currentInstPtr + size) = INST_JUMP_FALSE4; + break; + case INST_JUMP_FALSE4: + blank = size; + *(currentInstPtr + size) = INST_JUMP_TRUE4; + break; + } + break; + + case INST_TRY_CVT_TO_NUMERIC: + switch (nextInst) { + case INST_JUMP_TRUE1: + case INST_JUMP_TRUE4: + case INST_JUMP_FALSE1: + case INST_JUMP_FALSE4: + case INST_INCR_SCALAR1: + case INST_INCR_ARRAY1: + case INST_INCR_ARRAY_STK: + case INST_INCR_SCALAR_STK: + case INST_INCR_STK: + case INST_LOR: + case INST_LAND: + case INST_EQ: + case INST_NEQ: + case INST_LT: + case INST_LE: + case INST_GT: + case INST_GE: + case INST_MOD: + case INST_LSHIFT: + case INST_RSHIFT: + case INST_BITOR: + case INST_BITXOR: + case INST_BITAND: + case INST_EXPON: + case INST_ADD: + case INST_SUB: + case INST_DIV: + case INST_MULT: + case INST_LNOT: + case INST_BITNOT: + case INST_UMINUS: + case INST_UPLUS: + case INST_TRY_CVT_TO_NUMERIC: + blank = size; + break; + } + break; + } + + if (blank > 0) { + for (i=0 ; i<blank ; i++) { + *(currentInstPtr + i) = INST_NOP; + } + size = blank; + } + } + Tcl_DeleteHashTable(&targets); +} + +/* + * ---------------------------------------------------------------------- + * + * AdvanceJumps -- + * + * Advance jumps past NOPs and chained JUMPs. After this runs, the only + * JUMPs that jump to a NOP or a JUMP will be length-1 ones that run out + * of room in their opcode to be targeted to where they really belong. + * + * ---------------------------------------------------------------------- + */ + +static void +AdvanceJumps( + CompileEnv *envPtr) +{ + unsigned char *currentInstPtr; + Tcl_HashTable jumps; + + for (currentInstPtr = envPtr->codeStart ; + currentInstPtr < envPtr->codeNext-1 ; + currentInstPtr += AddrLength(currentInstPtr)) { + int offset, delta, isNew; + + switch (*currentInstPtr) { + case INST_JUMP1: + case INST_JUMP_TRUE1: + case INST_JUMP_FALSE1: + offset = TclGetInt1AtPtr(currentInstPtr + 1); + Tcl_InitHashTable(&jumps, TCL_ONE_WORD_KEYS); + for (delta=0 ; offset+delta != 0 ;) { + if (offset + delta < -128 || offset + delta > 127) { + break; + } + Tcl_CreateHashEntry(&jumps, INT2PTR(offset), &isNew); + if (!isNew) { + offset = TclGetInt1AtPtr(currentInstPtr + 1); + break; + } + offset += delta; + switch (*(currentInstPtr + offset)) { + case INST_NOP: + delta = InstLength(INST_NOP); + continue; + case INST_JUMP1: + delta = TclGetInt1AtPtr(currentInstPtr + offset + 1); + continue; + case INST_JUMP4: + delta = TclGetInt4AtPtr(currentInstPtr + offset + 1); + continue; + } + break; + } + Tcl_DeleteHashTable(&jumps); + TclStoreInt1AtPtr(offset, currentInstPtr + 1); + continue; + + case INST_JUMP4: + case INST_JUMP_TRUE4: + case INST_JUMP_FALSE4: + Tcl_InitHashTable(&jumps, TCL_ONE_WORD_KEYS); + Tcl_CreateHashEntry(&jumps, INT2PTR(0), &isNew); + for (offset = TclGetInt4AtPtr(currentInstPtr + 1); offset!=0 ;) { + Tcl_CreateHashEntry(&jumps, INT2PTR(offset), &isNew); + if (!isNew) { + offset = TclGetInt4AtPtr(currentInstPtr + 1); + break; + } + switch (*(currentInstPtr + offset)) { + case INST_NOP: + offset += InstLength(INST_NOP); + continue; + case INST_JUMP1: + offset += TclGetInt1AtPtr(currentInstPtr + offset + 1); + continue; + case INST_JUMP4: + offset += TclGetInt4AtPtr(currentInstPtr + offset + 1); + continue; + } + break; + } + Tcl_DeleteHashTable(&jumps); + TclStoreInt4AtPtr(offset, currentInstPtr + 1); + continue; + } + } +} + +/* + * ---------------------------------------------------------------------- + * + * TclOptimizeBytecode -- + * + * A very simple peephole optimizer for bytecode. + * + * ---------------------------------------------------------------------- + */ + +void +TclOptimizeBytecode( + void *envPtr) +{ + ConvertZeroEffectToNOP(envPtr); + AdvanceJumps(envPtr); + TrimUnreachable(envPtr); +} + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * tab-width: 8 + * End: + */ diff --git a/generic/tclPanic.c b/generic/tclPanic.c index b87a8df..2a453b9 100644 --- a/generic/tclPanic.c +++ b/generic/tclPanic.c @@ -52,6 +52,10 @@ Tcl_SetPanicProc( #if defined(_WIN32) /* tclWinDebugPanic only installs if there is no panicProc yet. */ if ((proc != tclWinDebugPanic) || (panicProc == NULL)) +#elif defined(__CYGWIN__) + if (proc == NULL) + panicProc = tclWinDebugPanic; + else #endif panicProc = proc; } diff --git a/generic/tclParse.c b/generic/tclParse.c index 08615a7..ee0d4c4 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -15,6 +15,7 @@ #include "tclInt.h" #include "tclParse.h" +#include <assert.h> /* * The following table provides parsing information about each possible 8-bit @@ -1567,6 +1568,7 @@ Tcl_ParseVar( code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens, NULL, 1, NULL, NULL); + Tcl_FreeParse(parsePtr); TclStackFree(interp, parsePtr); if (code != TCL_OK) { return NULL; @@ -1577,16 +1579,13 @@ Tcl_ParseVar( * At this point we should have an object containing the value of a * variable. Just return the string from that object. * - * This should have returned the object for the user to manage, but - * instead we have some weak reference to the string value in the object, - * which is why we make sure the object exists after resetting the result. - * This isn't ideal, but it's the best we can do with the current - * documented interface. -- hobbs + * Since TclSubstTokens above returned TCL_OK, we know that objPtr + * is shared. It is in both the interp result and the value of the + * variable. Returning the string relies on that to be true. */ - if (!Tcl_IsShared(objPtr)) { - Tcl_IncrRefCount(objPtr); - } + assert( Tcl_IsShared(objPtr) ); + Tcl_ResetResult(interp); return TclGetString(objPtr); } diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 2b9ff87..b7f3dcf 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -109,9 +109,9 @@ typedef struct FsPath { * fields. */ -#define PATHOBJ(pathPtr) ((FsPath *) (pathPtr)->internalRep.otherValuePtr) +#define PATHOBJ(pathPtr) ((FsPath *) (pathPtr)->internalRep.twoPtrValue.ptr1) #define SETPATHOBJ(pathPtr,fsPathPtr) \ - ((pathPtr)->internalRep.otherValuePtr = (void *) (fsPathPtr)) + ((pathPtr)->internalRep.twoPtrValue.ptr1 = (void *) (fsPathPtr)) #define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags) /* @@ -1156,7 +1156,7 @@ Tcl_FSConvertToPathType( FreeFsPathInternalRep(pathPtr); } - return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); + return SetFsPathFromAny(interp, pathPtr); /* * We used to have more complex code here: @@ -1873,7 +1873,7 @@ Tcl_FSGetNormalizedPath( UpdateStringOfFsPath(pathPtr); } FreeFsPathInternalRep(pathPtr); - if (Tcl_ConvertToType(interp, pathPtr, &tclFsPathType) != TCL_OK) { + if (SetFsPathFromAny(interp, pathPtr) != TCL_OK) { return NULL; } fsPathPtr = PATHOBJ(pathPtr); diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 5b09ddb..df90cea 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -106,6 +106,7 @@ static const char * PkgRequireCore(Tcl_Interp *interp, const char *name, *---------------------------------------------------------------------- */ +#undef Tcl_PkgProvide int Tcl_PkgProvide( Tcl_Interp *interp, /* Interpreter in which package is now @@ -188,6 +189,7 @@ Tcl_PkgProvideEx( *---------------------------------------------------------------------- */ +#undef Tcl_PkgRequire const char * Tcl_PkgRequire( Tcl_Interp *interp, /* Interpreter in which package is now @@ -670,6 +672,7 @@ PkgRequireCore( *---------------------------------------------------------------------- */ +#undef Tcl_PkgPresent const char * Tcl_PkgPresent( Tcl_Interp *interp, /* Interpreter in which package is now @@ -946,7 +949,7 @@ Tcl_PackageObjCmd( version = TclGetString(objv[3]); } } - Tcl_PkgPresent(interp, name, version, exact); + Tcl_PkgPresentEx(interp, name, version, exact, NULL); return TCL_ERROR; break; } @@ -971,7 +974,7 @@ Tcl_PackageObjCmd( if (CheckVersionAndConvert(interp, argv3, NULL, NULL) != TCL_OK) { return TCL_ERROR; } - return Tcl_PkgProvide(interp, argv2, argv3); + return Tcl_PkgProvideEx(interp, argv2, argv3, NULL); case PKG_REQUIRE: require: if (objc < 3) { diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h index e9b92fe..681854d 100644 --- a/generic/tclPlatDecls.h +++ b/generic/tclPlatDecls.h @@ -42,6 +42,10 @@ /* !BEGIN!: Do not edit below this line. */ +#ifdef __cplusplus +extern "C" { +#endif + /* * Exported function declarations: */ @@ -81,10 +85,8 @@ typedef struct TclPlatStubs { #endif /* MACOSX */ } TclPlatStubs; -#ifdef __cplusplus -extern "C" { -#endif extern const TclPlatStubs *tclPlatStubsPtr; + #ifdef __cplusplus } #endif diff --git a/generic/tclPort.h b/generic/tclPort.h index 7021b8d..12a60db 100644 --- a/generic/tclPort.h +++ b/generic/tclPort.h @@ -19,11 +19,10 @@ #endif #if defined(_WIN32) # include "tclWinPort.h" -#endif -#include "tcl.h" -#if !defined(_WIN32) +#else # include "tclUnixPort.h" #endif +#include "tcl.h" #if !defined(LLONG_MIN) # ifdef TCL_WIDE_INT_IS_LONG diff --git a/generic/tclProc.c b/generic/tclProc.c index 933e7d2..1314719 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -271,8 +271,8 @@ Tcl_ProcObjCmd( cfPtr->data.eval.path = contextPtr->data.eval.path; Tcl_IncrRefCount(cfPtr->data.eval.path); - cfPtr->cmd.str.cmd = NULL; - cfPtr->cmd.str.len = 0; + cfPtr->cmd = NULL; + cfPtr->len = 0; hePtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr, procPtr, &isNew); @@ -421,7 +421,7 @@ TclCreateProc( * will be holding a reference to it. */ - procPtr = bodyPtr->internalRep.otherValuePtr; + procPtr = bodyPtr->internalRep.twoPtrValue.ptr1; procPtr->iPtr = iPtr; procPtr->refCount++; precompiled = 1; @@ -837,7 +837,7 @@ TclObjGetFrame( } /* TODO: Consider skipping the typePtr checks */ } else if (objPtr->typePtr == &tclIntType -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG || objPtr->typePtr == &tclWideIntType #endif ) { @@ -1197,7 +1197,7 @@ TclInitCompiledLocals( if (bodyPtr->typePtr != &tclByteCodeType) { Tcl_Panic("body object for proc attached to frame is not a byte code type"); } - codePtr = bodyPtr->internalRep.otherValuePtr; + codePtr = bodyPtr->internalRep.twoPtrValue.ptr1; if (framePtr->numCompiledLocals) { if (!codePtr->localCachePtr) { @@ -1347,17 +1347,9 @@ TclFreeLocalCache( for (i = 0; i < localCachePtr->numVars; i++, namePtrPtr++) { register Tcl_Obj *objPtr = *namePtrPtr; - /* - * 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. - */ - if (objPtr) { - if (interp) { - TclReleaseLiteral(interp, objPtr); - } else { - Tcl_DecrRefCount(objPtr); - } + /* TclReleaseLiteral calls Tcl_DecrRefCount for us */ + TclReleaseLiteral(interp, objPtr); } } ckfree(localCachePtr); @@ -1368,7 +1360,7 @@ InitLocalCache( Proc *procPtr) { Interp *iPtr = procPtr->iPtr; - ByteCode *codePtr = procPtr->bodyPtr->internalRep.otherValuePtr; + ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1; int localCt = procPtr->numCompiledLocals; int numArgs = procPtr->numArgs, i = 0; @@ -1445,7 +1437,7 @@ InitArgsAndLocals( { CallFrame *framePtr = ((Interp *)interp)->varFramePtr; register Proc *procPtr = framePtr->procPtr; - ByteCode *codePtr = procPtr->bodyPtr->internalRep.otherValuePtr; + ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1; register Var *varPtr, *defPtr; int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax; Tcl_Obj *const *argObjs; @@ -1632,7 +1624,7 @@ PushProcCallFrame( * commands and/or resolver changes are considered). */ - codePtr = procPtr->bodyPtr->internalRep.otherValuePtr; + codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1; if (((Interp *) *codePtr->interpHandle != iPtr) || (codePtr->compileEpoch != iPtr->compileEpoch) || (codePtr->nsPtr != nsPtr) @@ -1833,7 +1825,7 @@ TclNRInterpProcCore( */ procPtr->refCount++; - codePtr = procPtr->bodyPtr->internalRep.otherValuePtr; + codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1; TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc, NULL, NULL); @@ -1975,7 +1967,7 @@ TclProcCompileProc( { Interp *iPtr = (Interp *) interp; Tcl_CallFrame *framePtr; - ByteCode *codePtr = bodyPtr->internalRep.otherValuePtr; + ByteCode *codePtr = bodyPtr->internalRep.twoPtrValue.ptr1; /* * If necessary, compile the procedure's body. The compiler will allocate @@ -2095,7 +2087,7 @@ TclProcCompileProc( iPtr->invokeWord = 0; iPtr->invokeCmdFramePtr = (hePtr ? Tcl_GetHashValue(hePtr) : NULL); - tclByteCodeType.setFromAnyProc(interp, bodyPtr); + TclSetByteCodeFromAny(interp, bodyPtr, NULL, NULL); iPtr->invokeCmdFramePtr = NULL; TclPopStackFrame(interp); } else if (codePtr->nsEpoch != nsPtr->resolverEpoch) { @@ -2365,7 +2357,7 @@ TclNewProcBodyObj( TclNewObj(objPtr); if (objPtr) { objPtr->typePtr = &tclProcBodyType; - objPtr->internalRep.otherValuePtr = procPtr; + objPtr->internalRep.twoPtrValue.ptr1 = procPtr; procPtr->refCount++; } @@ -2395,10 +2387,10 @@ ProcBodyDup( Tcl_Obj *srcPtr, /* Object to copy. */ Tcl_Obj *dupPtr) /* Target object for the duplication. */ { - Proc *procPtr = srcPtr->internalRep.otherValuePtr; + Proc *procPtr = srcPtr->internalRep.twoPtrValue.ptr1; dupPtr->typePtr = &tclProcBodyType; - dupPtr->internalRep.otherValuePtr = procPtr; + dupPtr->internalRep.twoPtrValue.ptr1 = procPtr; procPtr->refCount++; } @@ -2425,10 +2417,9 @@ static void ProcBodyFree( Tcl_Obj *objPtr) /* The object to clean up. */ { - Proc *procPtr = objPtr->internalRep.otherValuePtr; + Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1; - procPtr->refCount--; - if (procPtr->refCount <= 0) { + if (procPtr->refCount-- < 2) { TclProcCleanupProc(procPtr); } } @@ -2604,8 +2595,8 @@ SetLambdaFromAny( cfPtr->data.eval.path = contextPtr->data.eval.path; Tcl_IncrRefCount(cfPtr->data.eval.path); - cfPtr->cmd.str.cmd = NULL; - cfPtr->cmd.str.len = 0; + cfPtr->cmd = NULL; + cfPtr->len = 0; } /* @@ -2721,7 +2712,6 @@ TclNRApplyObjCmd( else { /* * Joe English's suggestion to allow cmdNames to function as lambdas. - * Also requires making tclCmdNameType non-static in tclObj.c */ Tcl_Obj *elemPtr; @@ -2961,10 +2951,9 @@ Tcl_DisassembleObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "script"); return TCL_ERROR; } - if (objv[2]->typePtr != &tclByteCodeType) { - if (TclSetByteCodeFromAny(interp, objv[2], NULL, NULL) != TCL_OK){ - return TCL_ERROR; - } + if ((objv[2]->typePtr != &tclByteCodeType) + && (TclSetByteCodeFromAny(interp, objv[2], NULL, NULL) != TCL_OK)) { + return TCL_ERROR; } codeObjPtr = objv[2]; break; @@ -3061,7 +3050,7 @@ Tcl_DisassembleObjCmd( * Do the actual disassembly. */ - if (((ByteCode *) codeObjPtr->internalRep.otherValuePtr)->flags + if (((ByteCode *) codeObjPtr->internalRep.twoPtrValue.ptr1)->flags & TCL_BYTECODE_PRECOMPILED) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may not disassemble prebuilt bytecode", -1)); diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index 6c1dc08..6348e4a 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -578,7 +578,7 @@ Tcl_GetRegExpFromObj( * TclRegexp* when the type is tclRegexpType. */ - regexpPtr = objPtr->internalRep.otherValuePtr; + regexpPtr = objPtr->internalRep.twoPtrValue.ptr1; if ((objPtr->typePtr != &tclRegexpType) || (regexpPtr->flags != flags)) { pattern = TclGetStringFromObj(objPtr, &length); @@ -601,7 +601,7 @@ Tcl_GetRegExpFromObj( */ TclFreeIntRep(objPtr); - objPtr->internalRep.otherValuePtr = regexpPtr; + objPtr->internalRep.twoPtrValue.ptr1 = regexpPtr; objPtr->typePtr = &tclRegexpType; } return (Tcl_RegExp) regexpPtr; @@ -749,7 +749,7 @@ static void FreeRegexpInternalRep( Tcl_Obj *objPtr) /* Regexp object with internal rep to free. */ { - TclRegexp *regexpRepPtr = objPtr->internalRep.otherValuePtr; + TclRegexp *regexpRepPtr = objPtr->internalRep.twoPtrValue.ptr1; /* * If this is the last reference to the regexp, free it. @@ -783,10 +783,10 @@ DupRegexpInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { - TclRegexp *regexpPtr = srcPtr->internalRep.otherValuePtr; + TclRegexp *regexpPtr = srcPtr->internalRep.twoPtrValue.ptr1; regexpPtr->refCount++; - copyPtr->internalRep.otherValuePtr = srcPtr->internalRep.otherValuePtr; + copyPtr->internalRep.twoPtrValue.ptr1 = srcPtr->internalRep.twoPtrValue.ptr1; copyPtr->typePtr = &tclRegexpType; } diff --git a/generic/tclResult.c b/generic/tclResult.c index 9707f20..2f2563a 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -230,6 +230,7 @@ Tcl_DiscardInterpState( *---------------------------------------------------------------------- */ +#undef Tcl_SaveResult void Tcl_SaveResult( Tcl_Interp *interp, /* Interpreter to save. */ @@ -304,6 +305,7 @@ Tcl_SaveResult( *---------------------------------------------------------------------- */ +#undef Tcl_RestoreResult void Tcl_RestoreResult( Tcl_Interp *interp, /* Interpreter being restored. */ @@ -372,6 +374,7 @@ Tcl_RestoreResult( *---------------------------------------------------------------------- */ +#undef Tcl_DiscardResult void Tcl_DiscardResult( Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */ @@ -1109,6 +1112,7 @@ Tcl_SetObjErrorCode( *---------------------------------------------------------------------- */ +#undef Tcl_GetErrorLine int Tcl_GetErrorLine( Tcl_Interp *interp) @@ -1126,6 +1130,7 @@ Tcl_GetErrorLine( *---------------------------------------------------------------------- */ +#undef Tcl_SetErrorLine void Tcl_SetErrorLine( Tcl_Interp *interp, @@ -1587,7 +1592,7 @@ Tcl_GetReturnOptions( } if (result == TCL_ERROR) { - Tcl_AddObjErrorInfo(interp, "", -1); + Tcl_AddErrorInfo(interp, ""); Tcl_DictObjPut(NULL, options, keys[KEY_ERRORSTACK], iPtr->errorStack); } if (iPtr->errorCode) { diff --git a/generic/tclScan.c b/generic/tclScan.c index ef7eedf..4dfc2d6 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -406,11 +406,14 @@ ValidateFormat( */ case 'd': case 'e': + case 'E': case 'f': case 'g': + case 'G': case 'i': case 'o': case 'x': + case 'X': case 'b': break; case 'u': @@ -743,6 +746,7 @@ Tcl_ScanObjCmd( parseFlag |= TCL_PARSE_OCTAL_ONLY | TCL_PARSE_SCAN_PREFIXES; break; case 'x': + case 'X': op = 'i'; parseFlag |= TCL_PARSE_HEXADECIMAL_ONLY; break; @@ -758,7 +762,9 @@ Tcl_ScanObjCmd( case 'f': case 'e': + case 'E': case 'g': + case 'G': op = 'f'; break; diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 2d534a68..883e2ea 100755 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -1239,7 +1239,7 @@ TclParseNumber( if (!octalSignificandOverflow) { if (octalSignificandWide > (Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) { -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG if (octalSignificandWide <= (MOST_BITS + signum)) { objPtr->typePtr = &tclWideIntType; if (signum) { @@ -1286,7 +1286,7 @@ TclParseNumber( if (!significandOverflow) { if (significandWide > (Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) { -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG if (significandWide <= MOST_BITS+signum) { objPtr->typePtr = &tclWideIntType; if (signum) { diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 04cf4ee..e495c2e 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -140,9 +140,9 @@ typedef struct String { #define stringAttemptRealloc(ptr, numChars) \ (String *) attemptckrealloc((ptr), (unsigned) STRING_SIZE(numChars) ) #define GET_STRING(objPtr) \ - ((String *) (objPtr)->internalRep.otherValuePtr) + ((String *) (objPtr)->internalRep.twoPtrValue.ptr1) #define SET_STRING(objPtr, stringPtr) \ - ((objPtr)->internalRep.otherValuePtr = (void *) (stringPtr)) + ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr)) /* * TCL STRING GROWTH ALGORITHM diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 88ada19..e1918ef 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -41,6 +41,9 @@ #undef Tcl_FindExecutable #undef TclpGetPid #undef TclSockMinimumBuffers +#define TclBackgroundException Tcl_BackgroundException +#undef Tcl_SetIntObj +#undef TclpInetNtoa /* See bug 510001: TclSockMinimumBuffers needs plat imp */ #ifdef _WIN64 @@ -53,6 +56,31 @@ static int TclSockMinimumBuffersOld(int sock, int size) } #endif +#define TclSetStartupScriptPath setStartupScriptPath +static void TclSetStartupScriptPath(Tcl_Obj *path) +{ + Tcl_SetStartupScript(path, NULL); +} +#define TclGetStartupScriptPath getStartupScriptPath +static Tcl_Obj *TclGetStartupScriptPath(void) +{ + return Tcl_GetStartupScript(NULL); +} +#define TclSetStartupScriptFileName setStartupScriptFileName +static void TclSetStartupScriptFileName( + const char *fileName) +{ + Tcl_SetStartupScript(Tcl_NewStringObj(fileName,-1), NULL); +} +#define TclGetStartupScriptFileName getStartupScriptFileName +static const char *TclGetStartupScriptFileName(void) +{ + Tcl_Obj *path = Tcl_GetStartupScript(NULL); + if (path == NULL) { + return NULL; + } + return Tcl_GetStringFromObj(path, NULL); +} #if defined(_WIN32) || defined(__CYGWIN__) #undef TclWinNToHS @@ -170,6 +198,89 @@ Tcl_WinTCharToUtf( string, len, dsPtr); } +#if defined(TCL_WIDE_INT_IS_LONG) +/* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore + * we have to make sure that all stub entries on Cygwin64 follow the Win64 + * signature. Tcl 9 must find a better solution, but that cannot be done + * without introducing a binary incompatibility. + */ +#define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))dbNewLongObj) +static Tcl_Obj *dbNewLongObj( + int intValue, + const char *file, + int line +) { +#ifdef TCL_MEM_DEBUG + register Tcl_Obj *objPtr; + + TclDbNewObj(objPtr, file, line); + objPtr->bytes = NULL; + + objPtr->internalRep.longValue = (long) intValue; + objPtr->typePtr = &tclIntType; + return objPtr; +#else + return Tcl_NewIntObj(intValue); +#endif +} +#define Tcl_GetLongFromObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetIntFromObj +#define Tcl_NewLongObj (Tcl_Obj*(*)(long))Tcl_NewIntObj +#define Tcl_SetLongObj (void(*)(Tcl_Obj*,long))Tcl_SetIntObj +static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){ + long longValue; + int result = Tcl_ExprLong(interp, expr, &longValue); + if (result == TCL_OK) { + if ((longValue >= -(long)(UINT_MAX)) + && (longValue <= (long)(UINT_MAX))) { + *ptr = (int)longValue; + } else { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "integer value too large to represent as non-long integer", -1)); + result = TCL_ERROR; + } + } + return result; +} +#define Tcl_ExprLong (int(*)(Tcl_Interp*,const char*,long*))exprInt +static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){ + long longValue; + int result = Tcl_ExprLongObj(interp, expr, &longValue); + if (result == TCL_OK) { + if ((longValue >= -(long)(UINT_MAX)) + && (longValue <= (long)(UINT_MAX))) { + *ptr = (int)longValue; + } else { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "integer value too large to represent as non-long integer", -1)); + result = TCL_ERROR; + } + } + return result; +} +#define Tcl_ExprLongObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))exprIntObj +static int uniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){ + return Tcl_UniCharNcmp(ucs, uct, (unsigned long)n); +} +#define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcmp +static int utfNcmp(const char *s1, const char *s2, unsigned int n){ + return Tcl_UtfNcmp(s1, s2, (unsigned long)n); +} +#define Tcl_UtfNcmp (int(*)(const char*,const char*,unsigned long))utfNcmp +static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){ + return Tcl_UtfNcasecmp(s1, s2, (unsigned long)n); +} +#define Tcl_UtfNcasecmp (int(*)(const char*,const char*,unsigned long))utfNcasecmp +static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){ + return Tcl_UniCharNcasecmp(ucs, uct, (unsigned long)n); +} +#define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcasecmp +static int formatInt(char *buffer, int n){ + return TclFormatInt(buffer, (long)n); +} +#define TclFormatInt (int(*)(char *, long))formatInt + +#endif + #else /* UNIX and MAC */ # define TclpLocaltime_unix TclpLocaltime # define TclpGmtime_unix TclpGmtime @@ -347,8 +458,8 @@ static const TclIntStubs tclIntStubs = { 0, /* 155 */ TclRegError, /* 156 */ TclVarTraceExists, /* 157 */ - 0, /* 158 */ - 0, /* 159 */ + TclSetStartupScriptFileName, /* 158 */ + TclGetStartupScriptFileName, /* 159 */ 0, /* 160 */ TclChannelTransform, /* 161 */ TclChannelEventScriptInvoker, /* 162 */ @@ -356,8 +467,8 @@ static const TclIntStubs tclIntStubs = { TclExpandCodeArray, /* 164 */ TclpSetInitialEncodings, /* 165 */ TclListObjSetElement, /* 166 */ - 0, /* 167 */ - 0, /* 168 */ + TclSetStartupScriptPath, /* 167 */ + TclGetStartupScriptPath, /* 168 */ TclpUtfNcmp2, /* 169 */ TclCheckInterpTraces, /* 170 */ TclCheckExecutionTraces, /* 171 */ @@ -367,8 +478,8 @@ static const TclIntStubs tclIntStubs = { TclCallVarTraces, /* 175 */ TclCleanupVar, /* 176 */ TclVarErrMsg, /* 177 */ - 0, /* 178 */ - 0, /* 179 */ + Tcl_SetStartupScript, /* 178 */ + Tcl_GetStartupScript, /* 179 */ 0, /* 180 */ 0, /* 181 */ TclpLocaltime, /* 182 */ @@ -425,7 +536,7 @@ static const TclIntStubs tclIntStubs = { TclGetSrcInfoForPc, /* 233 */ TclVarHashCreateVar, /* 234 */ TclInitVarHashTable, /* 235 */ - 0, /* 236 */ + TclBackgroundException, /* 236 */ TclResetCancellation, /* 237 */ TclNRInterpProc, /* 238 */ TclNRInterpProcCore, /* 239 */ @@ -440,6 +551,7 @@ static const TclIntStubs tclIntStubs = { TclCopyChannel, /* 248 */ TclDoubleDigits, /* 249 */ TclSetSlaveCancelFlags, /* 250 */ + TclRegisterLiteral, /* 251 */ }; static const TclIntPlatStubs tclIntPlatStubs = { diff --git a/generic/tclTest.c b/generic/tclTest.c index a8b27fb..f121d0d 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -327,10 +327,12 @@ static int TestreturnObjCmd(ClientData dummy, Tcl_Obj *const objv[]); static void TestregexpXflags(const char *string, int length, int *cflagsPtr, int *eflagsPtr); +#ifndef TCL_NO_DEPRECATED static int TestsaveresultCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void TestsaveresultFree(char *blockPtr); +#endif /* TCL_NO_DEPRECATED */ static int TestsetassocdataCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestsetCmd(ClientData dummy, @@ -523,7 +525,9 @@ int Tcltest_Init( Tcl_Interp *interp) /* Interpreter for application. */ { +#ifndef TCL_NO_DEPRECATED Tcl_ValueType t3ArgTypes[2]; +#endif /* TCL_NO_DEPRECATED */ Tcl_Obj *listPtr; Tcl_Obj **objv; @@ -642,8 +646,10 @@ Tcltest_Init( NULL, NULL); Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd, NULL, NULL); +#ifndef TCL_NO_DEPRECATED Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd, NULL, NULL); +#endif /* TCL_NO_DEPRECATED */ Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd, @@ -665,8 +671,10 @@ Tcltest_Init( Tcl_CreateCommand(interp, "testtranslatefilename", TesttranslatefilenameCmd, NULL, NULL); Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL); +#ifndef TCL_NO_DEPRECATED Tcl_CreateMathFunc(interp, "T1", 0, NULL, TestMathFunc, (ClientData) 123); Tcl_CreateMathFunc(interp, "T2", 0, NULL, TestMathFunc, (ClientData) 345); +#endif /* TCL_NO_DEPRECATED */ Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd, @@ -677,10 +685,12 @@ Tcltest_Init( Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd, (ClientData) 0, NULL); #endif +#ifndef TCL_NO_DEPRECATED t3ArgTypes[0] = TCL_EITHER; t3ArgTypes[1] = TCL_EITHER; Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2, NULL); +#endif /* TCL_NO_DEPRECATED */ Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels, NULL, NULL); @@ -1545,14 +1555,14 @@ DelCallbackProc( * * TestdelCmd -- * - * This procedure implements the "testdcall" command. It is used - * to test Tcl_CallWhenDeleted. + * This procedure implements the "testdel" command. It is used + * to test calling of command deletion callbacks. * * Results: * A standard Tcl result. * * Side effects: - * Creates and deletes interpreters. + * Creates a command. * *---------------------------------------------------------------------- */ @@ -1846,7 +1856,7 @@ TestdstringCmd( if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) { return TCL_ERROR; } - Tcl_DStringTrunc(&dstring, count); + Tcl_DStringSetLength(&dstring, count); } else if (strcmp(argv[1], "start") == 0) { if (argc != 2) { goto wrongNumArgs; @@ -4398,8 +4408,26 @@ TestseterrorcodeCmd( Tcl_SetResult(interp, "too many args", TCL_STATIC); return TCL_ERROR; } - Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4], - argv[5], NULL); + switch (argc) { + case 1: + Tcl_SetErrorCode(interp, "NONE", NULL); + break; + case 2: + Tcl_SetErrorCode(interp, argv[1], NULL); + break; + case 3: + Tcl_SetErrorCode(interp, argv[1], argv[2], NULL); + break; + case 4: + Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], NULL); + break; + case 5: + Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4], NULL); + break; + case 6: + Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4], + argv[5], NULL); + } return TCL_ERROR; } @@ -5003,6 +5031,7 @@ Testset2Cmd( } } +#ifndef TCL_NO_DEPRECATED /* *---------------------------------------------------------------------- * @@ -5136,6 +5165,7 @@ TestsaveresultFree( { freeCount++; } +#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- @@ -6170,7 +6200,7 @@ TestReport( * API, but there you go. We should convert it to objects. */ - Tcl_SavedResult savedResult; + Tcl_Obj *savedResult; Tcl_DString ds; Tcl_DStringInit(&ds); @@ -6184,11 +6214,15 @@ TestReport( Tcl_DStringAppendElement(&ds, Tcl_GetString(arg2)); } Tcl_DStringEndSublist(&ds); - Tcl_SaveResult(interp, &savedResult); + savedResult = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(savedResult); + Tcl_SetObjResult(interp, Tcl_NewObj()); Tcl_Eval(interp, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); - Tcl_RestoreResult(interp, &savedResult); - } + Tcl_ResetResult(interp); + Tcl_SetObjResult(interp, savedResult); + Tcl_DecrRefCount(savedResult); + } } static int diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 4bddc42..f36b07f 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -555,7 +555,7 @@ TestindexobjCmd( } Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index); - indexRep = objv[1]->internalRep.otherValuePtr; + indexRep = objv[1]->internalRep.twoPtrValue.ptr1; indexRep->index = index2; result = Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index); @@ -592,7 +592,7 @@ TestindexobjCmd( if (objv[3]->typePtr != NULL && !strcmp("index", objv[3]->typePtr->name)) { - indexRep = objv[3]->internalRep.otherValuePtr; + indexRep = objv[3]->internalRep.twoPtrValue.ptr1; if (indexRep->tablePtr == (void *) argv) { TclFreeIntRep(objv[3]); } @@ -1250,7 +1250,7 @@ TeststringobjCmd( if (varPtr[varIndex] != NULL) { Tcl_ConvertToType(NULL, varPtr[varIndex], Tcl_GetObjType("string")); - strPtr = varPtr[varIndex]->internalRep.otherValuePtr; + strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1; length = (int) strPtr->allocated; } else { length = -1; @@ -1304,7 +1304,7 @@ TeststringobjCmd( if (varPtr[varIndex] != NULL) { Tcl_ConvertToType(NULL, varPtr[varIndex], Tcl_GetObjType("string")); - strPtr = varPtr[varIndex]->internalRep.otherValuePtr; + strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1; length = strPtr->maxChars; } else { length = -1; diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c index e4261d6..abd5af5 100644 --- a/generic/tclThreadAlloc.c +++ b/generic/tclThreadAlloc.c @@ -573,7 +573,7 @@ TclThreadAllocObj(void) } while (--numMove >= 0) { objPtr = &newObjsPtr[numMove]; - objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr; + objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr; cachePtr->firstObjPtr = objPtr; } } @@ -584,7 +584,7 @@ TclThreadAllocObj(void) */ objPtr = cachePtr->firstObjPtr; - cachePtr->firstObjPtr = objPtr->internalRep.otherValuePtr; + cachePtr->firstObjPtr = objPtr->internalRep.twoPtrValue.ptr1; cachePtr->numObjects--; return objPtr; } @@ -621,7 +621,7 @@ TclThreadFreeObj( * Get this thread's list and push on the free Tcl_Obj. */ - objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr; + objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr; cachePtr->firstObjPtr = objPtr; cachePtr->numObjects++; @@ -722,16 +722,16 @@ MoveObjs( */ while (--numMove) { - objPtr = objPtr->internalRep.otherValuePtr; + objPtr = objPtr->internalRep.twoPtrValue.ptr1; } - fromPtr->firstObjPtr = objPtr->internalRep.otherValuePtr; + fromPtr->firstObjPtr = objPtr->internalRep.twoPtrValue.ptr1; /* * Move all objects as a block - they are already linked to each other, we * just have to update the first and last. */ - objPtr->internalRep.otherValuePtr = toPtr->firstObjPtr; + objPtr->internalRep.twoPtrValue.ptr1 = toPtr->firstObjPtr; toPtr->firstObjPtr = fromFirstObjPtr; } diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index b90e33d..02ee038 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -337,7 +337,7 @@ ThreadObjCmd( */ if (objc == 2) { - idObj = Tcl_NewLongObj((long)(size_t)Tcl_GetCurrentThread()); + idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t)Tcl_GetCurrentThread()); } else if (objc == 3 && strcmp("-main", Tcl_GetString(objv[2])) == 0) { Tcl_MutexLock(&threadMutex); @@ -355,14 +355,14 @@ ThreadObjCmd( return TCL_ERROR; } case THREAD_JOIN: { - long id; + Tcl_WideInt id; int result, status; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "id"); return TCL_ERROR; } - if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[2], &id) != TCL_OK) { return TCL_ERROR; } @@ -372,7 +372,7 @@ ThreadObjCmd( } else { char buf[20]; - TclFormatInt(buf, id); + sprintf(buf, "%" TCL_LL_MODIFIER "d", id); Tcl_AppendResult(interp, "cannot join thread ", buf, NULL); } return result; @@ -384,7 +384,7 @@ ThreadObjCmd( } return ThreadList(interp); case THREAD_SEND: { - long id; + Tcl_WideInt id; const char *script; int wait, arg; @@ -403,7 +403,7 @@ ThreadObjCmd( wait = 1; arg = 2; } - if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[arg], &id) != TCL_OK) { return TCL_ERROR; } arg++; @@ -523,7 +523,7 @@ ThreadCreate( Tcl_ConditionWait(&ctrl.condWait, &threadMutex, NULL); Tcl_MutexUnlock(&threadMutex); Tcl_ConditionFinalize(&ctrl.condWait); - Tcl_SetObjResult(interp, Tcl_NewLongObj((long)(size_t)id)); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)(size_t)id)); return TCL_OK; } @@ -655,7 +655,7 @@ ThreadErrorProc( char *script; char buf[TCL_DOUBLE_SPACE+1]; - TclFormatInt(buf, (size_t) Tcl_GetCurrentThread()); + sprintf(buf, "%" TCL_LL_MODIFIER "d", (Tcl_WideInt)(size_t)Tcl_GetCurrentThread()); errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); if (errorProcString == NULL) { @@ -773,7 +773,7 @@ ThreadList( Tcl_MutexLock(&threadMutex); for (tsdPtr = threadList ; tsdPtr ; tsdPtr = tsdPtr->nextPtr) { Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewLongObj((long)(size_t)tsdPtr->threadId)); + Tcl_NewWideIntObj((Tcl_WideInt)(size_t)tsdPtr->threadId)); } Tcl_MutexUnlock(&threadMutex); Tcl_SetObjResult(interp, listPtr); @@ -926,10 +926,11 @@ ThreadSend( ckfree(resultPtr->errorInfo); } } - Tcl_SetResult(interp, resultPtr->result, TCL_DYNAMIC); + Tcl_AppendResult(interp, resultPtr->result, NULL); Tcl_ConditionFinalize(&resultPtr->done); code = resultPtr->code; + ckfree(resultPtr->result); ckfree(resultPtr); return code; diff --git a/generic/tclTimer.c b/generic/tclTimer.c index 6b17825..c10986a 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -819,7 +819,7 @@ Tcl_AfterObjCmd( */ if (objv[1]->typePtr == &tclIntType -#ifndef NO_WIDE_TYPE +#ifndef TCL_WIDE_INT_IS_LONG || objv[1]->typePtr == &tclWideIntType #endif || objv[1]->typePtr == &tclBignumType diff --git a/generic/tclTomMathDecls.h b/generic/tclTomMathDecls.h index ef22153..69b095c 100644 --- a/generic/tclTomMathDecls.h +++ b/generic/tclTomMathDecls.h @@ -134,6 +134,10 @@ /* !BEGIN!: Do not edit below this line. */ +#ifdef __cplusplus +extern "C" { +#endif + /* * Exported function declarations: */ @@ -346,10 +350,8 @@ typedef struct TclTomMathStubs { int (*tclBN_mp_cnt_lsb) (const mp_int *a); /* 63 */ } TclTomMathStubs; -#ifdef __cplusplus -extern "C" { -#endif extern const TclTomMathStubs *tclTomMathStubsPtr; + #ifdef __cplusplus } #endif diff --git a/generic/tclTomMathStubLib.c b/generic/tclTomMathStubLib.c index a3bc4b3..324f2a3 100644 --- a/generic/tclTomMathStubLib.c +++ b/generic/tclTomMathStubLib.c @@ -11,15 +11,6 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -/* - * We need to ensure that we use the stub macros so that this file contains no - * references to any of the stub functions. This will make it possible to - * build an extension that references Tcl_InitStubs but doesn't end up - * including the rest of the stub functions. - */ - -#define USE_TCL_STUBS - #include "tclInt.h" MODULE_SCOPE const TclTomMathStubs *tclTomMathStubsPtr; @@ -55,31 +46,30 @@ TclTomMathInitializeStubs( int exact = 0; const char *packageName = "tcl::tommath"; const char *errMsg = NULL; - ClientData pkgClientData = NULL; - const char *actualVersion = - Tcl_PkgRequireEx(interp, packageName, version, exact, &pkgClientData); - const TclTomMathStubs *stubsPtr = pkgClientData; + TclTomMathStubs *stubsPtr = NULL; + const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp, + packageName, version, exact, &stubsPtr); if (actualVersion == NULL) { return NULL; } - if (pkgClientData == NULL) { + if (stubsPtr == NULL) { errMsg = "missing stub table pointer"; - } else if ((stubsPtr->tclBN_epoch)() != epoch) { + } else if(stubsPtr->tclBN_epoch() != epoch) { errMsg = "epoch number mismatch"; - } else if ((stubsPtr->tclBN_revision)() != revision) { + } else if(stubsPtr->tclBN_revision() != revision) { errMsg = "requires a later revision"; } else { tclTomMathStubsPtr = stubsPtr; return actualVersion; } - - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "error loading %s (requested version %s, actual version %s): %s", - packageName, version, actualVersion, errMsg)); + tclStubsPtr->tcl_ResetResult(interp); + tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName, + " (requested version ", version, ", actual version ", + actualVersion, "): ", errMsg, NULL); return NULL; } - + /* * Local Variables: * mode: c diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 519f201..c0cde49 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -155,8 +155,8 @@ typedef struct StringTraceData { #define FOREACH_VAR_TRACE(interp, name, clientData) \ (clientData) = NULL; \ - while (((clientData) = Tcl_VarTraceInfo((interp), (name), 0, \ - TraceVarProc, (clientData))) != NULL) + while (((clientData) = Tcl_VarTraceInfo2((interp), (name), NULL, \ + 0, TraceVarProc, (clientData))) != NULL) #define FOREACH_COMMAND_TRACE(interp, name, clientData) \ (clientData) = NULL; \ @@ -1322,7 +1322,7 @@ TraceCommandProc( Tcl_DStringLength(&cmd), 0); if (code != TCL_OK) { /* We ignore errors in these traced commands */ - /*** QUESTION: Use Tcl_BackgroundError(interp); instead? ***/ + /*** QUESTION: Use Tcl_BackgroundException(interp, code); instead? ***/ } Tcl_DStringFree(&cmd); } @@ -1485,7 +1485,11 @@ TclCheckExecutionTraces( } iPtr->activeCmdTracePtr = active.nextPtr; if (state) { - Tcl_RestoreInterpState(interp, state); + if (traceCode == TCL_OK) { + (void) Tcl_RestoreInterpState(interp, state); + } else { + Tcl_DiscardInterpState(state); + } } return traceCode; @@ -2811,6 +2815,7 @@ DisposeTraceResult( *---------------------------------------------------------------------- */ +#undef Tcl_UntraceVar void Tcl_UntraceVar( Tcl_Interp *interp, /* Interpreter containing variable. */ @@ -2979,6 +2984,7 @@ Tcl_UntraceVar2( *---------------------------------------------------------------------- */ +#undef Tcl_VarTraceInfo ClientData Tcl_VarTraceInfo( Tcl_Interp *interp, /* Interpreter containing variable. */ @@ -3087,6 +3093,7 @@ Tcl_VarTraceInfo2( *---------------------------------------------------------------------- */ +#undef Tcl_TraceVar int Tcl_TraceVar( Tcl_Interp *interp, /* Interpreter in which variable is to be diff --git a/generic/tclUniData.c b/generic/tclUniData.c index 5c88639..a0d4ccc 100644 --- a/generic/tclUniData.c +++ b/generic/tclUniData.c @@ -624,7 +624,7 @@ static const unsigned char groupMap[] = { 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 15, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 17, 17, 0, 7, 7, 7, 3, 3, - 4, 3, 3, 14, 14, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 3, 0, + 4, 3, 3, 14, 14, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 3, 17, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 85, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 86, 86, 86, 86, @@ -792,118 +792,118 @@ static const unsigned char groupMap[] = { 116, 86, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 3, 3, 3, 85, 3, 3, 3, 4, 15, 86, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, - 0, 3, 3, 3, 3, 3, 3, 8, 3, 3, 3, 3, 86, 86, 86, 2, 0, 9, 9, 9, 9, 9, - 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 85, 15, 15, 15, 15, 15, + 0, 3, 3, 3, 3, 3, 3, 8, 3, 3, 3, 3, 86, 86, 86, 17, 0, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 85, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, - 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 15, 0, 0, 0, 0, 0, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, + 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 15, 0, 0, 0, 0, + 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 86, 86, 86, 116, 116, 116, 116, + 86, 86, 116, 116, 116, 0, 0, 0, 0, 116, 116, 86, 116, 116, 116, 116, + 116, 116, 86, 86, 86, 0, 0, 0, 0, 14, 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 0, 0, 0, 86, 86, 86, 116, 116, 116, 116, 86, - 86, 116, 116, 116, 0, 0, 0, 0, 116, 116, 86, 116, 116, 116, 116, 116, - 116, 86, 86, 86, 0, 0, 0, 0, 14, 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, 9, 9, - 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, - 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 116, 116, 116, 116, 116, 116, - 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 15, 15, 15, - 15, 15, 15, 15, 116, 116, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 9, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 0, 0, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 116, 116, 116, + 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, + 15, 15, 15, 15, 15, 15, 15, 116, 116, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 116, 116, 116, - 0, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 116, 86, 116, 86, 86, 86, 86, 86, 86, 86, - 0, 86, 116, 86, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 116, 116, - 116, 116, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 0, 0, 86, - 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, - 9, 9, 9, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 85, 3, 3, 3, 3, 3, - 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, 86, - 86, 116, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 116, - 86, 86, 86, 86, 86, 116, 86, 116, 116, 116, 116, 116, 86, 116, 116, - 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 3, 3, 3, 3, 3, 3, 3, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 86, - 86, 86, 86, 86, 86, 86, 86, 86, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 0, 0, 0, 86, 86, 116, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 116, 86, 86, 86, 86, 116, 116, 86, 86, 116, 86, 116, 116, 15, 15, - 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 86, 116, 86, 86, 116, 116, 116, 86, 116, 86, 86, 86, 116, 116, - 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 15, 15, 15, 15, 116, 116, 116, - 116, 116, 116, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 116, 116, - 86, 86, 0, 0, 0, 3, 3, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, - 0, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 85, 85, 85, 85, 85, 85, 3, 3, 3, 3, 3, - 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, 86, 3, 86, 86, 86, 86, - 86, 86, 86, 86, 86, 86, 86, 86, 86, 116, 86, 86, 86, 86, 86, 86, 86, - 15, 15, 15, 15, 86, 15, 15, 15, 15, 116, 116, 86, 15, 15, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 116, + 116, 86, 0, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 116, 86, 116, 86, 86, 86, 86, 86, + 86, 86, 0, 86, 116, 86, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 116, + 116, 116, 116, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 0, + 0, 86, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 85, 3, 3, + 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, + 86, 86, 86, 116, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 86, 116, 86, 86, 86, 86, 86, 116, 86, 116, 116, 116, 116, 116, 86, + 116, 116, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 3, 3, 3, 3, 3, 3, 3, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 86, 86, 86, 86, 86, 86, 86, 86, 86, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 0, 0, 0, 86, 86, 116, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 116, 86, 86, 86, 86, 116, 116, 86, 86, 116, 86, 116, 116, + 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 86, 116, 86, 86, 116, 116, 116, 86, 116, 86, 86, 86, + 116, 116, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 15, 15, 15, 15, 116, + 116, 116, 116, 116, 116, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, + 116, 116, 86, 86, 0, 0, 0, 3, 3, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, + 9, 0, 0, 0, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 85, 85, 85, 85, 85, 85, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, 86, 3, 86, 86, + 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 116, 86, 86, 86, 86, 86, + 86, 86, 15, 15, 15, 15, 86, 15, 15, 15, 15, 116, 116, 86, 15, 15, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 85, 85, 85, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, - 85, 85, 85, 85, 85, 85, 85, 85, 85, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 85, 119, 21, 21, 21, 120, 21, 21, 21, 21, 21, 21, + 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 85, 119, 21, 21, 21, 120, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 85, 85, 85, 85, 85, 86, 86, 86, 86, 86, 86, - 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 86, 86, 86, 86, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, - 24, 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 21, 21, 21, 121, 21, 21, - 122, 21, 123, 123, 123, 123, 123, 123, 123, 123, 124, 124, 124, 124, - 124, 124, 124, 124, 123, 123, 123, 123, 123, 123, 0, 0, 124, 124, 124, - 124, 124, 124, 0, 0, 123, 123, 123, 123, 123, 123, 123, 123, 124, 124, - 124, 124, 124, 124, 124, 124, 123, 123, 123, 123, 123, 123, 123, 123, - 124, 124, 124, 124, 124, 124, 124, 124, 123, 123, 123, 123, 123, 123, - 0, 0, 124, 124, 124, 124, 124, 124, 0, 0, 21, 123, 21, 123, 21, 123, - 21, 123, 0, 124, 0, 124, 0, 124, 0, 124, 123, 123, 123, 123, 123, 123, - 123, 123, 124, 124, 124, 124, 124, 124, 124, 124, 125, 125, 126, 126, - 126, 126, 127, 127, 128, 128, 129, 129, 130, 130, 0, 0, 123, 123, 123, - 123, 123, 123, 123, 123, 131, 131, 131, 131, 131, 131, 131, 131, 123, - 123, 123, 123, 123, 123, 123, 123, 131, 131, 131, 131, 131, 131, 131, - 131, 123, 123, 123, 123, 123, 123, 123, 123, 131, 131, 131, 131, 131, - 131, 131, 131, 123, 123, 21, 132, 21, 0, 21, 21, 124, 124, 133, 133, - 134, 11, 135, 11, 11, 11, 21, 132, 21, 0, 21, 21, 136, 136, 136, 136, - 134, 11, 11, 11, 123, 123, 21, 21, 0, 0, 21, 21, 124, 124, 137, 137, - 0, 11, 11, 11, 123, 123, 21, 21, 21, 106, 21, 21, 124, 124, 138, 138, - 109, 11, 11, 11, 0, 0, 21, 132, 21, 0, 21, 21, 139, 139, 140, 140, - 134, 11, 11, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 17, 17, 17, 17, 17, - 8, 8, 8, 8, 8, 8, 3, 3, 16, 20, 5, 16, 16, 20, 5, 16, 3, 3, 3, 3, 3, - 3, 3, 3, 141, 142, 17, 17, 17, 17, 17, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, - 16, 20, 3, 3, 3, 3, 12, 12, 3, 3, 3, 7, 5, 6, 3, 3, 3, 3, 3, 3, 3, - 3, 3, 3, 3, 7, 3, 12, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 17, 17, 17, - 17, 17, 0, 0, 0, 0, 0, 17, 17, 17, 17, 17, 17, 18, 85, 0, 0, 18, 18, - 18, 18, 18, 18, 7, 7, 7, 5, 6, 85, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 7, 7, 7, 5, 6, 0, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, - 85, 85, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, - 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, - 86, 86, 111, 111, 111, 111, 86, 111, 111, 111, 86, 86, 86, 86, 86, - 86, 86, 86, 86, 86, 86, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 14, 14, 100, 14, 14, 14, 14, 100, 14, 14, 21, 100, 100, 100, - 21, 21, 100, 100, 100, 21, 14, 100, 14, 14, 7, 100, 100, 100, 100, - 100, 14, 14, 14, 14, 14, 14, 100, 14, 143, 14, 100, 14, 144, 145, 100, - 100, 14, 21, 100, 100, 146, 100, 21, 15, 15, 15, 15, 21, 14, 14, 21, - 21, 100, 100, 7, 7, 7, 7, 7, 100, 21, 21, 21, 21, 14, 7, 14, 14, 147, - 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, - 148, 148, 149, 149, 149, 149, 149, 149, 149, 149, 149, 149, 149, 149, - 149, 149, 149, 149, 118, 118, 118, 23, 24, 118, 118, 118, 118, 18, - 0, 0, 0, 0, 0, 0, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 7, 7, 14, 14, - 14, 14, 7, 14, 14, 7, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 7, 14, + 21, 21, 21, 21, 21, 21, 21, 21, 85, 85, 85, 85, 85, 86, 86, 86, 86, + 86, 86, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 86, 86, 86, 86, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, + 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 21, 21, 21, 121, 21, + 21, 122, 21, 123, 123, 123, 123, 123, 123, 123, 123, 124, 124, 124, + 124, 124, 124, 124, 124, 123, 123, 123, 123, 123, 123, 0, 0, 124, 124, + 124, 124, 124, 124, 0, 0, 123, 123, 123, 123, 123, 123, 123, 123, 124, + 124, 124, 124, 124, 124, 124, 124, 123, 123, 123, 123, 123, 123, 123, + 123, 124, 124, 124, 124, 124, 124, 124, 124, 123, 123, 123, 123, 123, + 123, 0, 0, 124, 124, 124, 124, 124, 124, 0, 0, 21, 123, 21, 123, 21, + 123, 21, 123, 0, 124, 0, 124, 0, 124, 0, 124, 123, 123, 123, 123, 123, + 123, 123, 123, 124, 124, 124, 124, 124, 124, 124, 124, 125, 125, 126, + 126, 126, 126, 127, 127, 128, 128, 129, 129, 130, 130, 0, 0, 123, 123, + 123, 123, 123, 123, 123, 123, 131, 131, 131, 131, 131, 131, 131, 131, + 123, 123, 123, 123, 123, 123, 123, 123, 131, 131, 131, 131, 131, 131, + 131, 131, 123, 123, 123, 123, 123, 123, 123, 123, 131, 131, 131, 131, + 131, 131, 131, 131, 123, 123, 21, 132, 21, 0, 21, 21, 124, 124, 133, + 133, 134, 11, 135, 11, 11, 11, 21, 132, 21, 0, 21, 21, 136, 136, 136, + 136, 134, 11, 11, 11, 123, 123, 21, 21, 0, 0, 21, 21, 124, 124, 137, + 137, 0, 11, 11, 11, 123, 123, 21, 21, 21, 106, 21, 21, 124, 124, 138, + 138, 109, 11, 11, 11, 0, 0, 21, 132, 21, 0, 21, 21, 139, 139, 140, + 140, 134, 11, 11, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 17, 17, 17, 17, + 17, 8, 8, 8, 8, 8, 8, 3, 3, 16, 20, 5, 16, 16, 20, 5, 16, 3, 3, 3, + 3, 3, 3, 3, 3, 141, 142, 17, 17, 17, 17, 17, 2, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 16, 20, 3, 3, 3, 3, 12, 12, 3, 3, 3, 7, 5, 6, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 7, 3, 12, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 17, 17, + 17, 17, 17, 0, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 18, 85, 0, 0, + 18, 18, 18, 18, 18, 18, 7, 7, 7, 5, 6, 85, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 7, 7, 7, 5, 6, 0, 85, 85, 85, 85, 85, 85, 85, 85, 85, + 85, 85, 85, 85, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, 86, 86, 86, 86, 86, 86, 86, + 86, 86, 86, 86, 111, 111, 111, 111, 86, 111, 111, 111, 86, 86, 86, + 86, 86, 86, 86, 86, 86, 86, 86, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 14, 14, 100, 14, 14, 14, 14, 100, 14, 14, 21, 100, 100, + 100, 21, 21, 100, 100, 100, 21, 14, 100, 14, 14, 7, 100, 100, 100, + 100, 100, 14, 14, 14, 14, 14, 14, 100, 14, 143, 14, 100, 14, 144, 145, + 100, 100, 14, 21, 100, 100, 146, 100, 21, 15, 15, 15, 15, 21, 14, 14, + 21, 21, 100, 100, 7, 7, 7, 7, 7, 100, 21, 21, 21, 21, 14, 7, 14, 14, + 147, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, + 148, 148, 148, 149, 149, 149, 149, 149, 149, 149, 149, 149, 149, 149, + 149, 149, 149, 149, 149, 118, 118, 118, 23, 24, 118, 118, 118, 118, + 18, 0, 0, 0, 0, 0, 0, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 7, 7, 14, + 14, 14, 14, 7, 14, 14, 7, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, 7, - 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, + 7, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14, - 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 5, 6, 5, 6, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, 14, 14, 14, 14, 14, 5, 6, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 4b5b37b..15529c7 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -1106,6 +1106,46 @@ Tcl_UtfNcasecmp( /* *---------------------------------------------------------------------- * + * Tcl_UtfNcasecmp -- + * + * Compare UTF chars of string cs to string ct case insensitively. + * Replacement for strcasecmp in Tcl core, in places where UTF-8 should + * be handled. + * + * Results: + * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +TclUtfCasecmp( + const char *cs, /* UTF string to compare to ct. */ + const char *ct) /* UTF string cs is compared to. */ +{ + while (*cs && *ct) { + Tcl_UniChar ch1, ch2; + + cs += TclUtfToUniChar(cs, &ch1); + ct += TclUtfToUniChar(ct, &ch2); + if (ch1 != ch2) { + ch1 = Tcl_UniCharToLower(ch1); + ch2 = Tcl_UniCharToLower(ch2); + if (ch1 != ch2) { + return ch1 - ch2; + } + } + } + return UCHAR(*cs) - UCHAR(*ct); +} + + +/* + *---------------------------------------------------------------------- + * * Tcl_UniCharToUpper -- * * Compute the uppercase equivalent of the given Unicode character. @@ -1515,9 +1555,10 @@ Tcl_UniCharIsSpace( */ if (((Tcl_UniChar) ch) < ((Tcl_UniChar) 0x80)) { - return isspace(UCHAR(ch)); /* INTL: ISO space */ - } else if ((Tcl_UniChar) ch == 0x0085 || (Tcl_UniChar) ch == 0x200b - || (Tcl_UniChar) ch == 0x2060 || (Tcl_UniChar) ch == 0xfeff) { + return TclIsSpaceProc((char) ch); + } else if ((Tcl_UniChar) ch == 0x0085 || (Tcl_UniChar) ch == 0x180e + || (Tcl_UniChar) ch == 0x200b || (Tcl_UniChar) ch == 0x2060 + || (Tcl_UniChar) ch == 0x202f || (Tcl_UniChar) ch == 0xfeff) { return 1; } else { return ((SPACE_BITS >> GetCategory(ch)) & 1); diff --git a/generic/tclUtil.c b/generic/tclUtil.c index ddf067b..b089132 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -167,7 +167,7 @@ const Tcl_ObjType tclEndOffsetType = { * separating whitespace, or a string terminator. It is just another * character in a list element. * - * The interpretaton of a formatted substring as a list element follows rules + * The interpretation of a formatted substring as a list element follows rules * similar to the parsing of the words of a command in a Tcl script. Backslash * substitution plays a key role, and is defined exactly as it is in command * parsing. The same routine, TclParseBackslash() is used in both command @@ -179,7 +179,7 @@ const Tcl_ObjType tclEndOffsetType = { * Backslash substitution replaces an "escape sequence" of one or more * characters starting with * \u005c \ BACKSLASH - * with a single character. The one character escape sequent case happens only + * with a single character. The one character escape sequence case happens only * when BACKSLASH is the last character in the string. In all other cases, the * escape sequence is at least two characters long. * @@ -3580,10 +3580,9 @@ UpdateStringOfEndOffset( register Tcl_Obj *objPtr) { char buffer[TCL_INTEGER_SPACE + 5]; - register int len; + register int len = 3; memcpy(buffer, "end", 4); - len = sizeof("end") - 1; if (objPtr->internalRep.longValue != 0) { buffer[len++] = '-'; len += TclFormatInt(buffer+len, -(objPtr->internalRep.longValue)); diff --git a/generic/tclVar.c b/generic/tclVar.c index 1c01e41..4694cd8 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -47,6 +47,13 @@ static inline void CleanupVar(Var *varPtr, Var *arrayPtr); #define VarHashGetValue(hPtr) \ ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry))) +/* + * NOTE: VarHashCreateVar increments the recount of its key argument. + * All callers that will call Tcl_DecrRefCount on that argument must + * call Tcl_IncrRefCount on it before passing it in. This requirement + * can bubble up to callers of callers .... etc. + */ + static inline Var * VarHashCreateVar( TclVarHashTable *tablePtr, @@ -137,6 +144,30 @@ static const char *isArrayElement = #define HasLocalVars(framePtr) ((framePtr)->isProcCallFrame & FRAME_IS_PROC) /* + * The following structure describes an enumerative search in progress on an + * array variable; this are invoked with options to the "array" command. + */ + +typedef struct ArraySearch { + int id; /* Integer id used to distinguish among + * multiple concurrent searches for the same + * array. */ + struct Var *varPtr; /* Pointer to array variable that's being + * searched. */ + Tcl_HashSearch search; /* Info kept by the hash module about progress + * through the array. */ + Tcl_HashEntry *nextEntry; /* Non-null means this is the next element to + * be enumerated (it's leftover from the + * Tcl_FirstHashEntry call or from an "array + * anymore" command). NULL means must call + * Tcl_NextHashEntry to get value to + * return. */ + struct ArraySearch *nextPtr;/* Next in list of all active searches for + * this variable, or NULL if this is the last + * one. */ +} ArraySearch; + +/* * Forward references to functions defined later in this file: */ @@ -383,11 +414,12 @@ TclLookupVar( * address of array variable. Otherwise this * is set to NULL. */ { - Tcl_Obj *part1Ptr; Var *varPtr; + Tcl_Obj *part1Ptr = Tcl_NewStringObj(part1, -1); - part1Ptr = Tcl_NewStringObj(part1, -1); - Tcl_IncrRefCount(part1Ptr); + if (createPart1) { + Tcl_IncrRefCount(part1Ptr); + } varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2, arrayPtrPtr); @@ -432,6 +464,8 @@ TclLookupVar( * are 1. The object part1Ptr is converted to one of localVarNameType, * tclNsVarNameType or tclParsedVarNameType and caches as much of the * lookup as it can. + * When createPart1 is 1, callers must IncrRefCount part1Ptr if they + * plan to DecrRefCount it. * *---------------------------------------------------------------------- */ @@ -460,14 +494,14 @@ TclObjLookupVar( * address of array variable. Otherwise this * is set to NULL. */ { - Tcl_Obj *part2Ptr; + Tcl_Obj *part2Ptr = NULL; Var *resPtr; if (part2) { part2Ptr = Tcl_NewStringObj(part2, -1); - Tcl_IncrRefCount(part2Ptr); - } else { - part2Ptr = NULL; + if (createPart2) { + Tcl_IncrRefCount(part2Ptr); + } } resPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, @@ -480,6 +514,12 @@ TclObjLookupVar( return resPtr; } +/* + * When createPart1 is 1, callers must IncrRefCount part1Ptr if they + * plan to DecrRefCount it. + * When createPart2 is 1, callers must IncrRefCount part2Ptr if they + * plan to DecrRefCount it. + */ Var * TclObjLookupVarEx( Tcl_Interp *interp, /* Interpreter to use for lookup. */ @@ -620,7 +660,9 @@ TclObjLookupVarEx( part2 = newPart2 = part1Ptr->internalRep.twoPtrValue.ptr2; if (newPart2) { part2Ptr = Tcl_NewStringObj(newPart2, -1); - Tcl_IncrRefCount(part2Ptr); + if (createPart2) { + Tcl_IncrRefCount(part2Ptr); + } } part1Ptr = part1Ptr->internalRep.twoPtrValue.ptr1; typePtr = part1Ptr->typePtr; @@ -666,7 +708,9 @@ TclObjLookupVarEx( *(newPart2+len2) = '\0'; part2 = newPart2; part2Ptr = Tcl_NewStringObj(newPart2, -1); - Tcl_IncrRefCount(part2Ptr); + if (createPart2) { + Tcl_IncrRefCount(part2Ptr); + } /* * Free the internal rep of the original part1Ptr, now renamed @@ -847,6 +891,7 @@ TclObjLookupVarEx( * * Side effects: * A new hashtable entry may be created if create is 1. + * Callers must Incr varNamePtr if they plan to Decr it if create is 1. * *---------------------------------------------------------------------- */ @@ -1075,6 +1120,8 @@ TclLookupSimpleVar( * The variable at arrayPtr may be converted to be an array if * createPart1 is 1. A new hashtable entry may be created if createPart2 * is 1. + * When createElem is 1, callers must incr elNamePtr if they plan + * to decr it. * *---------------------------------------------------------------------- */ @@ -1200,6 +1247,7 @@ TclLookupArrayElement( *---------------------------------------------------------------------- */ +#undef Tcl_GetVar const char * Tcl_GetVar( Tcl_Interp *interp, /* Command interpreter in which varName is to @@ -1209,11 +1257,9 @@ Tcl_GetVar( * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG * bits. */ { - Tcl_Obj *varNamePtr, *resultPtr; + Tcl_Obj *varNamePtr = Tcl_NewStringObj(varName, -1); + Tcl_Obj *resultPtr = Tcl_ObjGetVar2(interp, varNamePtr, NULL, flags); - varNamePtr = Tcl_NewStringObj(varName, -1); - Tcl_IncrRefCount(varNamePtr); - resultPtr = Tcl_ObjGetVar2(interp, varNamePtr, NULL, flags); TclDecrRefCount(varNamePtr); if (resultPtr == NULL) { @@ -1257,15 +1303,12 @@ Tcl_GetVar2( * TCL_NAMESPACE_ONLY and TCL_LEAVE_ERR_MSG * * bits. */ { - Tcl_Obj *resultPtr, *part1Ptr, *part2Ptr; + Tcl_Obj *resultPtr; + Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1); - part1Ptr = Tcl_NewStringObj(part1, -1); - Tcl_IncrRefCount(part1Ptr); if (part2) { part2Ptr = Tcl_NewStringObj(part2, -1); Tcl_IncrRefCount(part2Ptr); - } else { - part2Ptr = NULL; } resultPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags); @@ -1314,15 +1357,11 @@ Tcl_GetVar2Ex( int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ { - Tcl_Obj *part1Ptr, *part2Ptr, *resPtr; + Tcl_Obj *resPtr, *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1); - 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); @@ -1355,6 +1394,8 @@ Tcl_GetVar2Ex( * the returned reference; if you want to keep a reference to the object * you must increment its ref count yourself. * + * Callers must incr part2Ptr if they plan to decr it. + * *---------------------------------------------------------------------- */ @@ -1549,6 +1590,7 @@ Tcl_SetObjCmd( *---------------------------------------------------------------------- */ +#undef Tcl_SetVar const char * Tcl_SetVar( Tcl_Interp *interp, /* Command interpreter in which varName is to @@ -1560,17 +1602,13 @@ Tcl_SetVar( * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, * TCL_LEAVE_ERR_MSG. */ { - Tcl_Obj *valuePtr, *varNamePtr, *varValuePtr; + Tcl_Obj *varValuePtr, *varNamePtr = Tcl_NewStringObj(varName, -1); - varNamePtr = Tcl_NewStringObj(varName, -1); Tcl_IncrRefCount(varNamePtr); - valuePtr = Tcl_NewStringObj(newValue, -1); - Tcl_IncrRefCount(valuePtr); - - varValuePtr = Tcl_ObjSetVar2(interp, varNamePtr, NULL, valuePtr, flags); - + varValuePtr = Tcl_ObjSetVar2(interp, varNamePtr, NULL, + Tcl_NewStringObj(newValue, -1), flags); Tcl_DecrRefCount(varNamePtr); - Tcl_DecrRefCount(valuePtr); + if (varValuePtr == NULL) { return NULL; } @@ -1618,27 +1656,9 @@ Tcl_SetVar2( * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or * TCL_LEAVE_ERR_MSG. */ { - Tcl_Obj *valuePtr, *part1Ptr, *part2Ptr; - Tcl_Obj *varValuePtr; + Tcl_Obj *varValuePtr = Tcl_SetVar2Ex(interp, part1, part2, + Tcl_NewStringObj(newValue, -1), flags); - part1Ptr = Tcl_NewStringObj(part1, -1); - Tcl_IncrRefCount(part1Ptr); - if (part2 != NULL) { - part2Ptr = Tcl_NewStringObj(part2, -1); - Tcl_IncrRefCount(part2Ptr); - } else { - part2Ptr = NULL; - } - valuePtr = Tcl_NewStringObj(newValue, -1); - Tcl_IncrRefCount(valuePtr); - - varValuePtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, valuePtr, flags); - - Tcl_DecrRefCount(part1Ptr); - if (part2Ptr != NULL) { - Tcl_DecrRefCount(part2Ptr); - } - Tcl_DecrRefCount(valuePtr); if (varValuePtr == NULL) { return NULL; } @@ -1697,15 +1717,12 @@ Tcl_SetVar2Ex( * TCL_APPEND_VALUE, TCL_LIST_ELEMENT or * TCL_LEAVE_ERR_MSG. */ { - Tcl_Obj *part1Ptr, *part2Ptr, *resPtr; + Tcl_Obj *resPtr, *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1); - 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); @@ -1738,6 +1755,8 @@ Tcl_SetVar2Ex( * Side effects: * The value of the given variable is set. If either the array or the * entry didn't exist then a new variable is created. + * Callers must Incr part1Ptr if they plan to Decr it. + * Callers must Incr part2Ptr if they plan to Decr it. * *---------------------------------------------------------------------- */ @@ -2027,6 +2046,8 @@ TclPtrSetVar( * variable is created. The ref count for the returned object is _not_ * incremented to reflect the returned reference; if you want to keep a * reference to the object you must increment its ref count yourself. + * Callers must Incr part1Ptr if they plan to Decr it. + * Callers must Incr part2Ptr if they plan to Decr it. * *---------------------------------------------------------------------- */ @@ -2052,8 +2073,8 @@ TclIncrObjVar2( varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read", 1, 1, &arrayPtr); if (varPtr == NULL) { - Tcl_AddObjErrorInfo(interp, - "\n (reading value of variable to increment)", -1); + Tcl_AddErrorInfo(interp, + "\n (reading value of variable to increment)"); return NULL; } return TclPtrIncrObjVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, @@ -2109,8 +2130,7 @@ TclPtrIncrObjVar( * variable, or -1. Only used when part1Ptr is * NULL. */ { - register Tcl_Obj *varValuePtr, *newValuePtr = NULL; - int duplicated, code; + register Tcl_Obj *varValuePtr; if (TclIsVarInHash(varPtr)) { VarHashRefCount(varPtr)++; @@ -2124,19 +2144,33 @@ TclPtrIncrObjVar( varValuePtr = Tcl_NewIntObj(0); } if (Tcl_IsShared(varValuePtr)) { - duplicated = 1; + /* Copy on write */ varValuePtr = Tcl_DuplicateObj(varValuePtr); + + if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) { + return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, + varValuePtr, flags, index); + } else { + Tcl_DecrRefCount(varValuePtr); + return NULL; + } } else { - duplicated = 0; - } - code = TclIncrObj(interp, varValuePtr, incrPtr); - if (code == TCL_OK) { - newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, - part2Ptr, varValuePtr, flags, index); - } else if (duplicated) { - Tcl_DecrRefCount(varValuePtr); + /* Unshared - can Incr in place */ + if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) { + + /* + * This seems dumb to write the incremeted value into the var + * after we just adjusted the value in place, but the spec for + * [incr] requires that write traces fire, and making this call + * is the way to make that happen. + */ + + return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, + varValuePtr, flags, index); + } else { + return NULL; + } } - return newValuePtr; } /* @@ -2159,6 +2193,7 @@ TclPtrIncrObjVar( *---------------------------------------------------------------------- */ +#undef Tcl_UnsetVar int Tcl_UnsetVar( Tcl_Interp *interp, /* Command interpreter in which varName is to @@ -2219,13 +2254,10 @@ Tcl_UnsetVar2( * TCL_LEAVE_ERR_MSG. */ { int result; - Tcl_Obj *part1Ptr, *part2Ptr = NULL; + Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1); - part1Ptr = Tcl_NewStringObj(part1, -1); - Tcl_IncrRefCount(part1Ptr); if (part2) { part2Ptr = Tcl_NewStringObj(part2, -1); - Tcl_IncrRefCount(part2Ptr); } /* @@ -2841,6 +2873,7 @@ Tcl_LappendObjCmd( * * Side effects: * A variable will be created if one does not already exist. + * Callers must Incr arrayNameObj if they pland to Decr it. * *---------------------------------------------------------------------- */ @@ -3817,6 +3850,53 @@ ArrayNamesCmd( /* *---------------------------------------------------------------------- * + * TclFindArrayPtrElements -- + * + * Fill out a hash table (which *must* use Tcl_Obj* keys) with an entry + * for each existing element of the given array. The provided hash table + * is assumed to be initially empty. + * + * Result: + * none + * + * Side effects: + * The keys of the array gain an extra reference. The supplied hash table + * has elements added to it. + * + *---------------------------------------------------------------------- + */ + +void +TclFindArrayPtrElements( + Var *arrayPtr, + Tcl_HashTable *tablePtr) +{ + Var *varPtr; + Tcl_HashSearch search; + + if ((arrayPtr == NULL) || !TclIsVarArray(arrayPtr) + || TclIsVarUndefined(arrayPtr)) { + return; + } + + for (varPtr=VarHashFirstVar(arrayPtr->value.tablePtr, &search); + varPtr!=NULL ; varPtr=VarHashNextVar(&search)) { + Tcl_HashEntry *hPtr; + Tcl_Obj *nameObj; + int dummy; + + if (TclIsVarUndefined(varPtr)) { + continue; + } + nameObj = VarHashGetKey(varPtr); + hPtr = Tcl_CreateHashEntry(tablePtr, (char *) nameObj, &dummy); + Tcl_SetHashValue(hPtr, nameObj); + } +} + +/* + *---------------------------------------------------------------------- + * * ArraySetCmd -- * * This object-based function is invoked to process the "array set" Tcl @@ -4222,16 +4302,16 @@ TclInitArrayCmd( Tcl_Interp *interp) /* Current interpreter. */ { static const EnsembleImplMap arrayImplMap[] = { - {"anymore", ArrayAnyMoreCmd, NULL, NULL, NULL, 0}, - {"donesearch", ArrayDoneSearchCmd, NULL, NULL, NULL, 0}, + {"anymore", ArrayAnyMoreCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, + {"donesearch", ArrayDoneSearchCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"exists", ArrayExistsCmd, TclCompileArrayExistsCmd, NULL, NULL, 0}, - {"get", ArrayGetCmd, NULL, NULL, NULL, 0}, - {"names", ArrayNamesCmd, NULL, NULL, NULL, 0}, - {"nextelement", ArrayNextElementCmd, NULL, NULL, NULL, 0}, + {"get", ArrayGetCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, + {"names", ArrayNamesCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0}, + {"nextelement", ArrayNextElementCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"set", ArraySetCmd, TclCompileArraySetCmd, NULL, NULL, 0}, - {"size", ArraySizeCmd, NULL, NULL, NULL, 0}, - {"startsearch", ArrayStartSearchCmd, NULL, NULL, NULL, 0}, - {"statistics", ArrayStatsCmd, NULL, NULL, NULL, 0}, + {"size", ArraySizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"startsearch", ArrayStartSearchCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"statistics", ArrayStatsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"unset", ArrayUnsetCmd, TclCompileArrayUnsetCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; @@ -4255,6 +4335,8 @@ TclInitArrayCmd( * The variable given by myName is linked to the variable in framePtr * given by otherP1 and otherP2, so that references to myName are * redirected to the other variable like a symbolic link. + * Callers must Incr myNamePtr if they plan to Decr it. + * Callers must Incr otherP1Ptr if they plan to Decr it. * *---------------------------------------------------------------------- */ @@ -4363,14 +4445,12 @@ TclPtrMakeUpvar( int index) /* If the variable to be linked is an indexed * scalar, this is its index. Otherwise, -1 */ { - Tcl_Obj *myNamePtr; + Tcl_Obj *myNamePtr = NULL; int result; if (myName) { myNamePtr = Tcl_NewStringObj(myName, -1); Tcl_IncrRefCount(myNamePtr); - } else { - myNamePtr = NULL; } result = TclPtrObjMakeUpvar(interp, otherPtr, myNamePtr, myFlags, index); if (myNamePtr) { @@ -4379,6 +4459,8 @@ TclPtrMakeUpvar( return result; } +/* Callers must Incr myNamePtr if they plan to Decr it. */ + int TclPtrObjMakeUpvar( Tcl_Interp *interp, /* Interpreter containing variables. Used for @@ -4518,6 +4600,7 @@ TclPtrObjMakeUpvar( *---------------------------------------------------------------------- */ +#undef Tcl_UpVar int Tcl_UpVar( Tcl_Interp *interp, /* Command interpreter in which varName is to @@ -5111,7 +5194,8 @@ ParseSearchId( * Parse the id. */ - if (Tcl_ConvertToType(interp, handleObj, &tclArraySearchType) != TCL_OK) { + if ((handleObj->typePtr != &tclArraySearchType) + && (SetArraySearchObj(interp, handleObj) != TCL_OK)) { return NULL; } @@ -5242,8 +5326,6 @@ TclDeleteNamespaceVars( for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL; varPtr = VarHashFirstVar(tablePtr, &search)) { Tcl_Obj *objPtr = Tcl_NewObj(); - - Tcl_IncrRefCount(objPtr); VarHashRefCount(varPtr)++; /* Make sure we get to remove from * hash. */ Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr); @@ -5507,15 +5589,10 @@ TclVarErrMsg( * e.g. "read", "set", or "unset". */ const char *reason) /* String describing why operation failed. */ { - Tcl_Obj *part1Ptr = NULL, *part2Ptr = NULL; + Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1); - 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); @@ -5788,7 +5865,6 @@ Tcl_FindNamespaceVar( Tcl_Obj *namePtr = Tcl_NewStringObj(name, -1); Tcl_Var var; - Tcl_IncrRefCount(namePtr); var = ObjFindNamespaceVar(interp, namePtr, contextNsPtr, flags); Tcl_DecrRefCount(namePtr); return var; @@ -5883,7 +5959,6 @@ ObjFindNamespaceVar( varPtr = NULL; if (simpleName != name) { simpleNamePtr = Tcl_NewStringObj(simpleName, -1); - Tcl_IncrRefCount(simpleNamePtr); } else { simpleNamePtr = namePtr; } diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 9c1176e..9bceb4c 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -3111,7 +3111,7 @@ ZlibTransformOutput( e = deflate(&cd->outStream, Z_NO_FLUSH); produced = cd->outAllocated - cd->outStream.avail_out; - if (e == Z_OK && cd->outStream.avail_out > 0) { + if (e == Z_OK && produced > 0) { if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) < 0) { *errorCodePtr = Tcl_GetErrno(); return -1; @@ -3865,7 +3865,7 @@ TclZlibInit( cfg[0].key = "zlibVersion"; cfg[0].value = zlibVersion(); cfg[1].key = NULL; - Tcl_RegisterConfig(interp, "zlib", cfg, "ascii"); + Tcl_RegisterConfig(interp, "zlib", cfg, "iso8859-1"); /* * Formally provide the package as a Tcl built-in. @@ -3891,8 +3891,10 @@ Tcl_ZlibStreamInit( Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); - Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL); + if (interp) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); + Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL); + } return TCL_ERROR; } @@ -3957,8 +3959,10 @@ Tcl_ZlibDeflate( int level, Tcl_Obj *gzipHeaderDictObj) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); - Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL); + if (interp) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); + Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL); + } return TCL_ERROR; } @@ -3970,8 +3974,10 @@ Tcl_ZlibInflate( int bufferSize, Tcl_Obj *gzipHeaderDictObj) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); - Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL); + if (interp) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); + Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL); + } return TCL_ERROR; } diff --git a/library/auto.tcl b/library/auto.tcl index 4bd860d..02edcc4 100644 --- a/library/auto.tcl +++ b/library/auto.tcl @@ -20,8 +20,9 @@ # None. proc auto_reset {} { - if {[array exists ::auto_index]} { - foreach cmdName [array names ::auto_index] { + global auto_execs auto_index auto_path + if {[array exists auto_index]} { + foreach cmdName [array names auto_index] { set fqcn [namespace which $cmdName] if {$fqcn eq ""} { continue @@ -29,11 +30,11 @@ proc auto_reset {} { rename $fqcn {} } } - unset -nocomplain ::auto_execs ::auto_index ::tcl::auto_oldpath - if {[catch {llength $::auto_path}]} { - set ::auto_path [list [info library]] - } elseif {[info library] ni $::auto_path} { - lappend ::auto_path [info library] + unset -nocomplain auto_execs auto_index ::tcl::auto_oldpath + if {[catch {llength $auto_path}]} { + set auto_path [list [info library]] + } elseif {[info library] ni $auto_path} { + lappend auto_path [info library] } } @@ -53,7 +54,7 @@ proc auto_reset {} { proc tcl_findLibrary {basename version patch initScript enVarName varName} { upvar #0 $varName the_library - global env + global auto_path env tcl_platform set dirs {} set errors {} @@ -83,12 +84,10 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} { # 3. Relative to auto_path directories. This checks relative to the # Tcl library as well as allowing loading of libraries added to the # auto_path that is not relative to the core library or binary paths. - foreach d $::auto_path { + foreach d $auto_path { lappend dirs [file join $d $basename$version] - if { - $::tcl_platform(platform) eq "unix" - && $::tcl_platform(os) eq "Darwin" - } then { + if {$tcl_platform(platform) eq "unix" + && $tcl_platform(os) eq "Darwin"} { # 4. On MacOSX, check the Resources/Scripts subdir too lappend dirs [file join $d $basename$version Resources Scripts] } @@ -514,6 +513,32 @@ proc auto_mkindex_parser::fullname {name} { return [string map [list \0 \$] $name] } +# auto_mkindex_parser::indexEntry -- +# +# Used by commands like "proc" within the auto_mkindex parser to add a +# correctly-quoted entry to the index. This is shared code so it is done +# *right*, in one place. +# +# Arguments: +# name - Name that is being added to index. + +proc auto_mkindex_parser::indexEntry {name} { + variable index + variable scriptFile + + # We convert all metacharacters to their backslashed form, and pre-split + # the file name that we know about (which will be a proper list, and so + # correctly quoted). + + set name [string range [list \}[fullname $name]] 2 end] + set filenameParts [file split $scriptFile] + + append index [format \ + {set auto_index(%s) [list source [file join $dir %s]]%s} \ + $name $filenameParts \n] + return +} + if {[llength $::auto_mkindex_parser::initCommands]} { return } @@ -525,15 +550,7 @@ if {[llength $::auto_mkindex_parser::initCommands]} { # Adds an entry to the auto index list for the given procedure name. auto_mkindex_parser::command proc {name args} { - variable index - variable scriptFile - # Do some fancy reformatting on the "source" call to handle platform - # differences with respect to pathnames. Use format just so that the - # command is a little easier to read (otherwise it'd be full of - # backslashed dollar signs, etc. - append index [list set auto_index([fullname $name])] \ - [format { [list source [file join $dir %s]]} \ - [file split $scriptFile]] "\n" + indexEntry $name } # Conditionally add support for Tcl byte code files. There are some tricky @@ -560,14 +577,7 @@ auto_mkindex_parser::hook { # procedure name. auto_mkindex_parser::commandInit tbcload::bcproc {name args} { - variable index - variable scriptFile - # Do some nice reformatting of the "source" call, to get around - # path differences on different platforms. We use the format - # command just so that the code is a little easier to read. - append index [list set auto_index([fullname $name])] \ - [format { [list source [file join $dir %s]]} \ - [file split $scriptFile]] "\n" + indexEntry $name } } } @@ -606,6 +616,35 @@ auto_mkindex_parser::command namespace {op args} { } catch {$parser eval "_%@namespace import $args"} } + ensemble { + variable parser + variable contextStack + if {[lindex $args 0] eq "create"} { + set name ::[join [lreverse $contextStack] ::] + catch { + set name [dict get [lrange $args 1 end] -command] + if {![string match ::* $name]} { + set name ::[join [lreverse $contextStack] ::]$name + } + regsub -all ::+ $name :: name + } + # create artifical proc to force an entry in the tclIndex + $parser eval [list ::proc $name {} {}] + } + } + } +} + +# AUTO MKINDEX: oo::class create name ?definition? +# Adds an entry to the auto index list for the given class name. +auto_mkindex_parser::command oo::class {op name {body ""}} { + if {$op eq "create"} { + indexEntry $name + } +} +auto_mkindex_parser::command class {op name {body ""}} { + if {$op eq "create"} { + indexEntry $name } } diff --git a/library/clock.tcl b/library/clock.tcl index 0696c47..1e652b4 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -324,7 +324,7 @@ proc ::tcl::clock::Initialize {} { {-10800 0 3600 0 2 0 2 2 0 0 0 0 10 0 3 2 0 0 0} :America/Sao_Paulo {-10800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Godthab {-10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Buenos_Aires - {-10800 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Brasilia + {-10800 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Bahia {-10800 0 3600 0 3 0 2 2 0 0 0 0 10 0 1 2 0 0 0} :America/Montevideo {-7200 0 3600 0 9 0 5 2 0 0 0 0 3 0 5 2 0 0 0} :America/Noronha {-3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Atlantic/Azores @@ -3861,7 +3861,7 @@ proc ::tcl::clock::ProcessPosixTimeZone { z } { # Put DST in effect in all years from 1916 to 2099. - for { set y 1916 } { $y < 2099 } { incr y } { + for { set y 1916 } { $y < 2100 } { incr y } { set startTime [DeterminePosixDSTTime $z start $y] incr startTime [expr { - wide($stdOffset) }] set endTime [DeterminePosixDSTTime $z end $y] diff --git a/library/http/http.tcl b/library/http/http.tcl index d57e3ce..a6b2bfd 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -11,7 +11,7 @@ package require Tcl 8.6 # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles -package provide http 2.8.5 +package provide http 2.8.8 namespace eval http { # Allow resourcing to not clobber existing data @@ -113,7 +113,7 @@ if {[info command http::Log] eq {}} {proc http::Log {args} {}} proc http::register {proto port command} { variable urlTypes - set urlTypes($proto) [list $port $command] + set urlTypes([string tolower $proto]) [list $port $command] } # http::unregister -- @@ -127,11 +127,12 @@ proc http::register {proto port command} { proc http::unregister {proto} { variable urlTypes - if {![info exists urlTypes($proto)]} { + set lower [string tolower $proto] + if {![info exists urlTypes($lower)]} { return -code error "unsupported url type \"$proto\"" } - set old $urlTypes($proto) - unset urlTypes($proto) + set old $urlTypes($lower) + unset urlTypes($lower) return $old } @@ -394,13 +395,16 @@ proc http::geturl {url args} { # First, before the colon, is the protocol scheme (e.g. http) # Second, for HTTP-like protocols, is the authority # The authority is preceded by // and lasts up to (but not including) - # the following / and it identifies up to four parts, of which only one, - # the host, is required (if an authority is present at all). All other - # parts of the authority (user name, password, port number) are optional. + # the following / or ? and it identifies up to four parts, of which + # only one, the host, is required (if an authority is present at all). + # All other parts of the authority (user name, password, port number) + # are optional. # Third is the resource name, which is split into two parts at a ? # The first part (from the single "/" up to "?") is the path, and the # second part (from that "?" up to "#") is the query. *HOWEVER*, we do # not need to separate them; we send the whole lot to the server. + # Both, path and query are allowed to be missing, including their + # delimiting character. # Fourth is the fragment identifier, which is everything after the first # "#" in the URL. The fragment identifier MUST NOT be sent to the server # and indeed, we don't bother to validate it (it could be an error to @@ -437,7 +441,7 @@ proc http::geturl {url args} { ) (?: : (\d+) )? # <port part of authority> )? - ( / [^\#]*)? # <path> (including query) + ( [/\?] [^\#]*)? # <path> (including query) (?: \# (.*) )? # <fragment> $ } @@ -481,6 +485,12 @@ proc http::geturl {url args} { } } if {$srvurl ne ""} { + # RFC 3986 allows empty paths (not even a /), but servers + # return 400 if the path in the HTTP request doesn't start + # with / , so add it here if needed. + if {[string index $srvurl 0] ne "/"} { + set srvurl /$srvurl + } # Check for validity according to RFC 3986, Appendix A set validityRE {(?xi) ^ @@ -505,12 +515,13 @@ proc http::geturl {url args} { if {$proto eq ""} { set proto http } - if {![info exists urlTypes($proto)]} { + set lower [string tolower $proto] + if {![info exists urlTypes($lower)]} { unset $token return -code error "Unsupported URL type \"$proto\"" } - set defport [lindex $urlTypes($proto) 0] - set defcmd [lindex $urlTypes($proto) 1] + set defport [lindex $urlTypes($lower) 0] + set defcmd [lindex $urlTypes($lower) 1] if {$port eq ""} { set port $defport @@ -537,11 +548,10 @@ proc http::geturl {url args} { # If a timeout is specified we set up the after event and arrange for an # asynchronous socket connection. - set sockopts [list] + set sockopts [list -async] if {$state(-timeout) > 0} { set state(after) [after $state(-timeout) \ [list http::reset $token timeout]] - lappend sockopts -async } # If we are using the proxy, we must pass in the full URL that includes @@ -597,10 +607,15 @@ proc http::geturl {url args} { set socketmap($state(socketinfo)) $sock } - # Wait for the connection to complete. + if {![info exists phost]} { + set phost "" + } + fileevent $sock writable [list http::Connect $token $proto $phost $srvurl] - if {$state(-timeout) > 0} { - fileevent $sock writable [list http::Connect $token] + # Wait for the connection to complete. + if {![info exists state(-command)]} { + # geturl does EVERYTHING asynchronously, so if the user + # calls it synchronously, we just do a wait here. http::wait $token if {![info exists state]} { @@ -616,13 +631,30 @@ proc http::geturl {url args} { set err [lindex $state(error) 0] cleanup $token return -code error $err - } elseif {$state(status) ne "connect"} { - # Likely to be connection timeout - return $token } - set state(status) "" } + return $token +} + + +proc http::Connected { token proto phost srvurl} { + variable http + variable urlTypes + + variable $token + upvar 0 $token state + + # Set back the variables needed here + set sock $state(sock) + set isQueryChannel [info exists state(-querychannel)] + set isQuery [info exists state(-query)] + set host [lindex [split $state(socketinfo) :] 0] + set port [lindex [split $state(socketinfo) :] 1] + + set lower [string tolower $proto] + set defport [lindex $urlTypes($lower) 0] + # Send data in cr-lf format, but accept any line terminators fconfigure $sock -translation {auto crlf} -buffersize $state(-blocksize) @@ -753,35 +785,17 @@ proc http::geturl {url args} { fileevent $sock readable [list http::Event $sock $token] } - if {![info exists state(-command)]} { - # geturl does EVERYTHING asynchronously, so if the user calls it - # synchronously, we just do a wait here. - - wait $token - if {$state(status) eq "error"} { - # Something went wrong, so throw the exception, and the - # enclosing catch will do cleanup. - return -code error [lindex $state(error) 0] - } - } } err]} { # The socket probably was never connected, or the connection dropped # later. - # Clean up after events and such, but DON'T call the command callback - # (if available) because we're going to throw an exception from here - # instead. - # if state(status) is error, it means someone's already called Finish # to do the above-described clean up. if {$state(status) ne "error"} { - Finish $token $err 1 + Finish $token $err } - cleanup $token - return -code error $err } - return $token } # Data access functions: @@ -865,7 +879,7 @@ proc http::cleanup {token} { # Sets the status of the connection, which unblocks # the waiting geturl call -proc http::Connect {token} { +proc http::Connect {token proto phost srvurl} { variable $token upvar 0 $token state set err "due to unexpected EOF" @@ -873,10 +887,10 @@ proc http::Connect {token} { [eof $state(sock)] || [set err [fconfigure $state(sock) -error]] ne "" } { - Finish $token "connect failed $err" 1 + Finish $token "connect failed $err" } else { - set state(status) connect fileevent $state(sock) writable {} + ::http::Connected $token $proto $phost $srvurl } return } @@ -981,7 +995,7 @@ proc http::Event {sock token} { } elseif {$n == 0} { # We have now read all headers # We ignore HTTP/1.1 100 Continue returns. RFC2616 sec 8.2.3 - if {$state(http) == "" || [lindex $state(http) 1] == 100} { + if {$state(http) == "" || ([regexp {^\S+\s(\d+)} $state(http) {} x] && $x == 100)} { return } @@ -1379,7 +1393,7 @@ proc http::mapReply {string} { } set converted [string map $formMap $string] if {[string match "*\[\u0100-\uffff\]*" $converted]} { - regexp {[\u0100-\uffff]} $converted badChar + regexp "\[\u0100-\uffff\]" $converted badChar # Return this error message for maximum compatability... :^/ return -code error \ "can't read \"formMap($badChar)\": no such element in array" diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index 303d3bd..27ba795 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -1,2 +1,2 @@ if {![package vsatisfies [package provide Tcl] 8.6]} {return} -package ifneeded http 2.8.5 [list tclPkgSetup $dir http 2.8.5 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] +package ifneeded http 2.8.8 [list tclPkgSetup $dir http 2.8.8 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] diff --git a/library/init.tcl b/library/init.tcl index e836df9..f63eedf 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -12,10 +12,11 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # +# This test intentionally written in pre-7.5 Tcl if {[info commands package] == ""} { error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" } -package require -exact Tcl 8.6.0 +package require -exact Tcl 8.6.1 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: @@ -116,9 +117,10 @@ namespace eval tcl { if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} { namespace eval tcl { proc EnvTraceProc {lo n1 n2 op} { - set x $::env($n2) - set ::env($lo) $x - set ::env([string toupper $lo]) $x + global env + set x $env($n2) + set env($lo) $x + set env([string toupper $lo]) $x } proc InitWinEnv {} { global env tcl_platform @@ -128,9 +130,9 @@ if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} { switch -- $u { COMSPEC - PATH { - if {![info exists env($u)]} { - set env($u) $env($p) - } + set temp $env($p) + unset env($p) + set env($u) $temp trace add variable env($p) write \ [namespace code [list EnvTraceProc $p]] trace add variable env($u) write \ @@ -140,11 +142,7 @@ if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} { } } if {![info exists env(COMSPEC)]} { - if {$tcl_platform(os) eq "Windows NT"} { - set env(COMSPEC) cmd.exe - } else { - set env(COMSPEC) command.com - } + set env(COMSPEC) cmd.exe } } InitWinEnv @@ -159,8 +157,8 @@ if {[interp issafe]} { } else { # Set up search for Tcl Modules (TIP #189). # and setup platform specific unknown package handlers - if {$::tcl_platform(os) eq "Darwin" - && $::tcl_platform(platform) eq "unix"} { + if {$tcl_platform(os) eq "Darwin" + && $tcl_platform(platform) eq "unix"} { package unknown {::tcl::tm::UnknownHandler \ {::tcl::MacOSXPkgUnknown ::tclPkgUnknown}} } else { @@ -233,14 +231,13 @@ if {[namespace which -command tclLog] eq ""} { proc unknown args { variable ::tcl::UnknownPending - global auto_noexec auto_noload env tcl_interactive - + global auto_noexec auto_noload env tcl_interactive errorInfo errorCode - if {[info exists ::errorInfo]} { - set savedErrorInfo $::errorInfo + if {[info exists errorInfo]} { + set savedErrorInfo $errorInfo } - if {[info exists ::errorCode]} { - set savedErrorCode $::errorCode + if {[info exists errorCode]} { + set savedErrorCode $errorCode } set name [lindex $args 0] @@ -271,9 +268,9 @@ proc unknown args { unset -nocomplain ::errorCode } if {[info exists savedErrorInfo]} { - set ::errorInfo $savedErrorInfo + set errorInfo $savedErrorInfo } else { - unset -nocomplain ::errorInfo + unset -nocomplain errorInfo } set code [catch {uplevel 1 $args} msg opts] if {$code == 1} { @@ -282,8 +279,8 @@ proc unknown args { # Note the dependence on how Tcl_AddErrorInfo, etc. # construct the stack trace. # - set errorInfo [dict get $opts -errorinfo] - set errorCode [dict get $opts -errorcode] + set errInfo [dict get $opts -errorinfo] + set errCode [dict get $opts -errorcode] set cinfo $args if {[string bytelength $cinfo] > 150} { set cinfo [string range $cinfo 0 150] @@ -300,7 +297,7 @@ proc unknown args { # and trim the extra contribution from the matching case # set expect "$msg\n while executing\n\"$cinfo" - if {$errorInfo eq $expect} { + if {$errInfo eq $expect} { # # The stack has only the eval from the expanded command # Do not generate any stack trace here. @@ -315,18 +312,18 @@ proc unknown args { # set expect "\n invoked from within\n\"$cinfo" set exlen [string length $expect] - set eilen [string length $errorInfo] + set eilen [string length $errInfo] set i [expr {$eilen - $exlen - 1}] - set einfo [string range $errorInfo 0 $i] + set einfo [string range $errInfo 0 $i] # - # For now verify that $errorInfo consists of what we are about + # For now verify that $errInfo consists of what we are about # to return plus what we expected to trim off. # - if {$errorInfo ne "$einfo$expect"} { + if {$errInfo ne "$einfo$expect"} { error "Tcl bug: unexpected stack trace in \"unknown\"" {} \ - [list CORE UNKNOWN BADTRACE $einfo $expect $errorInfo] + [list CORE UNKNOWN BADTRACE $einfo $expect $errInfo] } - return -code error -errorcode $errorCode \ + return -code error -errorcode $errCode \ -errorinfo $einfo $msg } else { dict incr opts -level @@ -335,7 +332,7 @@ proc unknown args { } } - if {([info level] == 1) && ([info script] eq "") \ + if {([info level] == 1) && ([info script] eq "") && [info exists tcl_interactive] && $tcl_interactive} { if {![info exists auto_noexec]} { set new [auto_execok $name] @@ -788,7 +785,7 @@ proc tcl::CopyDirectory {action src dest} { lappend existing {*}[glob -nocomplain -directory $dest \ -type hidden * .*] foreach s $existing { - if {([file tail $s] ne ".") && ([file tail $s] ne "..")} { + if {[file tail $s] ni {. ..}} { return -code error "error $action \"$src\" to\ \"$dest\": file already exists" } @@ -796,7 +793,7 @@ proc tcl::CopyDirectory {action src dest} { } } else { if {[string first $nsrc $ndest] != -1} { - set srclen [expr {[llength [file split $nsrc]] -1}] + set srclen [expr {[llength [file split $nsrc]] - 1}] set ndest [lindex [file split $ndest] $srclen] if {$ndest eq [file tail $nsrc]} { return -code error "error $action \"$src\" to\ @@ -816,37 +813,9 @@ proc tcl::CopyDirectory {action src dest} { [glob -nocomplain -directory $src -types hidden *]] foreach s [lsort -unique $filelist] { - if {([file tail $s] ne ".") && ([file tail $s] ne "..")} { - file copy -force $s [file join $dest [file tail $s]] + if {[file tail $s] ni {. ..}} { + file copy -force -- $s [file join $dest [file tail $s]] } } return } - -# TIP 131 -if 0 { -proc tcl::rmmadwiw {} { - set magic { - 42 83 fe f6 ff f8 f1 e5 c6 f9 eb fd ff fb f1 e5 cc f5 ec f5 e3 fd fe - ff f5 fa f3 e1 c7 f9 f2 fd ff f9 fe f9 ed f4 fa f6 e6 f9 f2 e6 fd f9 - ff f9 f6 e6 fa fd ff fc fb fc f9 f1 ed - } - foreach mystic [lassign $magic tragic] { - set comic [expr (0x$mystic ^ 0x$tragic) - 255 + 0x$tragic] - append logic [format %x $comic] - set tragic $mystic - } - binary format H* $logic -} - -proc tcl::mathfunc::rmmadwiw {} { - set age [expr {9*6}] - set mind "" - while {$age} { - lappend mind [expr {$age%13}] - set age [expr {$age/13}] - } - set matter [lreverse $mind] - return [join $matter ""] -} -} diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 112507a..cf3b9d7 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -13,7 +13,7 @@ package require Tcl 8.5 # When the version number changes, be sure to update the pkgIndex.tcl file, # and the installation directory in the Makefiles. -package provide msgcat 1.5.0 +package provide msgcat 1.5.2 namespace eval msgcat { namespace export mc mcload mclocale mcmax mcmset mcpreferences mcset \ @@ -287,7 +287,7 @@ proc msgcat::mcload {langdir} { } set x 0 foreach p [mcpreferences] { - if { $p eq {} } { + if {$p eq {}} { set p ROOT } set langfile [file join $langdir $p.msg] @@ -374,7 +374,7 @@ proc msgcat::mcflset {src {dest ""}} { # Results: # Returns the number of pairs processed -proc msgcat::mcmset {locale pairs } { +proc msgcat::mcmset {locale pairs} { variable Msgs set length [llength $pairs] @@ -541,8 +541,11 @@ proc msgcat::Init {} { # settings, or fall back on locale of "C". # - # First check registry value LocalName present from Windows Vista - # which contains the local string as RFC5646, composed of: + # On Vista and later: + # HCU/Control Panel/Desktop : PreferredUILanguages is for language packs, + # HCU/Control Pannel/International : localName is the default locale. + # + # They contain the local string as RFC5646, composed of: # [a-z]{2,3} : language # -[a-z]{4} : script (optional, translated by table Latn->latin) # -[a-z]{2}|[0-9]{3} : territory (optional, numerical region codes not used) @@ -550,26 +553,25 @@ proc msgcat::Init {} { # Those are translated to local strings. # Examples: de-CH -> de_ch, sr-Latn-CS -> sr_cs@latin, es-419 -> es # - set key {HKEY_CURRENT_USER\Control Panel\International} - if {([registry values $key "LocaleName"] ne "") - && [regexp {^([a-z]{2,3})(?:-([a-z]{4}))?(?:-([a-z]{2}))?(?:-.+)?$}\ - [string tolower [registry get $key "LocaleName"]] match locale\ - script territory]} { - if {"" ne $territory} { - append locale _ $territory - } - set modifierDict [dict create latn latin cyrl cyrillic] - if {[dict exists $modifierDict $script]} { - append locale @ [dict get $modifierDict $script] - } - if {![catch { - mclocale [ConvertLocale $locale] - }]} { - return + foreach key {{HKEY_CURRENT_USER\Control Panel\Desktop} {HKEY_CURRENT_USER\Control Panel\International}}\ + value {PreferredUILanguages localeName} { + if {![catch {registry get $key $value} localeName] + && [regexp {^([a-z]{2,3})(?:-([a-z]{4}))?(?:-([a-z]{2}))?(?:-.+)?$}\ + [string tolower $localeName] match locale script territory]} { + if {"" ne $territory} { + append locale _ $territory + } + set modifierDict [dict create latn latin cyrl cyrillic] + if {[dict exists $modifierDict $script]} { + append locale @ [dict get $modifierDict $script] + } + if {![catch {mclocale [ConvertLocale $locale]}]} { + return + } } } - # then check key locale which contains a numerical language ID + # then check value locale which contains a numerical language ID if {[catch { set locale [registry get $key "locale"] }]} { diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl index 832bf81..5fabfe3 100644 --- a/library/msgcat/pkgIndex.tcl +++ b/library/msgcat/pkgIndex.tcl @@ -1,2 +1,2 @@ if {![package vsatisfies [package provide Tcl] 8.5]} {return} -package ifneeded msgcat 1.5.0 [list source [file join $dir msgcat.tcl]] +package ifneeded msgcat 1.5.2 [list source [file join $dir msgcat.tcl]] diff --git a/library/package.tcl b/library/package.tcl index c30431c..52daa0e 100644 --- a/library/package.tcl +++ b/library/package.tcl @@ -395,9 +395,7 @@ proc pkg_mkIndex {args} { foreach pkg [lsort [array names files]] { set cmd {} - foreach {name version} $pkg { - break - } + lassign $pkg name version lappend cmd ::tcl::Pkg::Create -name $name -version $version foreach spec [lsort -index 0 $files($pkg)] { foreach {file type procs} $spec { @@ -544,8 +542,7 @@ proc tclPkgUnknown {name args} { # Don't add directories we've already seen, or ones already on the # $use_path. foreach dir [lrange $auto_path $index end] { - if {![info exists tclSeenPath($dir)] - && ([lsearch -exact $use_path $dir] == -1) } { + if {![info exists tclSeenPath($dir)] && ($dir ni $use_path)} { lappend use_path $dir } } @@ -628,8 +625,7 @@ proc tcl::MacOSXPkgUnknown {original name args} { # Don't add directories we've already seen, or ones already on the # $use_path. foreach dir [lrange $auto_path $index end] { - if {![info exists tclSeenPath($dir)] - && ([lsearch -exact $use_path $dir] == -1) } { + if {![info exists tclSeenPath($dir)] && ($dir ni $use_path)} { lappend use_path $dir } } @@ -681,10 +677,7 @@ proc ::tcl::Pkg::Create {args} { } # Initialize parameters - set opts(-name) {} - set opts(-version) {} - set opts(-source) {} - set opts(-load) {} + array set opts {-name {} -version {} -source {} -load {}} # process parameters for {set i 0} {$i < $len} {incr i} { @@ -732,14 +725,9 @@ proc ::tcl::Pkg::Create {args} { # Handle -load and -source specs foreach key {load source} { foreach filespec $opts(-$key) { - foreach {filename proclist} {{} {}} { - break - } - foreach {filename proclist} $filespec { - break - } - - if {![llength $proclist]} { + lassign $filespec filename proclist + + if { [llength $proclist] == 0 } { set cmd "\[list $key \[file join \$dir [list $filename]\]\]" lappend cmdList $cmd } else { diff --git a/library/parray.tcl b/library/parray.tcl index 3ce9817..a9c2cb1 100644 --- a/library/parray.tcl +++ b/library/parray.tcl @@ -11,7 +11,7 @@ proc parray {a {pattern *}} { upvar 1 $a array if {![array exists array]} { - error "\"$a\" isn't an array" + return -code error "\"$a\" isn't an array" } set maxl 0 set names [lsort [array names array $pattern]] diff --git a/library/platform/pkgIndex.tcl b/library/platform/pkgIndex.tcl index 220a67b..23a3408 100644 --- a/library/platform/pkgIndex.tcl +++ b/library/platform/pkgIndex.tcl @@ -1,3 +1,3 @@ -package ifneeded platform 1.0.10 [list source [file join $dir platform.tcl]] +package ifneeded platform 1.0.12 [list source [file join $dir platform.tcl]] package ifneeded platform::shell 1.1.4 [list source [file join $dir shell.tcl]] diff --git a/library/platform/platform.tcl b/library/platform/platform.tcl index dd2e66b..5698425 100644 --- a/library/platform/platform.tcl +++ b/library/platform/platform.tcl @@ -256,7 +256,7 @@ proc ::platform::LibcVersion {base _->_ vv} { if {![catch { set vdata [lindex [split [exec $libc] \n] 0] }]} { - regexp {([0-9]+(\.[0-9]+)*)} $vdata -> v + regexp {version ([0-9]+(\.[0-9]+)*)} $vdata -> v foreach {major minor} [split $v .] break set v glibc${major}.${minor} return 1 @@ -368,7 +368,7 @@ proc ::platform::patterns {id} { # ### ### ### ######### ######### ######### ## Ready -package provide platform 1.0.10 +package provide platform 1.0.12 # ### ### ### ######### ######### ######### ## Demo application diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl index 4b0a9bc..c99ad2a 100644 --- a/library/tcltest/pkgIndex.tcl +++ b/library/tcltest/pkgIndex.tcl @@ -9,4 +9,4 @@ # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.5]} {return} -package ifneeded tcltest 2.3.5 [list source [file join $dir tcltest.tcl]] +package ifneeded tcltest 2.3.7 [list source [file join $dir tcltest.tcl]] diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 83ec9d3..4b94312 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -22,7 +22,7 @@ namespace eval tcltest { # When the version number changes, be sure to update the pkgIndex.tcl file, # and the install directory in the Makefiles. When the minor version # changes (new feature) be sure to update the man page as well. - variable Version 2.3.5 + variable Version 2.3.7 # Compatibility support for dumb variables defined in tcltest 1 # Do not use these. Call [package provide Tcl] and [info patchlevel] @@ -84,7 +84,7 @@ namespace eval tcltest { # None. # proc normalizePath {pathVar} { - upvar $pathVar path + upvar 1 $pathVar path set oldpwd [pwd] catch {cd $path} set path [pwd] @@ -247,15 +247,15 @@ namespace eval tcltest { # Kept only for compatibility Default constraintsSpecified {} AcceptList - trace variable constraintsSpecified r {set ::tcltest::constraintsSpecified \ - [array names ::tcltest::testConstraints] ;# } + trace add variable constraintsSpecified read [namespace code { + set constraintsSpecified [array names testConstraints] ;#}] # tests that use threads need to know which is the main thread Default mainThread 1 variable mainThread - if {[info commands thread::id] != {}} { + if {[info commands thread::id] ne {}} { set mainThread [thread::id] - } elseif {[info commands testthread] != {}} { + } elseif {[info commands testthread] ne {}} { set mainThread [testthread id] } @@ -263,7 +263,7 @@ namespace eval tcltest { # Tcl tests is the working directory. Whenever this value changes # change to that directory. variable workingDirectory - trace variable workingDirectory w \ + trace add variable workingDirectory write \ [namespace code {cd $workingDirectory ;#}] Default workingDirectory [pwd] AcceptAbsolutePath @@ -277,7 +277,7 @@ namespace eval tcltest { # Set the location of the execuatble Default tcltest [info nameofexecutable] - trace variable tcltest w [namespace code {testConstraint stdio \ + trace add variable tcltest write [namespace code {testConstraint stdio \ [eval [ConstraintInitializer stdio]] ;#}] # save the platform information so it can be restored later @@ -404,11 +404,11 @@ namespace eval tcltest { # already there. set outdir [normalizePath [file dirname \ [file join [pwd] $filename]]] - if {[string equal $outdir [temporaryDirectory]]} { + if {$outdir eq [temporaryDirectory]} { variable filesExisted FillFilesExisted set filename [file tail $filename] - if {[lsearch -exact $filesExisted $filename] == -1} { + if {$filename ni $filesExisted} { lappend filesExisted $filename } } @@ -448,11 +448,11 @@ namespace eval tcltest { # already there. set outdir [normalizePath [file dirname \ [file join [pwd] $filename]]] - if {[string equal $outdir [temporaryDirectory]]} { + if {$outdir eq [temporaryDirectory]} { variable filesExisted FillFilesExisted set filename [file tail $filename] - if {[lsearch -exact $filesExisted $filename] == -1} { + if {$filename ni $filesExisted} { lappend filesExisted $filename } } @@ -534,7 +534,7 @@ namespace eval tcltest { } default { # Exact match trumps ambiguity - if {[lsearch -exact $match $option] >= 0} { + if {$option in $match} { return $option } set values [join [lrange $match 0 end-1] ", "] @@ -549,7 +549,8 @@ namespace eval tcltest { variable OptionControlledVariables foreach varName [concat $OptionControlledVariables Option] { variable $varName - trace variable $varName r [namespace code {ProcessCmdLineArgs ;#}] + trace add variable $varName read [namespace code { + ProcessCmdLineArgs ;#}] } } @@ -557,11 +558,11 @@ namespace eval tcltest { variable OptionControlledVariables foreach varName [concat $OptionControlledVariables Option] { variable $varName - foreach pair [trace vinfo $varName] { - foreach {op cmd} $pair break - if {[string equal r $op] - && [string match *ProcessCmdLineArgs* $cmd]} { - trace vdelete $varName $op $cmd + foreach pair [trace info variable $varName] { + lassign $pair op cmd + if {($op eq "read") && + [string match *ProcessCmdLineArgs* $cmd]} { + trace remove variable $varName $op $cmd } } } @@ -698,7 +699,7 @@ namespace eval tcltest { Option -constraints {} { Do not skip the listed constraints listed in -constraints. } AcceptList - trace variable Option(-constraints) w \ + trace add variable Option(-constraints) write \ [namespace code {SetSelectedConstraints ;#}] # Don't run only the "-constraint" specified tests by default @@ -707,7 +708,7 @@ namespace eval tcltest { variable testConstraints if {!$Option(-limitconstraints)} {return} foreach c [array names testConstraints] { - if {[lsearch -exact $Option(-constraints) $c] == -1} { + if {$c ni $Option(-constraints)} { testConstraint $c 0 } } @@ -715,7 +716,7 @@ namespace eval tcltest { Option -limitconstraints 0 { whether to run only tests with the constraints } AcceptBoolean limitConstraints - trace variable Option(-limitconstraints) w \ + trace add variable Option(-limitconstraints) write \ [namespace code {ClearUnselectedConstraints ;#}] # A test application has to know how to load the tested commands @@ -736,7 +737,7 @@ namespace eval tcltest { } set directory [AcceptDirectory $directory] if {![file writable $directory]} { - if {[string equal [workingDirectory] $directory]} { + if {[workingDirectory] eq $directory} { # Special exception: accept the default value # even if the directory is not writable return $directory @@ -750,7 +751,7 @@ namespace eval tcltest { Option -tmpdir [workingDirectory] { Save temporary files in the specified directory. } AcceptTemporaryDirectory temporaryDirectory - trace variable Option(-tmpdir) w \ + trace add variable Option(-tmpdir) write \ [namespace code {normalizePath Option(-tmpdir) ;#}] # Tests should not rely on the current working directory. @@ -759,17 +760,17 @@ namespace eval tcltest { Option -testdir [workingDirectory] { Search tests in the specified directory. } AcceptDirectory testsDirectory - trace variable Option(-testdir) w \ + trace add variable Option(-testdir) write \ [namespace code {normalizePath Option(-testdir) ;#}] proc AcceptLoadFile { file } { - if {[string equal "" $file]} {return $file} + if {$file eq {}} {return $file} set file [file join [temporaryDirectory] $file] return [AcceptReadable $file] } proc ReadLoadScript {args} { variable Option - if {[string equal "" $Option(-loadfile)]} {return} + if {$Option(-loadfile) eq {}} {return} set tmp [open $Option(-loadfile) r] loadScript [read $tmp] close $tmp @@ -777,7 +778,7 @@ namespace eval tcltest { Option -loadfile {} { Read the script to load the tested commands from the specified file. } AcceptLoadFile loadFile - trace variable Option(-loadfile) w [namespace code ReadLoadScript] + trace add variable Option(-loadfile) write [namespace code ReadLoadScript] proc AcceptOutFile { file } { if {[string equal stderr $file]} {return $file} @@ -789,14 +790,14 @@ namespace eval tcltest { Option -outfile stdout { Send output from test runs to the specified file. } AcceptOutFile outputFile - trace variable Option(-outfile) w \ + trace add variable Option(-outfile) write \ [namespace code {outputChannel $Option(-outfile) ;#}] # errors go to stderr by default Option -errfile stderr { Send errors from test runs to the specified file. } AcceptOutFile errorFile - trace variable Option(-errfile) w \ + trace add variable Option(-errfile) write \ [namespace code {errorChannel $Option(-errfile) ;#}] proc loadIntoSlaveInterpreter {slave args} { @@ -877,7 +878,7 @@ proc tcltest::DebugPArray {level arrayvar} { variable debug if {$debug >= $level} { - catch {upvar $arrayvar $arrayvar} + catch {upvar 1 $arrayvar $arrayvar} parray $arrayvar } return @@ -961,8 +962,7 @@ proc tcltest::testConstraint {constraint {value ""}} { if {[catch {expr {$value && $value}} msg]} { return -code error $msg } - if {[limitConstraints] - && [lsearch -exact $Option(-constraints) $constraint] == -1} { + if {[limitConstraints] && ($constraint ni $Option(-constraints))} { set value 0 } set testConstraints($constraint) $value @@ -986,11 +986,7 @@ proc tcltest::interpreter { {interp ""} } { if {[llength [info level 0]] == 1} { return $tcltest } - if {[string equal {} $interp]} { - set tcltest {} - } else { - set tcltest $interp - } + set tcltest $interp } ##################################################################### @@ -1055,7 +1051,7 @@ proc tcltest::PrintError {errorMsg} { [expr {80 - $InitialMsgLen}]]] puts [errorChannel] [string range $errorMsg 0 $beginningIndex] - while {![string equal end $beginningIndex]} { + while {$beginningIndex ne "end"} { puts -nonewline [errorChannel] \ [string repeat " " $InitialMsgLen] if {($endingIndex - $beginningIndex) @@ -1108,7 +1104,7 @@ proc tcltest::PrintError {errorMsg} { proc tcltest::SafeFetch {n1 n2 op} { variable testConstraints DebugPuts 3 "entering SafeFetch $n1 $n2 $op" - if {[string equal {} $n2]} {return} + if {$n2 eq {}} {return} if {![info exists testConstraints($n2)]} { if {[catch {testConstraint $n2 [eval [ConstraintInitializer $n2]]}]} { testConstraint $n2 0 @@ -1253,9 +1249,8 @@ proc tcltest::DefineConstraintInitializers {} { # are running as root on Unix. ConstraintInitializer root {expr \ - {[string equal unix $::tcl_platform(platform)] - && ([string equal root $::tcl_platform(user)] - || [string equal "" $::tcl_platform(user)])}} + {($::tcl_platform(platform) eq "unix") && + ($::tcl_platform(user) in {root {}})}} ConstraintInitializer notRoot {expr {![testConstraint root]}} # Set nonBlockFiles constraint: 1 means this platform supports @@ -1263,7 +1258,7 @@ proc tcltest::DefineConstraintInitializers {} { ConstraintInitializer nonBlockFiles { set code [expr {[catch {set f [open defs r]}] - || [catch {fconfigure $f -blocking off}]}] + || [catch {chan configure $f -blocking off}]}] catch {close $f} set code } @@ -1289,10 +1284,10 @@ proc tcltest::DefineConstraintInitializers {} { ConstraintInitializer unixExecs { set code 1 - if {[string equal macintosh $::tcl_platform(platform)]} { + if {$::tcl_platform(platform) eq "macintosh"} { set code 0 } - if {[string equal windows $::tcl_platform(platform)]} { + if {$::tcl_platform(platform) eq "windows"} { if {[catch { set file _tcl_test_remove_me.txt makeFile {hello} $file @@ -1386,7 +1381,7 @@ proc tcltest::Usage { {option ""} } { set allOpts [concat -help [Configure]] foreach opt $allOpts { set foo [Usage $opt] - foreach [list x type($opt) usage($opt)] $foo break + lassign $foo x type($opt) usage($opt) set line($opt) " $opt $type($opt) " set length($opt) [string length $line($opt)] if {$length($opt) > $max} {set max $length($opt)} @@ -1410,7 +1405,7 @@ proc tcltest::Usage { {option ""} } { append msg $u } return $msg\n - } elseif {[string equal -help $option]} { + } elseif {$option eq "-help"} { return [list -help "" "Display this usage information."] } else { set type [lindex [info args $Verify($option)] 0] @@ -1436,7 +1431,7 @@ proc tcltest::Usage { {option ""} } { proc tcltest::ProcessFlags {flagArray} { # Process -help first - if {[lsearch -exact $flagArray {-help}] != -1} { + if {"-help" in $flagArray} { PrintUsageInfo exit 1 } @@ -1445,14 +1440,14 @@ proc tcltest::ProcessFlags {flagArray} { RemoveAutoConfigureTraces } else { set args $flagArray - while {[llength $args]>1 && [catch {configure {*}$args} msg]} { + while {[llength $args] > 1 && [catch {configure {*}$args} msg]} { # Something went wrong parsing $args for tcltest options # Check whether the problem is "unknown option" if {[regexp {^unknown option (\S+):} $msg -> option]} { # Could be this is an option the Hook knows about set moreOptions [processCmdLineArgsAddFlagsHook] - if {[lsearch -exact $moreOptions $option] == -1} { + if {$option ni $moreOptions} { # Nope. Report the error, including additional options, # but keep going if {[llength $moreOptions]} { @@ -1471,7 +1466,7 @@ proc tcltest::ProcessFlags {flagArray} { # To recover, find that unknown option and remove up to it. # then retry - while {![string equal [lindex $args 0] $option]} { + while {[lindex $args 0] ne $option} { set args [lrange $args 2 end] } set args [lrange $args 2 end] @@ -1577,7 +1572,7 @@ proc tcltest::Replace::puts {args} { } 2 { # Either -nonewline or channelId has been specified - if {[string equal -nonewline [lindex $args 0]]} { + if {[lindex $args 0] eq "-nonewline"} { append outData [lindex $args end] return # return [Puts -nonewline [lindex $args end]] @@ -1587,7 +1582,7 @@ proc tcltest::Replace::puts {args} { } } 3 { - if {[string equal -nonewline [lindex $args 0]]} { + if {[lindex $args 0] eq "-nonewline"} { # Both -nonewline and channelId are specified, unless # it's an error. -nonewline is supposed to be argv[0]. set channel [lindex $args 1] @@ -1597,12 +1592,10 @@ proc tcltest::Replace::puts {args} { } if {[info exists channel]} { - if {[string equal $channel [[namespace parent]::outputChannel]] - || [string equal $channel stdout]} { + if {$channel in [list [[namespace parent]::outputChannel] stdout]} { append outData [lindex $args end]$newline return - } elseif {[string equal $channel [[namespace parent]::errorChannel]] - || [string equal $channel stderr]} { + } elseif {$channel in [list [[namespace parent]::errorChannel] stderr]} { append errData [lindex $args end]$newline return } @@ -1771,7 +1764,7 @@ proc tcltest::SubstArguments {argList} { set argList {} } - if {$token != {}} { + if {$token ne {}} { # If we saw a word with quote before, then there is a # multi-word token starting with that word. In this case, # add the text and the current word to this token. @@ -1878,10 +1871,7 @@ proc tcltest::test {name description args} { # Pre-define everything to null except output and errorOutput. We # determine whether or not to trap output based on whether or not # these variables (output & errorOutput) are defined. - foreach item {constraints setup cleanup body result returnCodes - match} { - set $item {} - } + lassign {} constraints setup cleanup body result returnCodes match # Set the default match mode set match exact @@ -1893,8 +1883,7 @@ proc tcltest::test {name description args} { # The old test format can't have a 3rd argument (constraints or # script) that starts with '-'. - if {[string match -* [lindex $args 0]] - || ([llength $args] <= 1)} { + if {[string match -* [lindex $args 0]] || ([llength $args] <= 1)} { if {[llength $args] == 1} { set list [SubstArguments [lindex $args 0]] foreach {element value} $list { @@ -1915,7 +1904,7 @@ proc tcltest::test {name description args} { -match -output -errorOutput -constraints} foreach flag [array names testAttributes] { - if {[lsearch -exact $validFlags $flag] == -1} { + if {$flag ni $validFlags} { incr testLevel -1 set sorted [lsort $validFlags] set options [join [lrange $sorted 0 end-1] ", "] @@ -1931,7 +1920,7 @@ proc tcltest::test {name description args} { # Check the values supplied for -match variable CustomMatch - if {[lsearch [array names CustomMatch] $match] == -1} { + if {$match ni [array names CustomMatch]} { incr testLevel -1 set sorted [lsort [array names CustomMatch]] set values [join [lrange $sorted 0 end-1] ", "] @@ -1995,7 +1984,7 @@ proc tcltest::test {name description args} { } else { set testResult [uplevel 1 [list [namespace origin Eval] $command 1]] } - foreach {actualAnswer returnCode} $testResult break + lassign $testResult actualAnswer returnCode if {$returnCode == 1} { set errorInfo(body) $::errorInfo set errorCode(body) $::errorCode @@ -2031,11 +2020,11 @@ proc tcltest::test {name description args} { if {([preserveCore] > 1) && ($coreFailure)} { append coreMsg "\nMoving file to:\ [file join [temporaryDirectory] core-$name]" - catch {file rename -force \ + catch {file rename -force -- \ [file join [workingDirectory] core] \ [file join [temporaryDirectory] core-$name] } msg - if {[string length $msg] > 0} { + if {$msg ne {}} { append coreMsg "\nError:\ Problem renaming core file: $msg" } @@ -2045,7 +2034,7 @@ proc tcltest::test {name description args} { # check if the return code matched the expected return code set codeFailure 0 - if {!$setupFailure && [lsearch -exact $returnCodes $returnCode] == -1} { + if {!$setupFailure && ($returnCode ni $returnCodes)} { set codeFailure 1 } @@ -2124,7 +2113,7 @@ proc tcltest::test {name description args} { set testFd [open $testFile r] set testLine [expr {[lsearch -regexp \ [split [read $testFd] "\n"] \ - "^\[ \t\]*test [string map {. \\.} $name] "]+1}] + "^\[ \t\]*test [string map {. \\.} $name] "] + 1}] close $testFd } } @@ -2169,7 +2158,7 @@ proc tcltest::test {name description args} { puts [outputChannel] "---- Return code should have been\ one of: $returnCodes" if {[IsVerbose error]} { - if {[info exists errorInfo(body)] && ([lsearch $returnCodes 1]<0)} { + if {[info exists errorInfo(body)] && (1 ni $returnCodes)} { puts [outputChannel] "---- errorInfo: $errorInfo(body)" puts [outputChannel] "---- errorCode: $errorCode(body)" } @@ -2250,7 +2239,7 @@ proc tcltest::Skipped {name constraints} { } return 1 } - if {[string equal {} $constraints]} { + if {$constraints eq {}} { # If we're limited to the listed constraints and there aren't # any listed, then we shouldn't run the test. if {[limitConstraints]} { @@ -2401,7 +2390,7 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} { foreach file $filesMade { if {[file exists $file]} { DebugDo 1 {Warn "cleanupTests deleting $file..."} - catch {file delete -force $file} + catch {file delete -force -- $file} } } set currentFiles {} @@ -2411,7 +2400,7 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} { } set newFiles {} foreach file $currentFiles { - if {[lsearch -exact $filesExisted $file] == -1} { + if {$file ni $filesExisted} { lappend newFiles $file } } @@ -2494,8 +2483,7 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} { # then add current file to failFile list if any tests in this # file failed - if {$currentFailure \ - && ([lsearch -exact $failFiles $testFileName] == -1)} { + if {$currentFailure && ($testFileName ni $failFiles)} { lappend failFiles $testFileName } set currentFailure false @@ -2510,17 +2498,15 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} { if {![info exists originalEnv($index)]} { lappend newEnv $index unset ::env($index) - } else { - if {$::env($index) != $originalEnv($index)} { - lappend changedEnv $index - set ::env($index) $originalEnv($index) - } } } foreach index [array names originalEnv] { if {![info exists ::env($index)]} { lappend removedEnv $index set ::env($index) $originalEnv($index) + } elseif {$::env($index) ne $originalEnv($index)} { + lappend changedEnv $index + set ::env($index) $originalEnv($index) } } if {[llength $newEnv] > 0} { @@ -2555,11 +2541,11 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} { puts [outputChannel] "produced core file! \ Moving file to: \ [file join [temporaryDirectory] core-$testFileName]" - catch {file rename -force \ + catch {file rename -force -- \ [file join [workingDirectory] core] \ [file join [temporaryDirectory] core-$testFileName] } msg - if {[string length $msg] > 0} { + if {$msg ne {}} { PrintError "Problem renaming file: $msg" } } else { @@ -2637,7 +2623,7 @@ proc tcltest::GetMatchingFiles { args } { # Add to result list all files in match list and not in skip list foreach file $matchFileList { - if {[lsearch -exact $skipFileList $file] == -1} { + if {$file ni $skipFileList} { lappend matchingFiles $file } } @@ -2684,7 +2670,7 @@ proc tcltest::GetMatchingDirectories {rootdir} { foreach pattern [matchDirectories] { foreach path [glob -directory $rootdir -types d -nocomplain -- \ $pattern] { - if {[lsearch -exact $skipDirs $path] == -1} { + if {$path ni $skipDirs} { set matchDirs [concat $matchDirs [GetMatchingDirectories $path]] if {[file exists [file join $path all.tcl]]} { lappend matchDirs $path @@ -2737,7 +2723,7 @@ proc tcltest::runAllTests { {shell ""} } { # [file system] first available in Tcl 8.4 if {![catch {file system [testsDirectory]} result] - && ![string equal native [lindex $result 0]]} { + && ([lindex $result 0] ne "native")} { # If we aren't running in the native filesystem, then we must # run the tests in a single process (via 'source'), because # trying to run then via a pipe will fail since the files don't @@ -2784,10 +2770,10 @@ proc tcltest::runAllTests { {shell ""} } { # needs to read and process output of children. set childargv [list] foreach opt [Configure] { - if {[string equal $opt -outfile]} {continue} + if {$opt eq "-outfile"} {continue} set value [Configure $opt] # Don't bother passing default configuration options - if {[string equal $value $DefaultValue($opt)]} { + if {$value eq $DefaultValue($opt)} { continue } lappend childargv $opt $value @@ -2880,11 +2866,6 @@ proc tcltest::runAllTests { {shell ""} } { # none. proc tcltest::loadTestedCommands {} { - variable l - if {[string equal {} [loadScript]]} { - return - } - return [uplevel 1 [loadScript]] } @@ -2927,16 +2908,15 @@ proc tcltest::saveState {} { proc tcltest::restoreState {} { variable saveState foreach p [uplevel 1 {::info procs}] { - if {([lsearch [lindex $saveState 0] $p] < 0) - && ![string equal [namespace current]::$p \ - [uplevel 1 [list ::namespace origin $p]]]} { + if {($p ni [lindex $saveState 0]) && ("[namespace current]::$p" ne + [uplevel 1 [list ::namespace origin $p]])} { DebugPuts 2 "[lindex [info level 0] 0]: Removing proc $p" uplevel 1 [list ::catch [list ::rename $p {}]] } } foreach p [uplevel 1 {::info vars}] { - if {[lsearch [lindex $saveState 1] $p] < 0} { + if {$p ni [lindex $saveState 1]} { DebugPuts 2 "[lindex [info level 0] 0]:\ Removing variable $p" uplevel 1 [list ::catch [list ::unset $p]] @@ -2997,15 +2977,15 @@ proc tcltest::makeFile {contents name {directory ""}} { putting ``$contents'' into $fullName" set fd [open $fullName w] - fconfigure $fd -translation lf - if {[string equal [string index $contents end] \n]} { + chan configure $fd -translation lf + if {[string index $contents end] eq "\n"} { puts -nonewline $fd $contents } else { puts $fd $contents } close $fd - if {[lsearch -exact $filesMade $fullName] == -1} { + if {$fullName ni $filesMade} { lappend filesMade $fullName } return $fullName @@ -3045,7 +3025,7 @@ proc tcltest::removeFile {name {directory ""}} { Warn "removeFile removing \"$fullName\":\n not a file" } } - return [file delete $fullName] + return [file delete -- $fullName] } # tcltest::makeDirectory -- @@ -3075,7 +3055,7 @@ proc tcltest::makeDirectory {name {directory ""}} { set fullName [file join $directory $name] DebugPuts 3 "[lindex [info level 0] 0]: creating $fullName" file mkdir $fullName - if {[lsearch -exact $filesMade $fullName] == -1} { + if {$fullName ni $filesMade} { lappend filesMade $fullName } return $fullName @@ -3116,7 +3096,7 @@ proc tcltest::removeDirectory {name {directory ""}} { Warn "removeDirectory removing \"$fullName\":\n not a directory" } } - return [file delete -force $fullName] + return [file delete -force -- $fullName] } # tcltest::viewFile -- @@ -3213,7 +3193,7 @@ proc tcltest::LeakFiles {old} { } set leak {} foreach p $new { - if {[lsearch $old $p] < 0} { + if {$p ni $old} { lappend leak $p } } @@ -3284,7 +3264,7 @@ proc tcltest::RestoreLocale {} { # proc tcltest::threadReap {} { - if {[info commands testthread] != {}} { + if {[info commands testthread] ne {}} { # testthread built into tcltest @@ -3304,7 +3284,7 @@ proc tcltest::threadReap {} { } testthread errorproc ThreadError return [llength [testthread names]] - } elseif {[info commands thread::id] != {}} { + } elseif {[info commands thread::id] ne {}} { # Thread extension @@ -3336,15 +3316,15 @@ namespace eval tcltest { # Set up the constraints in the testConstraints array to be lazily # initialized by a registered initializer, or by "false" if no # initializer is registered. - trace variable testConstraints r [namespace code SafeFetch] + trace add variable testConstraints read [namespace code SafeFetch] # Only initialize constraints at package load time if an # [initConstraintsHook] has been pre-defined. This is only # for compatibility support. The modern way to add a custom # test constraint is to just call the [testConstraint] command # straight away, without all this "hook" nonsense. - if {[string equal [namespace current] \ - [namespace qualifiers [namespace which initConstraintsHook]]]} { + if {[namespace current] eq + [namespace qualifiers [namespace which initConstraintsHook]]} { InitConstraints } else { proc initConstraintsHook {} {} @@ -3381,15 +3361,15 @@ namespace eval tcltest { proc LoadTimeCmdLineArgParsingRequired {} { set required false - if {[info exists ::argv] && [lsearch -exact $::argv -help] != -1} { + if {[info exists ::argv] && ("-help" in $::argv)} { # The command line asks for -help, so give it (and exit) # right now. ([configure] does not process -help) set required true } foreach hook { PrintUsageInfoHook processCmdLineArgsHook processCmdLineArgsAddFlagsHook } { - if {[string equal [namespace current] [namespace qualifiers \ - [namespace which $hook]]]} { + if {[namespace current] eq + [namespace qualifiers [namespace which $hook]]} { set required true } else { proc $hook args {} diff --git a/library/tm.tcl b/library/tm.tcl index ce8a013..55efda6 100644 --- a/library/tm.tcl +++ b/library/tm.tcl @@ -54,7 +54,7 @@ namespace eval ::tcl::tm { # Export the public API namespace export path - namespace ensemble create -command path -subcommand {add remove list} + namespace ensemble create -command path -subcommands {add remove list} } # ::tcl::tm::path implementations -- @@ -238,6 +238,15 @@ proc ::tcl::tm::UnknownHandler {original name args} { continue } + if {[package ifneeded $pkgname $pkgversion] ne {}} { + # There's already a provide script registered for + # this version of this package. Since all units of + # code claiming to be the same version of the same + # package ought to be identical, just stick with + # the one we already have. + continue + } + # We have found a candidate, generate a "provide script" # for it, and remember it. Note that we are using ::list # to do this; locally [list] means something else without @@ -260,10 +269,8 @@ proc ::tcl::tm::UnknownHandler {original name args} { # Otherwise we still have to fallback to the regular # package search to complete the processing. - if { - ($pkgname eq $name) && - [package vsatisfies $pkgversion {*}$args] - } then { + if {($pkgname eq $name) + && [package vsatisfies $pkgversion {*}$args]} { set satisfied 1 # We do not abort the loop, and keep adding provide @@ -347,7 +354,7 @@ proc ::tcl::tm::Defaults {} { # Calls 'path add' to paths to the list of module search paths. proc ::tcl::tm::roots {paths} { - foreach {major minor} [split [info tclversion] .] break + lassign [split [package present Tcl] .] major minor foreach pa $paths { set p [file join $pa tcl$major] for {set n $minor} {$n >= 0} {incr n -1} { diff --git a/library/tzdata/Africa/Cairo b/library/tzdata/Africa/Cairo index 165d8c4..842b7b2 100644 --- a/library/tzdata/Africa/Cairo +++ b/library/tzdata/Africa/Cairo @@ -1,8 +1,8 @@ # created by tools/tclZIC.tcl - do not edit set TZData(:Africa/Cairo) { - {-9223372036854775808 7500 0 LMT} - {-2185409100 7200 0 EET} + {-9223372036854775808 7509 0 LMT} + {-2185409109 7200 0 EET} {-929844000 10800 1 EEST} {-923108400 7200 0 EET} {-906170400 10800 1 EEST} diff --git a/library/tzdata/Africa/Casablanca b/library/tzdata/Africa/Casablanca index 41f8742..dec2778 100644 --- a/library/tzdata/Africa/Casablanca +++ b/library/tzdata/Africa/Casablanca @@ -34,177 +34,135 @@ set TZData(:Africa/Casablanca) { {1345428000 3600 1 WEST} {1348970400 0 0 WET} {1367114400 3600 1 WEST} - {1380420000 0 0 WET} - {1398564000 3600 1 WEST} - {1411869600 0 0 WET} - {1430013600 3600 1 WEST} - {1443319200 0 0 WET} - {1461463200 3600 1 WEST} - {1474768800 0 0 WET} - {1493517600 3600 1 WEST} - {1506218400 0 0 WET} - {1524967200 3600 1 WEST} - {1538272800 0 0 WET} - {1556416800 3600 1 WEST} - {1569722400 0 0 WET} - {1587866400 3600 1 WEST} - {1601172000 0 0 WET} - {1619316000 3600 1 WEST} - {1632621600 0 0 WET} - {1650765600 3600 1 WEST} - {1664071200 0 0 WET} - {1682820000 3600 1 WEST} - {1695520800 0 0 WET} - {1714269600 3600 1 WEST} - {1727575200 0 0 WET} - {1745719200 3600 1 WEST} - {1759024800 0 0 WET} - {1777168800 3600 1 WEST} - {1790474400 0 0 WET} - {1808618400 3600 1 WEST} - {1821924000 0 0 WET} - {1840672800 3600 1 WEST} - {1853373600 0 0 WET} - {1872122400 3600 1 WEST} - {1885428000 0 0 WET} - {1903572000 3600 1 WEST} - {1916877600 0 0 WET} - {1935021600 3600 1 WEST} - {1948327200 0 0 WET} - {1966471200 3600 1 WEST} - {1979776800 0 0 WET} - {1997920800 3600 1 WEST} - {2011226400 0 0 WET} - {2029975200 3600 1 WEST} - {2042676000 0 0 WET} - {2061424800 3600 1 WEST} - {2074730400 0 0 WET} - {2092874400 3600 1 WEST} - {2106180000 0 0 WET} - {2124324000 3600 1 WEST} - {2137629600 0 0 WET} - {2155773600 3600 1 WEST} - {2169079200 0 0 WET} - {2187223200 3600 1 WEST} - {2200528800 0 0 WET} - {2219277600 3600 1 WEST} - {2232583200 0 0 WET} - {2250727200 3600 1 WEST} - {2264032800 0 0 WET} - {2282176800 3600 1 WEST} - {2295482400 0 0 WET} - {2313626400 3600 1 WEST} - {2326932000 0 0 WET} - {2345076000 3600 1 WEST} - {2358381600 0 0 WET} - {2377130400 3600 1 WEST} - {2389831200 0 0 WET} - {2408580000 3600 1 WEST} - {2421885600 0 0 WET} - {2440029600 3600 1 WEST} - {2453335200 0 0 WET} - {2471479200 3600 1 WEST} - {2484784800 0 0 WET} - {2502928800 3600 1 WEST} - {2516234400 0 0 WET} - {2534378400 3600 1 WEST} - {2547684000 0 0 WET} - {2566432800 3600 1 WEST} - {2579133600 0 0 WET} - {2597882400 3600 1 WEST} - {2611188000 0 0 WET} - {2629332000 3600 1 WEST} - {2642637600 0 0 WET} - {2660781600 3600 1 WEST} - {2674087200 0 0 WET} - {2692231200 3600 1 WEST} - {2705536800 0 0 WET} - {2724285600 3600 1 WEST} - {2736986400 0 0 WET} - {2755735200 3600 1 WEST} - {2769040800 0 0 WET} - {2787184800 3600 1 WEST} - {2800490400 0 0 WET} - {2818634400 3600 1 WEST} - {2831940000 0 0 WET} - {2850084000 3600 1 WEST} - {2863389600 0 0 WET} - {2881533600 3600 1 WEST} - {2894839200 0 0 WET} - {2913588000 3600 1 WEST} - {2926288800 0 0 WET} - {2945037600 3600 1 WEST} - {2958343200 0 0 WET} - {2976487200 3600 1 WEST} - {2989792800 0 0 WET} - {3007936800 3600 1 WEST} - {3021242400 0 0 WET} - {3039386400 3600 1 WEST} - {3052692000 0 0 WET} - {3070836000 3600 1 WEST} - {3084141600 0 0 WET} - {3102890400 3600 1 WEST} - {3116196000 0 0 WET} - {3134340000 3600 1 WEST} - {3147645600 0 0 WET} - {3165789600 3600 1 WEST} - {3179095200 0 0 WET} - {3197239200 3600 1 WEST} - {3210544800 0 0 WET} - {3228688800 3600 1 WEST} - {3241994400 0 0 WET} - {3260743200 3600 1 WEST} - {3273444000 0 0 WET} - {3292192800 3600 1 WEST} - {3305498400 0 0 WET} - {3323642400 3600 1 WEST} - {3336948000 0 0 WET} - {3355092000 3600 1 WEST} - {3368397600 0 0 WET} - {3386541600 3600 1 WEST} - {3399847200 0 0 WET} - {3417991200 3600 1 WEST} - {3431296800 0 0 WET} - {3450045600 3600 1 WEST} - {3462746400 0 0 WET} - {3481495200 3600 1 WEST} - {3494800800 0 0 WET} - {3512944800 3600 1 WEST} - {3526250400 0 0 WET} - {3544394400 3600 1 WEST} - {3557700000 0 0 WET} - {3575844000 3600 1 WEST} - {3589149600 0 0 WET} - {3607898400 3600 1 WEST} - {3620599200 0 0 WET} - {3639348000 3600 1 WEST} - {3652653600 0 0 WET} - {3670797600 3600 1 WEST} - {3684103200 0 0 WET} - {3702247200 3600 1 WEST} - {3715552800 0 0 WET} - {3733696800 3600 1 WEST} - {3747002400 0 0 WET} - {3765146400 3600 1 WEST} - {3778452000 0 0 WET} - {3797200800 3600 1 WEST} - {3809901600 0 0 WET} - {3828650400 3600 1 WEST} - {3841956000 0 0 WET} - {3860100000 3600 1 WEST} - {3873405600 0 0 WET} - {3891549600 3600 1 WEST} - {3904855200 0 0 WET} - {3922999200 3600 1 WEST} - {3936304800 0 0 WET} - {3954448800 3600 1 WEST} - {3967754400 0 0 WET} - {3986503200 3600 1 WEST} - {3999808800 0 0 WET} - {4017952800 3600 1 WEST} - {4031258400 0 0 WET} - {4049402400 3600 1 WEST} - {4062708000 0 0 WET} - {4080852000 3600 1 WEST} - {4094157600 0 0 WET} + {1373162400 0 0 WET} + {1376100000 3600 1 WEST} + {1382839200 0 0 WET} + {1396144800 3600 1 WEST} + {1404007200 0 0 WET} + {1406599200 3600 1 WEST} + {1414288800 0 0 WET} + {1427594400 3600 1 WEST} + {1434592800 0 0 WET} + {1437184800 3600 1 WEST} + {1445738400 0 0 WET} + {1459044000 3600 1 WEST} + {1465264800 0 0 WET} + {1467856800 3600 1 WEST} + {1477792800 0 0 WET} + {1490493600 3600 1 WEST} + {1495850400 0 0 WET} + {1498442400 3600 1 WEST} + {1509242400 0 0 WET} + {1521943200 3600 1 WEST} + {1526436000 0 0 WET} + {1529028000 3600 1 WEST} + {1540692000 0 0 WET} + {1553997600 3600 1 WEST} + {1557108000 0 0 WET} + {1559700000 3600 1 WEST} + {1572141600 0 0 WET} + {1585447200 3600 1 WEST} + {1587693600 0 0 WET} + {1590285600 3600 1 WEST} + {1603591200 0 0 WET} + {1616896800 3600 1 WEST} + {1618279200 0 0 WET} + {1620871200 3600 1 WEST} + {1635645600 0 0 WET} + {1648346400 3600 1 WEST} + {1648951200 0 0 WET} + {1651543200 3600 1 WEST} + {1667095200 0 0 WET} + {1682128800 3600 1 WEST} + {1698544800 0 0 WET} + {1712714400 3600 1 WEST} + {1729994400 0 0 WET} + {1743386400 3600 1 WEST} + {1761444000 0 0 WET} + {1774749600 3600 1 WEST} + {1792893600 0 0 WET} + {1806199200 3600 1 WEST} + {1824948000 0 0 WET} + {1837648800 3600 1 WEST} + {1856397600 0 0 WET} + {1869098400 3600 1 WEST} + {1887847200 0 0 WET} + {1901152800 3600 1 WEST} + {1919296800 0 0 WET} + {1932602400 3600 1 WEST} + {1950746400 0 0 WET} + {1964052000 3600 1 WEST} + {1982800800 0 0 WET} + {1995501600 3600 1 WEST} + {2014250400 0 0 WET} + {2026951200 3600 1 WEST} + {2045700000 0 0 WET} + {2058400800 3600 1 WEST} + {2077149600 0 0 WET} + {2090455200 3600 1 WEST} + {2108167200 0 0 WET} + {2121904800 3600 1 WEST} + {2138839200 0 0 WET} + {2153354400 3600 1 WEST} + {2184800400 3600 1 WEST} + {2216250000 3600 1 WEST} + {2248304400 3600 1 WEST} + {2279754000 3600 1 WEST} + {2311203600 3600 1 WEST} + {2342653200 3600 1 WEST} + {2374102800 3600 1 WEST} + {2405552400 3600 1 WEST} + {2437606800 3600 1 WEST} + {2469056400 3600 1 WEST} + {2500506000 3600 1 WEST} + {2531955600 3600 1 WEST} + {2563405200 3600 1 WEST} + {2595459600 3600 1 WEST} + {2626909200 3600 1 WEST} + {2658358800 3600 1 WEST} + {2689808400 3600 1 WEST} + {2721258000 3600 1 WEST} + {2752707600 3600 1 WEST} + {2784762000 3600 1 WEST} + {2816211600 3600 1 WEST} + {2847661200 3600 1 WEST} + {2879110800 3600 1 WEST} + {2910560400 3600 1 WEST} + {2942010000 3600 1 WEST} + {2974064400 3600 1 WEST} + {3005514000 3600 1 WEST} + {3036963600 3600 1 WEST} + {3068413200 3600 1 WEST} + {3099862800 3600 1 WEST} + {3131917200 3600 1 WEST} + {3163366800 3600 1 WEST} + {3194816400 3600 1 WEST} + {3226266000 3600 1 WEST} + {3257715600 3600 1 WEST} + {3289165200 3600 1 WEST} + {3321219600 3600 1 WEST} + {3352669200 3600 1 WEST} + {3384118800 3600 1 WEST} + {3415568400 3600 1 WEST} + {3447018000 3600 1 WEST} + {3479072400 3600 1 WEST} + {3510522000 3600 1 WEST} + {3541971600 3600 1 WEST} + {3573421200 3600 1 WEST} + {3604870800 3600 1 WEST} + {3636320400 3600 1 WEST} + {3668374800 3600 1 WEST} + {3699824400 3600 1 WEST} + {3731274000 3600 1 WEST} + {3762723600 3600 1 WEST} + {3794173200 3600 1 WEST} + {3825622800 3600 1 WEST} + {3857677200 3600 1 WEST} + {3889126800 3600 1 WEST} + {3920576400 3600 1 WEST} + {3952026000 3600 1 WEST} + {3983475600 3600 1 WEST} + {4015530000 3600 1 WEST} + {4046979600 3600 1 WEST} + {4078429200 3600 1 WEST} } diff --git a/library/tzdata/Africa/Gaborone b/library/tzdata/Africa/Gaborone index 7753ba0..bd38673 100644 --- a/library/tzdata/Africa/Gaborone +++ b/library/tzdata/Africa/Gaborone @@ -2,7 +2,8 @@ set TZData(:Africa/Gaborone) { {-9223372036854775808 6220 0 LMT} - {-2682294220 7200 0 CAT} + {-2682294220 5400 0 SAST} + {-2109288600 7200 0 CAT} {-829526400 10800 1 CAST} {-813805200 7200 0 CAT} } diff --git a/library/tzdata/Africa/Juba b/library/tzdata/Africa/Juba index 7495981..40551f2 100644 --- a/library/tzdata/Africa/Juba +++ b/library/tzdata/Africa/Juba @@ -1,39 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:Africa/Juba) { - {-9223372036854775808 7584 0 LMT} - {-1230775584 7200 0 CAT} - {10360800 10800 1 CAST} - {24786000 7200 0 CAT} - {41810400 10800 1 CAST} - {56322000 7200 0 CAT} - {73432800 10800 1 CAST} - {87944400 7200 0 CAT} - {104882400 10800 1 CAST} - {119480400 7200 0 CAT} - {136332000 10800 1 CAST} - {151016400 7200 0 CAT} - {167781600 10800 1 CAST} - {182552400 7200 0 CAT} - {199231200 10800 1 CAST} - {214174800 7200 0 CAT} - {230680800 10800 1 CAST} - {245710800 7200 0 CAT} - {262735200 10800 1 CAST} - {277246800 7200 0 CAT} - {294184800 10800 1 CAST} - {308782800 7200 0 CAT} - {325634400 10800 1 CAST} - {340405200 7200 0 CAT} - {357084000 10800 1 CAST} - {371941200 7200 0 CAT} - {388533600 10800 1 CAST} - {403477200 7200 0 CAT} - {419983200 10800 1 CAST} - {435013200 7200 0 CAT} - {452037600 10800 1 CAST} - {466635600 7200 0 CAT} - {483487200 10800 1 CAST} - {498171600 7200 0 CAT} - {947930400 10800 0 EAT} +if {![info exists TZData(Africa/Khartoum)]} { + LoadTimeZoneFile Africa/Khartoum } +set TZData(:Africa/Juba) $TZData(:Africa/Khartoum) diff --git a/library/tzdata/Africa/Tripoli b/library/tzdata/Africa/Tripoli index e993249..ac78218 100644 --- a/library/tzdata/Africa/Tripoli +++ b/library/tzdata/Africa/Tripoli @@ -27,5 +27,180 @@ set TZData(:Africa/Tripoli) { {641775600 7200 0 EET} {844034400 3600 0 CET} {860108400 7200 1 CEST} - {875916000 7200 0 EET} + {875919600 7200 0 EET} + {1352505600 3600 0 CET} + {1364515200 7200 1 CEST} + {1382659200 3600 0 CET} + {1395964800 7200 1 CEST} + {1414713600 3600 0 CET} + {1427414400 7200 1 CEST} + {1446163200 3600 0 CET} + {1458864000 7200 1 CEST} + {1477612800 3600 0 CET} + {1490918400 7200 1 CEST} + {1509062400 3600 0 CET} + {1522368000 7200 1 CEST} + {1540512000 3600 0 CET} + {1553817600 7200 1 CEST} + {1571961600 3600 0 CET} + {1585267200 7200 1 CEST} + {1604016000 3600 0 CET} + {1616716800 7200 1 CEST} + {1635465600 3600 0 CET} + {1648166400 7200 1 CEST} + {1666915200 3600 0 CET} + {1680220800 7200 1 CEST} + {1698364800 3600 0 CET} + {1711670400 7200 1 CEST} + {1729814400 3600 0 CET} + {1743120000 7200 1 CEST} + {1761868800 3600 0 CET} + {1774569600 7200 1 CEST} + {1793318400 3600 0 CET} + {1806019200 7200 1 CEST} + {1824768000 3600 0 CET} + {1838073600 7200 1 CEST} + {1856217600 3600 0 CET} + {1869523200 7200 1 CEST} + {1887667200 3600 0 CET} + {1900972800 7200 1 CEST} + {1919116800 3600 0 CET} + {1932422400 7200 1 CEST} + {1951171200 3600 0 CET} + {1963872000 7200 1 CEST} + {1982620800 3600 0 CET} + {1995321600 7200 1 CEST} + {2014070400 3600 0 CET} + {2027376000 7200 1 CEST} + {2045520000 3600 0 CET} + {2058825600 7200 1 CEST} + {2076969600 3600 0 CET} + {2090275200 7200 1 CEST} + {2109024000 3600 0 CET} + {2121724800 7200 1 CEST} + {2140473600 3600 0 CET} + {2153174400 7200 1 CEST} + {2171923200 3600 0 CET} + {2184624000 7200 1 CEST} + {2203372800 3600 0 CET} + {2216678400 7200 1 CEST} + {2234822400 3600 0 CET} + {2248128000 7200 1 CEST} + {2266272000 3600 0 CET} + {2279577600 7200 1 CEST} + {2298326400 3600 0 CET} + {2311027200 7200 1 CEST} + {2329776000 3600 0 CET} + {2342476800 7200 1 CEST} + {2361225600 3600 0 CET} + {2374531200 7200 1 CEST} + {2392675200 3600 0 CET} + {2405980800 7200 1 CEST} + {2424124800 3600 0 CET} + {2437430400 7200 1 CEST} + {2455574400 3600 0 CET} + {2468880000 7200 1 CEST} + {2487628800 3600 0 CET} + {2500329600 7200 1 CEST} + {2519078400 3600 0 CET} + {2531779200 7200 1 CEST} + {2550528000 3600 0 CET} + {2563833600 7200 1 CEST} + {2581977600 3600 0 CET} + {2595283200 7200 1 CEST} + {2613427200 3600 0 CET} + {2626732800 7200 1 CEST} + {2645481600 3600 0 CET} + {2658182400 7200 1 CEST} + {2676931200 3600 0 CET} + {2689632000 7200 1 CEST} + {2708380800 3600 0 CET} + {2721686400 7200 1 CEST} + {2739830400 3600 0 CET} + {2753136000 7200 1 CEST} + {2771280000 3600 0 CET} + {2784585600 7200 1 CEST} + {2802729600 3600 0 CET} + {2816035200 7200 1 CEST} + {2834784000 3600 0 CET} + {2847484800 7200 1 CEST} + {2866233600 3600 0 CET} + {2878934400 7200 1 CEST} + {2897683200 3600 0 CET} + {2910988800 7200 1 CEST} + {2929132800 3600 0 CET} + {2942438400 7200 1 CEST} + {2960582400 3600 0 CET} + {2973888000 7200 1 CEST} + {2992636800 3600 0 CET} + {3005337600 7200 1 CEST} + {3024086400 3600 0 CET} + {3036787200 7200 1 CEST} + {3055536000 3600 0 CET} + {3068236800 7200 1 CEST} + {3086985600 3600 0 CET} + {3100291200 7200 1 CEST} + {3118435200 3600 0 CET} + {3131740800 7200 1 CEST} + {3149884800 3600 0 CET} + {3163190400 7200 1 CEST} + {3181939200 3600 0 CET} + {3194640000 7200 1 CEST} + {3213388800 3600 0 CET} + {3226089600 7200 1 CEST} + {3244838400 3600 0 CET} + {3258144000 7200 1 CEST} + {3276288000 3600 0 CET} + {3289593600 7200 1 CEST} + {3307737600 3600 0 CET} + {3321043200 7200 1 CEST} + {3339187200 3600 0 CET} + {3352492800 7200 1 CEST} + {3371241600 3600 0 CET} + {3383942400 7200 1 CEST} + {3402691200 3600 0 CET} + {3415392000 7200 1 CEST} + {3434140800 3600 0 CET} + {3447446400 7200 1 CEST} + {3465590400 3600 0 CET} + {3478896000 7200 1 CEST} + {3497040000 3600 0 CET} + {3510345600 7200 1 CEST} + {3529094400 3600 0 CET} + {3541795200 7200 1 CEST} + {3560544000 3600 0 CET} + {3573244800 7200 1 CEST} + {3591993600 3600 0 CET} + {3605299200 7200 1 CEST} + {3623443200 3600 0 CET} + {3636748800 7200 1 CEST} + {3654892800 3600 0 CET} + {3668198400 7200 1 CEST} + {3686342400 3600 0 CET} + {3699648000 7200 1 CEST} + {3718396800 3600 0 CET} + {3731097600 7200 1 CEST} + {3749846400 3600 0 CET} + {3762547200 7200 1 CEST} + {3781296000 3600 0 CET} + {3794601600 7200 1 CEST} + {3812745600 3600 0 CET} + {3826051200 7200 1 CEST} + {3844195200 3600 0 CET} + {3857500800 7200 1 CEST} + {3876249600 3600 0 CET} + {3888950400 7200 1 CEST} + {3907699200 3600 0 CET} + {3920400000 7200 1 CEST} + {3939148800 3600 0 CET} + {3951849600 7200 1 CEST} + {3970598400 3600 0 CET} + {3983904000 7200 1 CEST} + {4002048000 3600 0 CET} + {4015353600 7200 1 CEST} + {4033497600 3600 0 CET} + {4046803200 7200 1 CEST} + {4065552000 3600 0 CET} + {4078252800 7200 1 CEST} + {4097001600 3600 0 CET} } diff --git a/library/tzdata/America/Anguilla b/library/tzdata/America/Anguilla index cfe7483..39a0d18 100644 --- a/library/tzdata/America/Anguilla +++ b/library/tzdata/America/Anguilla @@ -1,6 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:America/Anguilla) { - {-9223372036854775808 -15136 0 LMT} - {-1825098464 -14400 0 AST} +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } +set TZData(:America/Anguilla) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/Araguaina b/library/tzdata/America/Araguaina index dc1b543..e4a0d52 100644 --- a/library/tzdata/America/Araguaina +++ b/library/tzdata/America/Araguaina @@ -56,177 +56,5 @@ set TZData(:America/Araguaina) { {1064368800 -10800 0 BRT} {1350788400 -7200 0 BRST} {1361066400 -10800 0 BRT} - {1382238000 -7200 1 BRST} - {1392516000 -10800 0 BRT} - {1413687600 -7200 1 BRST} - {1424570400 -10800 0 BRT} - {1445137200 -7200 1 BRST} - {1456020000 -10800 0 BRT} - {1476586800 -7200 1 BRST} - {1487469600 -10800 0 BRT} - {1508036400 -7200 1 BRST} - {1518919200 -10800 0 BRT} - {1540090800 -7200 1 BRST} - {1550368800 -10800 0 BRT} - {1571540400 -7200 1 BRST} - {1581818400 -10800 0 BRT} - {1602990000 -7200 1 BRST} - {1613872800 -10800 0 BRT} - {1634439600 -7200 1 BRST} - {1645322400 -10800 0 BRT} - {1665889200 -7200 1 BRST} - {1677376800 -10800 0 BRT} - {1697338800 -7200 1 BRST} - {1708221600 -10800 0 BRT} - {1729393200 -7200 1 BRST} - {1739671200 -10800 0 BRT} - {1760842800 -7200 1 BRST} - {1771725600 -10800 0 BRT} - {1792292400 -7200 1 BRST} - {1803175200 -10800 0 BRT} - {1823742000 -7200 1 BRST} - {1834624800 -10800 0 BRT} - {1855191600 -7200 1 BRST} - {1866074400 -10800 0 BRT} - {1887246000 -7200 1 BRST} - {1897524000 -10800 0 BRT} - {1918695600 -7200 1 BRST} - {1928973600 -10800 0 BRT} - {1950145200 -7200 1 BRST} - {1960423200 -10800 0 BRT} - {1981594800 -7200 1 BRST} - {1992477600 -10800 0 BRT} - {2013044400 -7200 1 BRST} - {2024532000 -10800 0 BRT} - {2044494000 -7200 1 BRST} - {2055376800 -10800 0 BRT} - {2076548400 -7200 1 BRST} - {2086826400 -10800 0 BRT} - {2107998000 -7200 1 BRST} - {2118880800 -10800 0 BRT} - {2139447600 -7200 1 BRST} - {2150330400 -10800 0 BRT} - {2170897200 -7200 1 BRST} - {2181780000 -10800 0 BRT} - {2202346800 -7200 1 BRST} - {2213229600 -10800 0 BRT} - {2234401200 -7200 1 BRST} - {2244679200 -10800 0 BRT} - {2265850800 -7200 1 BRST} - {2276128800 -10800 0 BRT} - {2297300400 -7200 1 BRST} - {2307578400 -10800 0 BRT} - {2328750000 -7200 1 BRST} - {2339632800 -10800 0 BRT} - {2360199600 -7200 1 BRST} - {2371082400 -10800 0 BRT} - {2391649200 -7200 1 BRST} - {2402532000 -10800 0 BRT} - {2423703600 -7200 1 BRST} - {2433981600 -10800 0 BRT} - {2455153200 -7200 1 BRST} - {2465431200 -10800 0 BRT} - {2486602800 -7200 1 BRST} - {2497485600 -10800 0 BRT} - {2518052400 -7200 1 BRST} - {2528935200 -10800 0 BRT} - {2549502000 -7200 1 BRST} - {2560384800 -10800 0 BRT} - {2580951600 -7200 1 BRST} - {2591834400 -10800 0 BRT} - {2613006000 -7200 1 BRST} - {2623284000 -10800 0 BRT} - {2644455600 -7200 1 BRST} - {2654733600 -10800 0 BRT} - {2675905200 -7200 1 BRST} - {2686788000 -10800 0 BRT} - {2707354800 -7200 1 BRST} - {2718237600 -10800 0 BRT} - {2738804400 -7200 1 BRST} - {2749687200 -10800 0 BRT} - {2770858800 -7200 1 BRST} - {2781136800 -10800 0 BRT} - {2802308400 -7200 1 BRST} - {2812586400 -10800 0 BRT} - {2833758000 -7200 1 BRST} - {2844036000 -10800 0 BRT} - {2865207600 -7200 1 BRST} - {2876090400 -10800 0 BRT} - {2896657200 -7200 1 BRST} - {2907540000 -10800 0 BRT} - {2928106800 -7200 1 BRST} - {2938989600 -10800 0 BRT} - {2960161200 -7200 1 BRST} - {2970439200 -10800 0 BRT} - {2991610800 -7200 1 BRST} - {3001888800 -10800 0 BRT} - {3023060400 -7200 1 BRST} - {3033943200 -10800 0 BRT} - {3054510000 -7200 1 BRST} - {3065392800 -10800 0 BRT} - {3085959600 -7200 1 BRST} - {3096842400 -10800 0 BRT} - {3118014000 -7200 1 BRST} - {3128292000 -10800 0 BRT} - {3149463600 -7200 1 BRST} - {3159741600 -10800 0 BRT} - {3180913200 -7200 1 BRST} - {3191191200 -10800 0 BRT} - {3212362800 -7200 1 BRST} - {3223245600 -10800 0 BRT} - {3243812400 -7200 1 BRST} - {3254695200 -10800 0 BRT} - {3275262000 -7200 1 BRST} - {3286144800 -10800 0 BRT} - {3307316400 -7200 1 BRST} - {3317594400 -10800 0 BRT} - {3338766000 -7200 1 BRST} - {3349044000 -10800 0 BRT} - {3370215600 -7200 1 BRST} - {3381098400 -10800 0 BRT} - {3401665200 -7200 1 BRST} - {3412548000 -10800 0 BRT} - {3433114800 -7200 1 BRST} - {3443997600 -10800 0 BRT} - {3464564400 -7200 1 BRST} - {3475447200 -10800 0 BRT} - {3496618800 -7200 1 BRST} - {3506896800 -10800 0 BRT} - {3528068400 -7200 1 BRST} - {3538346400 -10800 0 BRT} - {3559518000 -7200 1 BRST} - {3570400800 -10800 0 BRT} - {3590967600 -7200 1 BRST} - {3601850400 -10800 0 BRT} - {3622417200 -7200 1 BRST} - {3633300000 -10800 0 BRT} - {3654471600 -7200 1 BRST} - {3664749600 -10800 0 BRT} - {3685921200 -7200 1 BRST} - {3696199200 -10800 0 BRT} - {3717370800 -7200 1 BRST} - {3727648800 -10800 0 BRT} - {3748820400 -7200 1 BRST} - {3759703200 -10800 0 BRT} - {3780270000 -7200 1 BRST} - {3791152800 -10800 0 BRT} - {3811719600 -7200 1 BRST} - {3822602400 -10800 0 BRT} - {3843774000 -7200 1 BRST} - {3854052000 -10800 0 BRT} - {3875223600 -7200 1 BRST} - {3885501600 -10800 0 BRT} - {3906673200 -7200 1 BRST} - {3917556000 -10800 0 BRT} - {3938122800 -7200 1 BRST} - {3949005600 -10800 0 BRT} - {3969572400 -7200 1 BRST} - {3980455200 -10800 0 BRT} - {4001626800 -7200 1 BRST} - {4011904800 -10800 0 BRT} - {4033076400 -7200 1 BRST} - {4043354400 -10800 0 BRT} - {4064526000 -7200 1 BRST} - {4074804000 -10800 0 BRT} - {4095975600 -7200 1 BRST} + {1378000800 -10800 0 BRT} } diff --git a/library/tzdata/America/Argentina/San_Luis b/library/tzdata/America/Argentina/San_Luis index bec1554..8ca55d7 100644 --- a/library/tzdata/America/Argentina/San_Luis +++ b/library/tzdata/America/Argentina/San_Luis @@ -64,5 +64,5 @@ set TZData(:America/Argentina/San_Luis) { {1205031600 -14400 0 WART} {1223784000 -10800 1 WARST} {1236481200 -14400 0 WART} - {1255233600 -10800 1 WARST} + {1255233600 -10800 0 ART} } diff --git a/library/tzdata/America/Aruba b/library/tzdata/America/Aruba index 92f182d..e02d5fc 100644 --- a/library/tzdata/America/Aruba +++ b/library/tzdata/America/Aruba @@ -1,7 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:America/Aruba) { - {-9223372036854775808 -16824 0 LMT} - {-1826738376 -16200 0 ANT} - {-157750200 -14400 0 AST} +if {![info exists TZData(America/Curacao)]} { + LoadTimeZoneFile America/Curacao } +set TZData(:America/Aruba) $TZData(:America/Curacao) diff --git a/library/tzdata/America/Asuncion b/library/tzdata/America/Asuncion index 14bbab2..9ea30da 100644 --- a/library/tzdata/America/Asuncion +++ b/library/tzdata/America/Asuncion @@ -82,178 +82,178 @@ set TZData(:America/Asuncion) { {1317528000 -10800 1 PYST} {1333854000 -14400 0 PYT} {1349582400 -10800 1 PYST} - {1365908400 -14400 0 PYT} + {1364094000 -14400 0 PYT} {1381032000 -10800 1 PYST} - {1397358000 -14400 0 PYT} + {1395543600 -14400 0 PYT} {1412481600 -10800 1 PYST} - {1428807600 -14400 0 PYT} + {1426993200 -14400 0 PYT} {1443931200 -10800 1 PYST} - {1460257200 -14400 0 PYT} + {1459047600 -14400 0 PYT} {1475380800 -10800 1 PYST} - {1491706800 -14400 0 PYT} + {1490497200 -14400 0 PYT} {1506830400 -10800 1 PYST} - {1523156400 -14400 0 PYT} + {1521946800 -14400 0 PYT} {1538884800 -10800 1 PYST} - {1555210800 -14400 0 PYT} + {1553396400 -14400 0 PYT} {1570334400 -10800 1 PYST} - {1586660400 -14400 0 PYT} + {1584846000 -14400 0 PYT} {1601784000 -10800 1 PYST} - {1618110000 -14400 0 PYT} + {1616900400 -14400 0 PYT} {1633233600 -10800 1 PYST} - {1649559600 -14400 0 PYT} + {1648350000 -14400 0 PYT} {1664683200 -10800 1 PYST} - {1681009200 -14400 0 PYT} + {1679799600 -14400 0 PYT} {1696132800 -10800 1 PYST} - {1713063600 -14400 0 PYT} + {1711249200 -14400 0 PYT} {1728187200 -10800 1 PYST} - {1744513200 -14400 0 PYT} + {1742698800 -14400 0 PYT} {1759636800 -10800 1 PYST} - {1775962800 -14400 0 PYT} + {1774148400 -14400 0 PYT} {1791086400 -10800 1 PYST} - {1807412400 -14400 0 PYT} + {1806202800 -14400 0 PYT} {1822536000 -10800 1 PYST} - {1838862000 -14400 0 PYT} + {1837652400 -14400 0 PYT} {1853985600 -10800 1 PYST} - {1870311600 -14400 0 PYT} + {1869102000 -14400 0 PYT} {1886040000 -10800 1 PYST} - {1902366000 -14400 0 PYT} + {1900551600 -14400 0 PYT} {1917489600 -10800 1 PYST} - {1933815600 -14400 0 PYT} + {1932001200 -14400 0 PYT} {1948939200 -10800 1 PYST} - {1965265200 -14400 0 PYT} + {1964055600 -14400 0 PYT} {1980388800 -10800 1 PYST} - {1996714800 -14400 0 PYT} + {1995505200 -14400 0 PYT} {2011838400 -10800 1 PYST} - {2028164400 -14400 0 PYT} + {2026954800 -14400 0 PYT} {2043288000 -10800 1 PYST} - {2059614000 -14400 0 PYT} + {2058404400 -14400 0 PYT} {2075342400 -10800 1 PYST} - {2091668400 -14400 0 PYT} + {2089854000 -14400 0 PYT} {2106792000 -10800 1 PYST} - {2123118000 -14400 0 PYT} + {2121303600 -14400 0 PYT} {2138241600 -10800 1 PYST} - {2154567600 -14400 0 PYT} + {2153358000 -14400 0 PYT} {2169691200 -10800 1 PYST} - {2186017200 -14400 0 PYT} + {2184807600 -14400 0 PYT} {2201140800 -10800 1 PYST} - {2217466800 -14400 0 PYT} + {2216257200 -14400 0 PYT} {2233195200 -10800 1 PYST} - {2249521200 -14400 0 PYT} + {2247706800 -14400 0 PYT} {2264644800 -10800 1 PYST} - {2280970800 -14400 0 PYT} + {2279156400 -14400 0 PYT} {2296094400 -10800 1 PYST} - {2312420400 -14400 0 PYT} + {2310606000 -14400 0 PYT} {2327544000 -10800 1 PYST} - {2343870000 -14400 0 PYT} + {2342660400 -14400 0 PYT} {2358993600 -10800 1 PYST} - {2375319600 -14400 0 PYT} + {2374110000 -14400 0 PYT} {2390443200 -10800 1 PYST} - {2406769200 -14400 0 PYT} + {2405559600 -14400 0 PYT} {2422497600 -10800 1 PYST} - {2438823600 -14400 0 PYT} + {2437009200 -14400 0 PYT} {2453947200 -10800 1 PYST} - {2470273200 -14400 0 PYT} + {2468458800 -14400 0 PYT} {2485396800 -10800 1 PYST} - {2501722800 -14400 0 PYT} + {2500513200 -14400 0 PYT} {2516846400 -10800 1 PYST} - {2533172400 -14400 0 PYT} + {2531962800 -14400 0 PYT} {2548296000 -10800 1 PYST} - {2564622000 -14400 0 PYT} + {2563412400 -14400 0 PYT} {2579745600 -10800 1 PYST} - {2596676400 -14400 0 PYT} + {2594862000 -14400 0 PYT} {2611800000 -10800 1 PYST} - {2628126000 -14400 0 PYT} + {2626311600 -14400 0 PYT} {2643249600 -10800 1 PYST} - {2659575600 -14400 0 PYT} + {2657761200 -14400 0 PYT} {2674699200 -10800 1 PYST} - {2691025200 -14400 0 PYT} + {2689815600 -14400 0 PYT} {2706148800 -10800 1 PYST} - {2722474800 -14400 0 PYT} + {2721265200 -14400 0 PYT} {2737598400 -10800 1 PYST} - {2753924400 -14400 0 PYT} + {2752714800 -14400 0 PYT} {2769652800 -10800 1 PYST} - {2785978800 -14400 0 PYT} + {2784164400 -14400 0 PYT} {2801102400 -10800 1 PYST} - {2817428400 -14400 0 PYT} + {2815614000 -14400 0 PYT} {2832552000 -10800 1 PYST} - {2848878000 -14400 0 PYT} + {2847668400 -14400 0 PYT} {2864001600 -10800 1 PYST} - {2880327600 -14400 0 PYT} + {2879118000 -14400 0 PYT} {2895451200 -10800 1 PYST} - {2911777200 -14400 0 PYT} + {2910567600 -14400 0 PYT} {2926900800 -10800 1 PYST} - {2943226800 -14400 0 PYT} + {2942017200 -14400 0 PYT} {2958955200 -10800 1 PYST} - {2975281200 -14400 0 PYT} + {2973466800 -14400 0 PYT} {2990404800 -10800 1 PYST} - {3006730800 -14400 0 PYT} + {3004916400 -14400 0 PYT} {3021854400 -10800 1 PYST} - {3038180400 -14400 0 PYT} + {3036970800 -14400 0 PYT} {3053304000 -10800 1 PYST} - {3069630000 -14400 0 PYT} + {3068420400 -14400 0 PYT} {3084753600 -10800 1 PYST} - {3101079600 -14400 0 PYT} + {3099870000 -14400 0 PYT} {3116808000 -10800 1 PYST} - {3133134000 -14400 0 PYT} + {3131319600 -14400 0 PYT} {3148257600 -10800 1 PYST} - {3164583600 -14400 0 PYT} + {3162769200 -14400 0 PYT} {3179707200 -10800 1 PYST} - {3196033200 -14400 0 PYT} + {3194218800 -14400 0 PYT} {3211156800 -10800 1 PYST} - {3227482800 -14400 0 PYT} + {3226273200 -14400 0 PYT} {3242606400 -10800 1 PYST} - {3258932400 -14400 0 PYT} + {3257722800 -14400 0 PYT} {3274056000 -10800 1 PYST} - {3290382000 -14400 0 PYT} + {3289172400 -14400 0 PYT} {3306110400 -10800 1 PYST} - {3322436400 -14400 0 PYT} + {3320622000 -14400 0 PYT} {3337560000 -10800 1 PYST} - {3353886000 -14400 0 PYT} + {3352071600 -14400 0 PYT} {3369009600 -10800 1 PYST} - {3385335600 -14400 0 PYT} + {3384126000 -14400 0 PYT} {3400459200 -10800 1 PYST} - {3416785200 -14400 0 PYT} + {3415575600 -14400 0 PYT} {3431908800 -10800 1 PYST} - {3448234800 -14400 0 PYT} + {3447025200 -14400 0 PYT} {3463358400 -10800 1 PYST} - {3480289200 -14400 0 PYT} + {3478474800 -14400 0 PYT} {3495412800 -10800 1 PYST} - {3511738800 -14400 0 PYT} + {3509924400 -14400 0 PYT} {3526862400 -10800 1 PYST} - {3543188400 -14400 0 PYT} + {3541374000 -14400 0 PYT} {3558312000 -10800 1 PYST} - {3574638000 -14400 0 PYT} + {3573428400 -14400 0 PYT} {3589761600 -10800 1 PYST} - {3606087600 -14400 0 PYT} + {3604878000 -14400 0 PYT} {3621211200 -10800 1 PYST} - {3637537200 -14400 0 PYT} + {3636327600 -14400 0 PYT} {3653265600 -10800 1 PYST} - {3669591600 -14400 0 PYT} + {3667777200 -14400 0 PYT} {3684715200 -10800 1 PYST} - {3701041200 -14400 0 PYT} + {3699226800 -14400 0 PYT} {3716164800 -10800 1 PYST} - {3732490800 -14400 0 PYT} + {3731281200 -14400 0 PYT} {3747614400 -10800 1 PYST} - {3763940400 -14400 0 PYT} + {3762730800 -14400 0 PYT} {3779064000 -10800 1 PYST} - {3795390000 -14400 0 PYT} + {3794180400 -14400 0 PYT} {3810513600 -10800 1 PYST} - {3826839600 -14400 0 PYT} + {3825630000 -14400 0 PYT} {3842568000 -10800 1 PYST} - {3858894000 -14400 0 PYT} + {3857079600 -14400 0 PYT} {3874017600 -10800 1 PYST} - {3890343600 -14400 0 PYT} + {3888529200 -14400 0 PYT} {3905467200 -10800 1 PYST} - {3921793200 -14400 0 PYT} + {3920583600 -14400 0 PYT} {3936916800 -10800 1 PYST} - {3953242800 -14400 0 PYT} + {3952033200 -14400 0 PYT} {3968366400 -10800 1 PYST} - {3984692400 -14400 0 PYT} + {3983482800 -14400 0 PYT} {4000420800 -10800 1 PYST} - {4016746800 -14400 0 PYT} + {4014932400 -14400 0 PYT} {4031870400 -10800 1 PYST} - {4048196400 -14400 0 PYT} + {4046382000 -14400 0 PYT} {4063320000 -10800 1 PYST} - {4079646000 -14400 0 PYT} + {4077831600 -14400 0 PYT} {4094769600 -10800 1 PYST} } diff --git a/library/tzdata/America/Barbados b/library/tzdata/America/Barbados index 5c06408..ea17073 100644 --- a/library/tzdata/America/Barbados +++ b/library/tzdata/America/Barbados @@ -1,9 +1,9 @@ # created by tools/tclZIC.tcl - do not edit set TZData(:America/Barbados) { - {-9223372036854775808 -14308 0 LMT} - {-1451678492 -14308 0 BMT} - {-1199217692 -14400 0 AST} + {-9223372036854775808 -14309 0 LMT} + {-1451678491 -14309 0 BMT} + {-1199217691 -14400 0 AST} {234943200 -10800 1 ADT} {244616400 -14400 0 AST} {261554400 -10800 1 ADT} diff --git a/library/tzdata/America/Bogota b/library/tzdata/America/Bogota index f727d17..b28abc1 100644 --- a/library/tzdata/America/Bogota +++ b/library/tzdata/America/Bogota @@ -1,9 +1,9 @@ # created by tools/tclZIC.tcl - do not edit set TZData(:America/Bogota) { - {-9223372036854775808 -17780 0 LMT} - {-2707671820 -17780 0 BMT} - {-1739041420 -18000 0 COT} + {-9223372036854775808 -17776 0 LMT} + {-2707671824 -17776 0 BMT} + {-1739041424 -18000 0 COT} {704869200 -14400 1 COST} {733896000 -18000 0 COT} } diff --git a/library/tzdata/America/Cayman b/library/tzdata/America/Cayman index ab5d12b..3e2e3cc 100644 --- a/library/tzdata/America/Cayman +++ b/library/tzdata/America/Cayman @@ -2,6 +2,6 @@ set TZData(:America/Cayman) { {-9223372036854775808 -19532 0 LMT} - {-2524502068 -18432 0 KMT} - {-1827687168 -18000 0 EST} + {-2524502068 -18431 0 KMT} + {-1827687169 -18000 0 EST} } diff --git a/library/tzdata/America/Costa_Rica b/library/tzdata/America/Costa_Rica index 04420a4..8fc9343 100644 --- a/library/tzdata/America/Costa_Rica +++ b/library/tzdata/America/Costa_Rica @@ -1,9 +1,9 @@ # created by tools/tclZIC.tcl - do not edit set TZData(:America/Costa_Rica) { - {-9223372036854775808 -20180 0 LMT} - {-2524501420 -20180 0 SJMT} - {-1545071020 -21600 0 CST} + {-9223372036854775808 -20173 0 LMT} + {-2524501427 -20173 0 SJMT} + {-1545071027 -21600 0 CST} {288770400 -18000 1 CDT} {297234000 -21600 0 CST} {320220000 -18000 1 CDT} diff --git a/library/tzdata/America/Curacao b/library/tzdata/America/Curacao index 443a319..5189e9c 100644 --- a/library/tzdata/America/Curacao +++ b/library/tzdata/America/Curacao @@ -1,7 +1,7 @@ # created by tools/tclZIC.tcl - do not edit set TZData(:America/Curacao) { - {-9223372036854775808 -16544 0 LMT} - {-1826738656 -16200 0 ANT} + {-9223372036854775808 -16547 0 LMT} + {-1826738653 -16200 0 ANT} {-157750200 -14400 0 AST} } diff --git a/library/tzdata/America/Dominica b/library/tzdata/America/Dominica index 3503a65..b97cb0e 100644 --- a/library/tzdata/America/Dominica +++ b/library/tzdata/America/Dominica @@ -1,6 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:America/Dominica) { - {-9223372036854775808 -14736 0 LMT} - {-1846266804 -14400 0 AST} +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } +set TZData(:America/Dominica) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/Grand_Turk b/library/tzdata/America/Grand_Turk index a455dd5..6c8ea4a 100644 --- a/library/tzdata/America/Grand_Turk +++ b/library/tzdata/America/Grand_Turk @@ -2,8 +2,8 @@ set TZData(:America/Grand_Turk) { {-9223372036854775808 -17072 0 LMT} - {-2524504528 -18432 0 KMT} - {-1827687168 -18000 0 EST} + {-2524504528 -18431 0 KMT} + {-1827687169 -18000 0 EST} {294217200 -14400 1 EDT} {309938400 -18000 0 EST} {325666800 -14400 1 EDT} diff --git a/library/tzdata/America/Grenada b/library/tzdata/America/Grenada index 3c2919b..92300c3 100644 --- a/library/tzdata/America/Grenada +++ b/library/tzdata/America/Grenada @@ -1,6 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:America/Grenada) { - {-9223372036854775808 -14820 0 LMT} - {-1846266780 -14400 0 AST} +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } +set TZData(:America/Grenada) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/Guadeloupe b/library/tzdata/America/Guadeloupe index b1987ce..aba6bd7 100644 --- a/library/tzdata/America/Guadeloupe +++ b/library/tzdata/America/Guadeloupe @@ -1,6 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:America/Guadeloupe) { - {-9223372036854775808 -14768 0 LMT} - {-1848254032 -14400 0 AST} +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } +set TZData(:America/Guadeloupe) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/Jamaica b/library/tzdata/America/Jamaica index 393d90a8..682e47c 100644 --- a/library/tzdata/America/Jamaica +++ b/library/tzdata/America/Jamaica @@ -1,9 +1,9 @@ # created by tools/tclZIC.tcl - do not edit set TZData(:America/Jamaica) { - {-9223372036854775808 -18432 0 LMT} - {-2524503168 -18432 0 KMT} - {-1827687168 -18000 0 EST} + {-9223372036854775808 -18431 0 LMT} + {-2524503169 -18431 0 KMT} + {-1827687169 -18000 0 EST} {136364400 -14400 0 EDT} {152085600 -18000 0 EST} {162370800 -14400 1 EDT} diff --git a/library/tzdata/America/Marigot b/library/tzdata/America/Marigot index 9f3f8f6..c2b3873 100644 --- a/library/tzdata/America/Marigot +++ b/library/tzdata/America/Marigot @@ -1,5 +1,5 @@ # created by tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/Guadeloupe)]} { - LoadTimeZoneFile America/Guadeloupe +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } -set TZData(:America/Marigot) $TZData(:America/Guadeloupe) +set TZData(:America/Marigot) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/Montserrat b/library/tzdata/America/Montserrat index 4d82766..0a656d3 100644 --- a/library/tzdata/America/Montserrat +++ b/library/tzdata/America/Montserrat @@ -1,6 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:America/Montserrat) { - {-9223372036854775808 -14932 0 LMT} - {-1846266608 -14400 0 AST} +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } +set TZData(:America/Montserrat) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/Nassau b/library/tzdata/America/Nassau index 06c5f06..1c35e93 100644 --- a/library/tzdata/America/Nassau +++ b/library/tzdata/America/Nassau @@ -1,8 +1,8 @@ # created by tools/tclZIC.tcl - do not edit set TZData(:America/Nassau) { - {-9223372036854775808 -18564 0 LMT} - {-1825095036 -18000 0 EST} + {-9223372036854775808 -18570 0 LMT} + {-1825095030 -18000 0 EST} {-179341200 -14400 1 EDT} {-163620000 -18000 0 EST} {-147891600 -14400 1 EDT} diff --git a/library/tzdata/America/Port-au-Prince b/library/tzdata/America/Port-au-Prince index 639972b..f1d7fc4 100644 --- a/library/tzdata/America/Port-au-Prince +++ b/library/tzdata/America/Port-au-Prince @@ -40,4 +40,178 @@ set TZData(:America/Port-au-Prince) { {1162094400 -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/Santiago b/library/tzdata/America/Santiago index f42ff3d..44be9f8 100644 --- a/library/tzdata/America/Santiago +++ b/library/tzdata/America/Santiago @@ -114,178 +114,178 @@ set TZData(:America/Santiago) { {1313899200 -10800 1 CLST} {1335668400 -14400 0 CLT} {1346558400 -10800 1 CLST} - {1362884400 -14400 0 CLT} - {1381636800 -10800 1 CLST} - {1394334000 -14400 0 CLT} - {1413086400 -10800 1 CLST} - {1426388400 -14400 0 CLT} - {1444536000 -10800 1 CLST} - {1457838000 -14400 0 CLT} - {1475985600 -10800 1 CLST} - {1489287600 -14400 0 CLT} - {1508040000 -10800 1 CLST} - {1520737200 -14400 0 CLT} - {1539489600 -10800 1 CLST} - {1552186800 -14400 0 CLT} - {1570939200 -10800 1 CLST} - {1584241200 -14400 0 CLT} - {1602388800 -10800 1 CLST} - {1615690800 -14400 0 CLT} - {1633838400 -10800 1 CLST} - {1647140400 -14400 0 CLT} - {1665288000 -10800 1 CLST} - {1678590000 -14400 0 CLT} - {1697342400 -10800 1 CLST} - {1710039600 -14400 0 CLT} - {1728792000 -10800 1 CLST} - {1741489200 -14400 0 CLT} - {1760241600 -10800 1 CLST} - {1773543600 -14400 0 CLT} - {1791691200 -10800 1 CLST} - {1804993200 -14400 0 CLT} - {1823140800 -10800 1 CLST} - {1836442800 -14400 0 CLT} - {1855195200 -10800 1 CLST} - {1867892400 -14400 0 CLT} - {1886644800 -10800 1 CLST} - {1899342000 -14400 0 CLT} - {1918094400 -10800 1 CLST} - {1930791600 -14400 0 CLT} - {1949544000 -10800 1 CLST} - {1962846000 -14400 0 CLT} - {1980993600 -10800 1 CLST} - {1994295600 -14400 0 CLT} - {2012443200 -10800 1 CLST} - {2025745200 -14400 0 CLT} - {2044497600 -10800 1 CLST} - {2057194800 -14400 0 CLT} - {2075947200 -10800 1 CLST} - {2088644400 -14400 0 CLT} - {2107396800 -10800 1 CLST} - {2120698800 -14400 0 CLT} - {2138846400 -10800 1 CLST} - {2152148400 -14400 0 CLT} - {2170296000 -10800 1 CLST} - {2183598000 -14400 0 CLT} - {2201745600 -10800 1 CLST} - {2215047600 -14400 0 CLT} - {2233800000 -10800 1 CLST} - {2246497200 -14400 0 CLT} - {2265249600 -10800 1 CLST} - {2277946800 -14400 0 CLT} - {2296699200 -10800 1 CLST} - {2310001200 -14400 0 CLT} - {2328148800 -10800 1 CLST} - {2341450800 -14400 0 CLT} - {2359598400 -10800 1 CLST} - {2372900400 -14400 0 CLT} - {2391652800 -10800 1 CLST} - {2404350000 -14400 0 CLT} - {2423102400 -10800 1 CLST} - {2435799600 -14400 0 CLT} - {2454552000 -10800 1 CLST} - {2467854000 -14400 0 CLT} - {2486001600 -10800 1 CLST} - {2499303600 -14400 0 CLT} - {2517451200 -10800 1 CLST} - {2530753200 -14400 0 CLT} - {2548900800 -10800 1 CLST} - {2562202800 -14400 0 CLT} - {2580955200 -10800 1 CLST} - {2593652400 -14400 0 CLT} - {2612404800 -10800 1 CLST} - {2625102000 -14400 0 CLT} - {2643854400 -10800 1 CLST} - {2657156400 -14400 0 CLT} - {2675304000 -10800 1 CLST} - {2688606000 -14400 0 CLT} - {2706753600 -10800 1 CLST} - {2720055600 -14400 0 CLT} - {2738808000 -10800 1 CLST} - {2751505200 -14400 0 CLT} - {2770257600 -10800 1 CLST} - {2782954800 -14400 0 CLT} - {2801707200 -10800 1 CLST} - {2814404400 -14400 0 CLT} - {2833156800 -10800 1 CLST} - {2846458800 -14400 0 CLT} - {2864606400 -10800 1 CLST} - {2877908400 -14400 0 CLT} - {2896056000 -10800 1 CLST} - {2909358000 -14400 0 CLT} - {2928110400 -10800 1 CLST} - {2940807600 -14400 0 CLT} - {2959560000 -10800 1 CLST} - {2972257200 -14400 0 CLT} - {2991009600 -10800 1 CLST} - {3004311600 -14400 0 CLT} - {3022459200 -10800 1 CLST} - {3035761200 -14400 0 CLT} - {3053908800 -10800 1 CLST} - {3067210800 -14400 0 CLT} - {3085358400 -10800 1 CLST} - {3098660400 -14400 0 CLT} - {3117412800 -10800 1 CLST} - {3130110000 -14400 0 CLT} - {3148862400 -10800 1 CLST} - {3161559600 -14400 0 CLT} - {3180312000 -10800 1 CLST} - {3193614000 -14400 0 CLT} - {3211761600 -10800 1 CLST} - {3225063600 -14400 0 CLT} - {3243211200 -10800 1 CLST} - {3256513200 -14400 0 CLT} - {3275265600 -10800 1 CLST} - {3287962800 -14400 0 CLT} - {3306715200 -10800 1 CLST} - {3319412400 -14400 0 CLT} - {3338164800 -10800 1 CLST} - {3351466800 -14400 0 CLT} - {3369614400 -10800 1 CLST} - {3382916400 -14400 0 CLT} - {3401064000 -10800 1 CLST} - {3414366000 -14400 0 CLT} - {3432513600 -10800 1 CLST} - {3445815600 -14400 0 CLT} - {3464568000 -10800 1 CLST} - {3477265200 -14400 0 CLT} - {3496017600 -10800 1 CLST} - {3508714800 -14400 0 CLT} - {3527467200 -10800 1 CLST} - {3540769200 -14400 0 CLT} - {3558916800 -10800 1 CLST} - {3572218800 -14400 0 CLT} - {3590366400 -10800 1 CLST} - {3603668400 -14400 0 CLT} - {3622420800 -10800 1 CLST} - {3635118000 -14400 0 CLT} - {3653870400 -10800 1 CLST} - {3666567600 -14400 0 CLT} - {3685320000 -10800 1 CLST} - {3698017200 -14400 0 CLT} - {3716769600 -10800 1 CLST} - {3730071600 -14400 0 CLT} - {3748219200 -10800 1 CLST} - {3761521200 -14400 0 CLT} - {3779668800 -10800 1 CLST} - {3792970800 -14400 0 CLT} - {3811723200 -10800 1 CLST} - {3824420400 -14400 0 CLT} - {3843172800 -10800 1 CLST} - {3855870000 -14400 0 CLT} - {3874622400 -10800 1 CLST} - {3887924400 -14400 0 CLT} - {3906072000 -10800 1 CLST} - {3919374000 -14400 0 CLT} - {3937521600 -10800 1 CLST} - {3950823600 -14400 0 CLT} - {3968971200 -10800 1 CLST} - {3982273200 -14400 0 CLT} - {4001025600 -10800 1 CLST} - {4013722800 -14400 0 CLT} - {4032475200 -10800 1 CLST} - {4045172400 -14400 0 CLT} - {4063924800 -10800 1 CLST} - {4077226800 -14400 0 CLT} - {4095374400 -10800 1 CLST} + {1367118000 -14400 0 CLT} + {1378612800 -10800 1 CLST} + {1398567600 -14400 0 CLT} + {1410062400 -10800 1 CLST} + {1430017200 -14400 0 CLT} + {1441512000 -10800 1 CLST} + {1461466800 -14400 0 CLT} + {1472961600 -10800 1 CLST} + {1492916400 -14400 0 CLT} + {1504411200 -10800 1 CLST} + {1524970800 -14400 0 CLT} + {1535860800 -10800 1 CLST} + {1556420400 -14400 0 CLT} + {1567915200 -10800 1 CLST} + {1587870000 -14400 0 CLT} + {1599364800 -10800 1 CLST} + {1619319600 -14400 0 CLT} + {1630814400 -10800 1 CLST} + {1650769200 -14400 0 CLT} + {1662264000 -10800 1 CLST} + {1682218800 -14400 0 CLT} + {1693713600 -10800 1 CLST} + {1714273200 -14400 0 CLT} + {1725768000 -10800 1 CLST} + {1745722800 -14400 0 CLT} + {1757217600 -10800 1 CLST} + {1777172400 -14400 0 CLT} + {1788667200 -10800 1 CLST} + {1808622000 -14400 0 CLT} + {1820116800 -10800 1 CLST} + {1840071600 -14400 0 CLT} + {1851566400 -10800 1 CLST} + {1872126000 -14400 0 CLT} + {1883016000 -10800 1 CLST} + {1903575600 -14400 0 CLT} + {1915070400 -10800 1 CLST} + {1935025200 -14400 0 CLT} + {1946520000 -10800 1 CLST} + {1966474800 -14400 0 CLT} + {1977969600 -10800 1 CLST} + {1997924400 -14400 0 CLT} + {2009419200 -10800 1 CLST} + {2029374000 -14400 0 CLT} + {2040868800 -10800 1 CLST} + {2061428400 -14400 0 CLT} + {2072318400 -10800 1 CLST} + {2092878000 -14400 0 CLT} + {2104372800 -10800 1 CLST} + {2124327600 -14400 0 CLT} + {2135822400 -10800 1 CLST} + {2155777200 -14400 0 CLT} + {2167272000 -10800 1 CLST} + {2187226800 -14400 0 CLT} + {2198721600 -10800 1 CLST} + {2219281200 -14400 0 CLT} + {2230171200 -10800 1 CLST} + {2250730800 -14400 0 CLT} + {2262225600 -10800 1 CLST} + {2282180400 -14400 0 CLT} + {2293675200 -10800 1 CLST} + {2313630000 -14400 0 CLT} + {2325124800 -10800 1 CLST} + {2345079600 -14400 0 CLT} + {2356574400 -10800 1 CLST} + {2376529200 -14400 0 CLT} + {2388024000 -10800 1 CLST} + {2408583600 -14400 0 CLT} + {2419473600 -10800 1 CLST} + {2440033200 -14400 0 CLT} + {2451528000 -10800 1 CLST} + {2471482800 -14400 0 CLT} + {2482977600 -10800 1 CLST} + {2502932400 -14400 0 CLT} + {2514427200 -10800 1 CLST} + {2534382000 -14400 0 CLT} + {2545876800 -10800 1 CLST} + {2565831600 -14400 0 CLT} + {2577326400 -10800 1 CLST} + {2597886000 -14400 0 CLT} + {2609380800 -10800 1 CLST} + {2629335600 -14400 0 CLT} + {2640830400 -10800 1 CLST} + {2660785200 -14400 0 CLT} + {2672280000 -10800 1 CLST} + {2692234800 -14400 0 CLT} + {2703729600 -10800 1 CLST} + {2723684400 -14400 0 CLT} + {2735179200 -10800 1 CLST} + {2755738800 -14400 0 CLT} + {2766628800 -10800 1 CLST} + {2787188400 -14400 0 CLT} + {2798683200 -10800 1 CLST} + {2818638000 -14400 0 CLT} + {2830132800 -10800 1 CLST} + {2850087600 -14400 0 CLT} + {2861582400 -10800 1 CLST} + {2881537200 -14400 0 CLT} + {2893032000 -10800 1 CLST} + {2912986800 -14400 0 CLT} + {2924481600 -10800 1 CLST} + {2945041200 -14400 0 CLT} + {2955931200 -10800 1 CLST} + {2976490800 -14400 0 CLT} + {2987985600 -10800 1 CLST} + {3007940400 -14400 0 CLT} + {3019435200 -10800 1 CLST} + {3039390000 -14400 0 CLT} + {3050884800 -10800 1 CLST} + {3070839600 -14400 0 CLT} + {3082334400 -10800 1 CLST} + {3102894000 -14400 0 CLT} + {3113784000 -10800 1 CLST} + {3134343600 -14400 0 CLT} + {3145838400 -10800 1 CLST} + {3165793200 -14400 0 CLT} + {3177288000 -10800 1 CLST} + {3197242800 -14400 0 CLT} + {3208737600 -10800 1 CLST} + {3228692400 -14400 0 CLT} + {3240187200 -10800 1 CLST} + {3260142000 -14400 0 CLT} + {3271636800 -10800 1 CLST} + {3292196400 -14400 0 CLT} + {3303086400 -10800 1 CLST} + {3323646000 -14400 0 CLT} + {3335140800 -10800 1 CLST} + {3355095600 -14400 0 CLT} + {3366590400 -10800 1 CLST} + {3386545200 -14400 0 CLT} + {3398040000 -10800 1 CLST} + {3417994800 -14400 0 CLT} + {3429489600 -10800 1 CLST} + {3449444400 -14400 0 CLT} + {3460939200 -10800 1 CLST} + {3481498800 -14400 0 CLT} + {3492993600 -10800 1 CLST} + {3512948400 -14400 0 CLT} + {3524443200 -10800 1 CLST} + {3544398000 -14400 0 CLT} + {3555892800 -10800 1 CLST} + {3575847600 -14400 0 CLT} + {3587342400 -10800 1 CLST} + {3607297200 -14400 0 CLT} + {3618792000 -10800 1 CLST} + {3639351600 -14400 0 CLT} + {3650241600 -10800 1 CLST} + {3670801200 -14400 0 CLT} + {3682296000 -10800 1 CLST} + {3702250800 -14400 0 CLT} + {3713745600 -10800 1 CLST} + {3733700400 -14400 0 CLT} + {3745195200 -10800 1 CLST} + {3765150000 -14400 0 CLT} + {3776644800 -10800 1 CLST} + {3796599600 -14400 0 CLT} + {3808094400 -10800 1 CLST} + {3828654000 -14400 0 CLT} + {3839544000 -10800 1 CLST} + {3860103600 -14400 0 CLT} + {3871598400 -10800 1 CLST} + {3891553200 -14400 0 CLT} + {3903048000 -10800 1 CLST} + {3923002800 -14400 0 CLT} + {3934497600 -10800 1 CLST} + {3954452400 -14400 0 CLT} + {3965947200 -10800 1 CLST} + {3986506800 -14400 0 CLT} + {3997396800 -10800 1 CLST} + {4017956400 -14400 0 CLT} + {4029451200 -10800 1 CLST} + {4049406000 -14400 0 CLT} + {4060900800 -10800 1 CLST} + {4080855600 -14400 0 CLT} + {4092350400 -10800 1 CLST} } diff --git a/library/tzdata/America/St_Barthelemy b/library/tzdata/America/St_Barthelemy index 25c114a..46bc287 100644 --- a/library/tzdata/America/St_Barthelemy +++ b/library/tzdata/America/St_Barthelemy @@ -1,5 +1,5 @@ # created by tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/Guadeloupe)]} { - LoadTimeZoneFile America/Guadeloupe +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } -set TZData(:America/St_Barthelemy) $TZData(:America/Guadeloupe) +set TZData(:America/St_Barthelemy) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/St_Kitts b/library/tzdata/America/St_Kitts index bfd803b..6ad7f04 100644 --- a/library/tzdata/America/St_Kitts +++ b/library/tzdata/America/St_Kitts @@ -1,6 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:America/St_Kitts) { - {-9223372036854775808 -15052 0 LMT} - {-1825098548 -14400 0 AST} +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } +set TZData(:America/St_Kitts) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/St_Lucia b/library/tzdata/America/St_Lucia index c2767dd..e479b31 100644 --- a/library/tzdata/America/St_Lucia +++ b/library/tzdata/America/St_Lucia @@ -1,7 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:America/St_Lucia) { - {-9223372036854775808 -14640 0 LMT} - {-2524506960 -14640 0 CMT} - {-1830369360 -14400 0 AST} +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } +set TZData(:America/St_Lucia) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/St_Thomas b/library/tzdata/America/St_Thomas index bf93595..24698b8 100644 --- a/library/tzdata/America/St_Thomas +++ b/library/tzdata/America/St_Thomas @@ -1,6 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:America/St_Thomas) { - {-9223372036854775808 -15584 0 LMT} - {-1846266016 -14400 0 AST} +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } +set TZData(:America/St_Thomas) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/St_Vincent b/library/tzdata/America/St_Vincent index 3a884c7..e3b32fb 100644 --- a/library/tzdata/America/St_Vincent +++ b/library/tzdata/America/St_Vincent @@ -1,7 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:America/St_Vincent) { - {-9223372036854775808 -14696 0 LMT} - {-2524506904 -14696 0 KMT} - {-1830369304 -14400 0 AST} +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } +set TZData(:America/St_Vincent) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/Tortola b/library/tzdata/America/Tortola index bf7f1fc..aa6f655 100644 --- a/library/tzdata/America/Tortola +++ b/library/tzdata/America/Tortola @@ -1,6 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:America/Tortola) { - {-9223372036854775808 -15508 0 LMT} - {-1846266092 -14400 0 AST} +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } +set TZData(:America/Tortola) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/Virgin b/library/tzdata/America/Virgin index 390d7c2..c267e5b 100644 --- a/library/tzdata/America/Virgin +++ b/library/tzdata/America/Virgin @@ -1,5 +1,5 @@ # created by tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/St_Thomas)]} { - LoadTimeZoneFile America/St_Thomas +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } -set TZData(:America/Virgin) $TZData(:America/St_Thomas) +set TZData(:America/Virgin) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/Antarctica/Macquarie b/library/tzdata/Antarctica/Macquarie index 9877ee8..bd5cf8a 100644 --- a/library/tzdata/Antarctica/Macquarie +++ b/library/tzdata/Antarctica/Macquarie @@ -2,16 +2,11 @@ set TZData(:Antarctica/Macquarie) { {-9223372036854775808 0 0 zzz} - {-1861920000 36000 0 EST} + {-2214259200 36000 0 EST} {-1680508800 39600 1 EST} {-1669892400 39600 0 EST} {-1665392400 36000 0 EST} - {-883641600 39600 1 EST} - {-876128400 36000 0 EST} - {-860400000 39600 1 EST} - {-844678800 36000 0 EST} - {-828345600 39600 1 EST} - {-813229200 36000 0 EST} + {-1601719200 0 0 zzz} {-94730400 36000 0 EST} {-71136000 39600 1 EST} {-55411200 36000 0 EST} diff --git a/library/tzdata/Antarctica/McMurdo b/library/tzdata/Antarctica/McMurdo index 670f7eb..3b29ba1 100644 --- a/library/tzdata/Antarctica/McMurdo +++ b/library/tzdata/Antarctica/McMurdo @@ -1,257 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:Antarctica/McMurdo) { - {-9223372036854775808 0 0 zzz} - {-441849600 43200 0 NZST} - {152632800 46800 1 NZDT} - {162309600 43200 0 NZST} - {183477600 46800 1 NZDT} - {194968800 43200 0 NZST} - {215532000 46800 1 NZDT} - {226418400 43200 0 NZST} - {246981600 46800 1 NZDT} - {257868000 43200 0 NZST} - {278431200 46800 1 NZDT} - {289317600 43200 0 NZST} - {309880800 46800 1 NZDT} - {320767200 43200 0 NZST} - {341330400 46800 1 NZDT} - {352216800 43200 0 NZST} - {372780000 46800 1 NZDT} - {384271200 43200 0 NZST} - {404834400 46800 1 NZDT} - {415720800 43200 0 NZST} - {436284000 46800 1 NZDT} - {447170400 43200 0 NZST} - {467733600 46800 1 NZDT} - {478620000 43200 0 NZST} - {499183200 46800 1 NZDT} - {510069600 43200 0 NZST} - {530632800 46800 1 NZDT} - {541519200 43200 0 NZST} - {562082400 46800 1 NZDT} - {573573600 43200 0 NZST} - {594136800 46800 1 NZDT} - {605023200 43200 0 NZST} - {623772000 46800 1 NZDT} - {637682400 43200 0 NZST} - {655221600 46800 1 NZDT} - {669132000 43200 0 NZST} - {686671200 46800 1 NZDT} - {700581600 43200 0 NZST} - {718120800 46800 1 NZDT} - {732636000 43200 0 NZST} - {749570400 46800 1 NZDT} - {764085600 43200 0 NZST} - {781020000 46800 1 NZDT} - {795535200 43200 0 NZST} - {812469600 46800 1 NZDT} - {826984800 43200 0 NZST} - {844524000 46800 1 NZDT} - {858434400 43200 0 NZST} - {875973600 46800 1 NZDT} - {889884000 43200 0 NZST} - {907423200 46800 1 NZDT} - {921938400 43200 0 NZST} - {938872800 46800 1 NZDT} - {953388000 43200 0 NZST} - {970322400 46800 1 NZDT} - {984837600 43200 0 NZST} - {1002376800 46800 1 NZDT} - {1016287200 43200 0 NZST} - {1033826400 46800 1 NZDT} - {1047736800 43200 0 NZST} - {1065276000 46800 1 NZDT} - {1079791200 43200 0 NZST} - {1096725600 46800 1 NZDT} - {1111240800 43200 0 NZST} - {1128175200 46800 1 NZDT} - {1142690400 43200 0 NZST} - {1159624800 46800 1 NZDT} - {1174140000 43200 0 NZST} - {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} +if {![info exists TZData(Pacific/Auckland)]} { + LoadTimeZoneFile Pacific/Auckland } +set TZData(:Antarctica/McMurdo) $TZData(:Pacific/Auckland) diff --git a/library/tzdata/Antarctica/Palmer b/library/tzdata/Antarctica/Palmer index 601a684..e87b171 100644 --- a/library/tzdata/Antarctica/Palmer +++ b/library/tzdata/Antarctica/Palmer @@ -77,178 +77,178 @@ set TZData(:Antarctica/Palmer) { {1313899200 -10800 1 CLST} {1335668400 -14400 0 CLT} {1346558400 -10800 1 CLST} - {1362884400 -14400 0 CLT} - {1381636800 -10800 1 CLST} - {1394334000 -14400 0 CLT} - {1413086400 -10800 1 CLST} - {1426388400 -14400 0 CLT} - {1444536000 -10800 1 CLST} - {1457838000 -14400 0 CLT} - {1475985600 -10800 1 CLST} - {1489287600 -14400 0 CLT} - {1508040000 -10800 1 CLST} - {1520737200 -14400 0 CLT} - {1539489600 -10800 1 CLST} - {1552186800 -14400 0 CLT} - {1570939200 -10800 1 CLST} - {1584241200 -14400 0 CLT} - {1602388800 -10800 1 CLST} - {1615690800 -14400 0 CLT} - {1633838400 -10800 1 CLST} - {1647140400 -14400 0 CLT} - {1665288000 -10800 1 CLST} - {1678590000 -14400 0 CLT} - {1697342400 -10800 1 CLST} - {1710039600 -14400 0 CLT} - {1728792000 -10800 1 CLST} - {1741489200 -14400 0 CLT} - {1760241600 -10800 1 CLST} - {1773543600 -14400 0 CLT} - {1791691200 -10800 1 CLST} - {1804993200 -14400 0 CLT} - {1823140800 -10800 1 CLST} - {1836442800 -14400 0 CLT} - {1855195200 -10800 1 CLST} - {1867892400 -14400 0 CLT} - {1886644800 -10800 1 CLST} - {1899342000 -14400 0 CLT} - {1918094400 -10800 1 CLST} - {1930791600 -14400 0 CLT} - {1949544000 -10800 1 CLST} - {1962846000 -14400 0 CLT} - {1980993600 -10800 1 CLST} - {1994295600 -14400 0 CLT} - {2012443200 -10800 1 CLST} - {2025745200 -14400 0 CLT} - {2044497600 -10800 1 CLST} - {2057194800 -14400 0 CLT} - {2075947200 -10800 1 CLST} - {2088644400 -14400 0 CLT} - {2107396800 -10800 1 CLST} - {2120698800 -14400 0 CLT} - {2138846400 -10800 1 CLST} - {2152148400 -14400 0 CLT} - {2170296000 -10800 1 CLST} - {2183598000 -14400 0 CLT} - {2201745600 -10800 1 CLST} - {2215047600 -14400 0 CLT} - {2233800000 -10800 1 CLST} - {2246497200 -14400 0 CLT} - {2265249600 -10800 1 CLST} - {2277946800 -14400 0 CLT} - {2296699200 -10800 1 CLST} - {2310001200 -14400 0 CLT} - {2328148800 -10800 1 CLST} - {2341450800 -14400 0 CLT} - {2359598400 -10800 1 CLST} - {2372900400 -14400 0 CLT} - {2391652800 -10800 1 CLST} - {2404350000 -14400 0 CLT} - {2423102400 -10800 1 CLST} - {2435799600 -14400 0 CLT} - {2454552000 -10800 1 CLST} - {2467854000 -14400 0 CLT} - {2486001600 -10800 1 CLST} - {2499303600 -14400 0 CLT} - {2517451200 -10800 1 CLST} - {2530753200 -14400 0 CLT} - {2548900800 -10800 1 CLST} - {2562202800 -14400 0 CLT} - {2580955200 -10800 1 CLST} - {2593652400 -14400 0 CLT} - {2612404800 -10800 1 CLST} - {2625102000 -14400 0 CLT} - {2643854400 -10800 1 CLST} - {2657156400 -14400 0 CLT} - {2675304000 -10800 1 CLST} - {2688606000 -14400 0 CLT} - {2706753600 -10800 1 CLST} - {2720055600 -14400 0 CLT} - {2738808000 -10800 1 CLST} - {2751505200 -14400 0 CLT} - {2770257600 -10800 1 CLST} - {2782954800 -14400 0 CLT} - {2801707200 -10800 1 CLST} - {2814404400 -14400 0 CLT} - {2833156800 -10800 1 CLST} - {2846458800 -14400 0 CLT} - {2864606400 -10800 1 CLST} - {2877908400 -14400 0 CLT} - {2896056000 -10800 1 CLST} - {2909358000 -14400 0 CLT} - {2928110400 -10800 1 CLST} - {2940807600 -14400 0 CLT} - {2959560000 -10800 1 CLST} - {2972257200 -14400 0 CLT} - {2991009600 -10800 1 CLST} - {3004311600 -14400 0 CLT} - {3022459200 -10800 1 CLST} - {3035761200 -14400 0 CLT} - {3053908800 -10800 1 CLST} - {3067210800 -14400 0 CLT} - {3085358400 -10800 1 CLST} - {3098660400 -14400 0 CLT} - {3117412800 -10800 1 CLST} - {3130110000 -14400 0 CLT} - {3148862400 -10800 1 CLST} - {3161559600 -14400 0 CLT} - {3180312000 -10800 1 CLST} - {3193614000 -14400 0 CLT} - {3211761600 -10800 1 CLST} - {3225063600 -14400 0 CLT} - {3243211200 -10800 1 CLST} - {3256513200 -14400 0 CLT} - {3275265600 -10800 1 CLST} - {3287962800 -14400 0 CLT} - {3306715200 -10800 1 CLST} - {3319412400 -14400 0 CLT} - {3338164800 -10800 1 CLST} - {3351466800 -14400 0 CLT} - {3369614400 -10800 1 CLST} - {3382916400 -14400 0 CLT} - {3401064000 -10800 1 CLST} - {3414366000 -14400 0 CLT} - {3432513600 -10800 1 CLST} - {3445815600 -14400 0 CLT} - {3464568000 -10800 1 CLST} - {3477265200 -14400 0 CLT} - {3496017600 -10800 1 CLST} - {3508714800 -14400 0 CLT} - {3527467200 -10800 1 CLST} - {3540769200 -14400 0 CLT} - {3558916800 -10800 1 CLST} - {3572218800 -14400 0 CLT} - {3590366400 -10800 1 CLST} - {3603668400 -14400 0 CLT} - {3622420800 -10800 1 CLST} - {3635118000 -14400 0 CLT} - {3653870400 -10800 1 CLST} - {3666567600 -14400 0 CLT} - {3685320000 -10800 1 CLST} - {3698017200 -14400 0 CLT} - {3716769600 -10800 1 CLST} - {3730071600 -14400 0 CLT} - {3748219200 -10800 1 CLST} - {3761521200 -14400 0 CLT} - {3779668800 -10800 1 CLST} - {3792970800 -14400 0 CLT} - {3811723200 -10800 1 CLST} - {3824420400 -14400 0 CLT} - {3843172800 -10800 1 CLST} - {3855870000 -14400 0 CLT} - {3874622400 -10800 1 CLST} - {3887924400 -14400 0 CLT} - {3906072000 -10800 1 CLST} - {3919374000 -14400 0 CLT} - {3937521600 -10800 1 CLST} - {3950823600 -14400 0 CLT} - {3968971200 -10800 1 CLST} - {3982273200 -14400 0 CLT} - {4001025600 -10800 1 CLST} - {4013722800 -14400 0 CLT} - {4032475200 -10800 1 CLST} - {4045172400 -14400 0 CLT} - {4063924800 -10800 1 CLST} - {4077226800 -14400 0 CLT} - {4095374400 -10800 1 CLST} + {1367118000 -14400 0 CLT} + {1378612800 -10800 1 CLST} + {1398567600 -14400 0 CLT} + {1410062400 -10800 1 CLST} + {1430017200 -14400 0 CLT} + {1441512000 -10800 1 CLST} + {1461466800 -14400 0 CLT} + {1472961600 -10800 1 CLST} + {1492916400 -14400 0 CLT} + {1504411200 -10800 1 CLST} + {1524970800 -14400 0 CLT} + {1535860800 -10800 1 CLST} + {1556420400 -14400 0 CLT} + {1567915200 -10800 1 CLST} + {1587870000 -14400 0 CLT} + {1599364800 -10800 1 CLST} + {1619319600 -14400 0 CLT} + {1630814400 -10800 1 CLST} + {1650769200 -14400 0 CLT} + {1662264000 -10800 1 CLST} + {1682218800 -14400 0 CLT} + {1693713600 -10800 1 CLST} + {1714273200 -14400 0 CLT} + {1725768000 -10800 1 CLST} + {1745722800 -14400 0 CLT} + {1757217600 -10800 1 CLST} + {1777172400 -14400 0 CLT} + {1788667200 -10800 1 CLST} + {1808622000 -14400 0 CLT} + {1820116800 -10800 1 CLST} + {1840071600 -14400 0 CLT} + {1851566400 -10800 1 CLST} + {1872126000 -14400 0 CLT} + {1883016000 -10800 1 CLST} + {1903575600 -14400 0 CLT} + {1915070400 -10800 1 CLST} + {1935025200 -14400 0 CLT} + {1946520000 -10800 1 CLST} + {1966474800 -14400 0 CLT} + {1977969600 -10800 1 CLST} + {1997924400 -14400 0 CLT} + {2009419200 -10800 1 CLST} + {2029374000 -14400 0 CLT} + {2040868800 -10800 1 CLST} + {2061428400 -14400 0 CLT} + {2072318400 -10800 1 CLST} + {2092878000 -14400 0 CLT} + {2104372800 -10800 1 CLST} + {2124327600 -14400 0 CLT} + {2135822400 -10800 1 CLST} + {2155777200 -14400 0 CLT} + {2167272000 -10800 1 CLST} + {2187226800 -14400 0 CLT} + {2198721600 -10800 1 CLST} + {2219281200 -14400 0 CLT} + {2230171200 -10800 1 CLST} + {2250730800 -14400 0 CLT} + {2262225600 -10800 1 CLST} + {2282180400 -14400 0 CLT} + {2293675200 -10800 1 CLST} + {2313630000 -14400 0 CLT} + {2325124800 -10800 1 CLST} + {2345079600 -14400 0 CLT} + {2356574400 -10800 1 CLST} + {2376529200 -14400 0 CLT} + {2388024000 -10800 1 CLST} + {2408583600 -14400 0 CLT} + {2419473600 -10800 1 CLST} + {2440033200 -14400 0 CLT} + {2451528000 -10800 1 CLST} + {2471482800 -14400 0 CLT} + {2482977600 -10800 1 CLST} + {2502932400 -14400 0 CLT} + {2514427200 -10800 1 CLST} + {2534382000 -14400 0 CLT} + {2545876800 -10800 1 CLST} + {2565831600 -14400 0 CLT} + {2577326400 -10800 1 CLST} + {2597886000 -14400 0 CLT} + {2609380800 -10800 1 CLST} + {2629335600 -14400 0 CLT} + {2640830400 -10800 1 CLST} + {2660785200 -14400 0 CLT} + {2672280000 -10800 1 CLST} + {2692234800 -14400 0 CLT} + {2703729600 -10800 1 CLST} + {2723684400 -14400 0 CLT} + {2735179200 -10800 1 CLST} + {2755738800 -14400 0 CLT} + {2766628800 -10800 1 CLST} + {2787188400 -14400 0 CLT} + {2798683200 -10800 1 CLST} + {2818638000 -14400 0 CLT} + {2830132800 -10800 1 CLST} + {2850087600 -14400 0 CLT} + {2861582400 -10800 1 CLST} + {2881537200 -14400 0 CLT} + {2893032000 -10800 1 CLST} + {2912986800 -14400 0 CLT} + {2924481600 -10800 1 CLST} + {2945041200 -14400 0 CLT} + {2955931200 -10800 1 CLST} + {2976490800 -14400 0 CLT} + {2987985600 -10800 1 CLST} + {3007940400 -14400 0 CLT} + {3019435200 -10800 1 CLST} + {3039390000 -14400 0 CLT} + {3050884800 -10800 1 CLST} + {3070839600 -14400 0 CLT} + {3082334400 -10800 1 CLST} + {3102894000 -14400 0 CLT} + {3113784000 -10800 1 CLST} + {3134343600 -14400 0 CLT} + {3145838400 -10800 1 CLST} + {3165793200 -14400 0 CLT} + {3177288000 -10800 1 CLST} + {3197242800 -14400 0 CLT} + {3208737600 -10800 1 CLST} + {3228692400 -14400 0 CLT} + {3240187200 -10800 1 CLST} + {3260142000 -14400 0 CLT} + {3271636800 -10800 1 CLST} + {3292196400 -14400 0 CLT} + {3303086400 -10800 1 CLST} + {3323646000 -14400 0 CLT} + {3335140800 -10800 1 CLST} + {3355095600 -14400 0 CLT} + {3366590400 -10800 1 CLST} + {3386545200 -14400 0 CLT} + {3398040000 -10800 1 CLST} + {3417994800 -14400 0 CLT} + {3429489600 -10800 1 CLST} + {3449444400 -14400 0 CLT} + {3460939200 -10800 1 CLST} + {3481498800 -14400 0 CLT} + {3492993600 -10800 1 CLST} + {3512948400 -14400 0 CLT} + {3524443200 -10800 1 CLST} + {3544398000 -14400 0 CLT} + {3555892800 -10800 1 CLST} + {3575847600 -14400 0 CLT} + {3587342400 -10800 1 CLST} + {3607297200 -14400 0 CLT} + {3618792000 -10800 1 CLST} + {3639351600 -14400 0 CLT} + {3650241600 -10800 1 CLST} + {3670801200 -14400 0 CLT} + {3682296000 -10800 1 CLST} + {3702250800 -14400 0 CLT} + {3713745600 -10800 1 CLST} + {3733700400 -14400 0 CLT} + {3745195200 -10800 1 CLST} + {3765150000 -14400 0 CLT} + {3776644800 -10800 1 CLST} + {3796599600 -14400 0 CLT} + {3808094400 -10800 1 CLST} + {3828654000 -14400 0 CLT} + {3839544000 -10800 1 CLST} + {3860103600 -14400 0 CLT} + {3871598400 -10800 1 CLST} + {3891553200 -14400 0 CLT} + {3903048000 -10800 1 CLST} + {3923002800 -14400 0 CLT} + {3934497600 -10800 1 CLST} + {3954452400 -14400 0 CLT} + {3965947200 -10800 1 CLST} + {3986506800 -14400 0 CLT} + {3997396800 -10800 1 CLST} + {4017956400 -14400 0 CLT} + {4029451200 -10800 1 CLST} + {4049406000 -14400 0 CLT} + {4060900800 -10800 1 CLST} + {4080855600 -14400 0 CLT} + {4092350400 -10800 1 CLST} } diff --git a/library/tzdata/Antarctica/South_Pole b/library/tzdata/Antarctica/South_Pole index 34d0db1..544bde4 100644 --- a/library/tzdata/Antarctica/South_Pole +++ b/library/tzdata/Antarctica/South_Pole @@ -1,5 +1,5 @@ # created by tools/tclZIC.tcl - do not edit -if {![info exists TZData(Antarctica/McMurdo)]} { - LoadTimeZoneFile Antarctica/McMurdo +if {![info exists TZData(Pacific/Auckland)]} { + LoadTimeZoneFile Pacific/Auckland } -set TZData(:Antarctica/South_Pole) $TZData(:Antarctica/McMurdo) +set TZData(:Antarctica/South_Pole) $TZData(:Pacific/Auckland) diff --git a/library/tzdata/Asia/Aden b/library/tzdata/Asia/Aden index e939235..399d9f0 100644 --- a/library/tzdata/Asia/Aden +++ b/library/tzdata/Asia/Aden @@ -1,6 +1,6 @@ # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Aden) { - {-9223372036854775808 10848 0 LMT} - {-631162848 10800 0 AST} + {-9223372036854775808 10794 0 LMT} + {-631162794 10800 0 AST} } diff --git a/library/tzdata/Asia/Amman b/library/tzdata/Asia/Amman index 33f0ba7..d5e8616 100644 --- a/library/tzdata/Asia/Amman +++ b/library/tzdata/Asia/Amman @@ -70,178 +70,5 @@ set TZData(:Asia/Amman) { {1301608800 10800 1 EEST} {1319752800 7200 0 EET} {1333058400 10800 1 EEST} - {1364504400 10800 1 EEST} - {1382652000 7200 0 EET} - {1395957600 10800 1 EEST} - {1414706400 7200 0 EET} - {1427407200 10800 1 EEST} - {1446156000 7200 0 EET} - {1459461600 10800 1 EEST} - {1477605600 7200 0 EET} - {1490911200 10800 1 EEST} - {1509055200 7200 0 EET} - {1522360800 10800 1 EEST} - {1540504800 7200 0 EET} - {1553810400 10800 1 EEST} - {1571954400 7200 0 EET} - {1585260000 10800 1 EEST} - {1604008800 7200 0 EET} - {1616709600 10800 1 EEST} - {1635458400 7200 0 EET} - {1648764000 10800 1 EEST} - {1666908000 7200 0 EET} - {1680213600 10800 1 EEST} - {1698357600 7200 0 EET} - {1711663200 10800 1 EEST} - {1729807200 7200 0 EET} - {1743112800 10800 1 EEST} - {1761861600 7200 0 EET} - {1774562400 10800 1 EEST} - {1793311200 7200 0 EET} - {1806012000 10800 1 EEST} - {1824760800 7200 0 EET} - {1838066400 10800 1 EEST} - {1856210400 7200 0 EET} - {1869516000 10800 1 EEST} - {1887660000 7200 0 EET} - {1900965600 10800 1 EEST} - {1919109600 7200 0 EET} - {1932415200 10800 1 EEST} - {1951164000 7200 0 EET} - {1963864800 10800 1 EEST} - {1982613600 7200 0 EET} - {1995919200 10800 1 EEST} - {2014063200 7200 0 EET} - {2027368800 10800 1 EEST} - {2045512800 7200 0 EET} - {2058818400 10800 1 EEST} - {2076962400 7200 0 EET} - {2090268000 10800 1 EEST} - {2109016800 7200 0 EET} - {2121717600 10800 1 EEST} - {2140466400 7200 0 EET} - {2153167200 10800 1 EEST} - {2171916000 7200 0 EET} - {2185221600 10800 1 EEST} - {2203365600 7200 0 EET} - {2216671200 10800 1 EEST} - {2234815200 7200 0 EET} - {2248120800 10800 1 EEST} - {2266264800 7200 0 EET} - {2279570400 10800 1 EEST} - {2298319200 7200 0 EET} - {2311020000 10800 1 EEST} - {2329768800 7200 0 EET} - {2343074400 10800 1 EEST} - {2361218400 7200 0 EET} - {2374524000 10800 1 EEST} - {2392668000 7200 0 EET} - {2405973600 10800 1 EEST} - {2424117600 7200 0 EET} - {2437423200 10800 1 EEST} - {2455567200 7200 0 EET} - {2468872800 10800 1 EEST} - {2487621600 7200 0 EET} - {2500322400 10800 1 EEST} - {2519071200 7200 0 EET} - {2532376800 10800 1 EEST} - {2550520800 7200 0 EET} - {2563826400 10800 1 EEST} - {2581970400 7200 0 EET} - {2595276000 10800 1 EEST} - {2613420000 7200 0 EET} - {2626725600 10800 1 EEST} - {2645474400 7200 0 EET} - {2658175200 10800 1 EEST} - {2676924000 7200 0 EET} - {2689624800 10800 1 EEST} - {2708373600 7200 0 EET} - {2721679200 10800 1 EEST} - {2739823200 7200 0 EET} - {2753128800 10800 1 EEST} - {2771272800 7200 0 EET} - {2784578400 10800 1 EEST} - {2802722400 7200 0 EET} - {2816028000 10800 1 EEST} - {2834776800 7200 0 EET} - {2847477600 10800 1 EEST} - {2866226400 7200 0 EET} - {2879532000 10800 1 EEST} - {2897676000 7200 0 EET} - {2910981600 10800 1 EEST} - {2929125600 7200 0 EET} - {2942431200 10800 1 EEST} - {2960575200 7200 0 EET} - {2973880800 10800 1 EEST} - {2992629600 7200 0 EET} - {3005330400 10800 1 EEST} - {3024079200 7200 0 EET} - {3036780000 10800 1 EEST} - {3055528800 7200 0 EET} - {3068834400 10800 1 EEST} - {3086978400 7200 0 EET} - {3100284000 10800 1 EEST} - {3118428000 7200 0 EET} - {3131733600 10800 1 EEST} - {3149877600 7200 0 EET} - {3163183200 10800 1 EEST} - {3181932000 7200 0 EET} - {3194632800 10800 1 EEST} - {3213381600 7200 0 EET} - {3226687200 10800 1 EEST} - {3244831200 7200 0 EET} - {3258136800 10800 1 EEST} - {3276280800 7200 0 EET} - {3289586400 10800 1 EEST} - {3307730400 7200 0 EET} - {3321036000 10800 1 EEST} - {3339180000 7200 0 EET} - {3352485600 10800 1 EEST} - {3371234400 7200 0 EET} - {3383935200 10800 1 EEST} - {3402684000 7200 0 EET} - {3415989600 10800 1 EEST} - {3434133600 7200 0 EET} - {3447439200 10800 1 EEST} - {3465583200 7200 0 EET} - {3478888800 10800 1 EEST} - {3497032800 7200 0 EET} - {3510338400 10800 1 EEST} - {3529087200 7200 0 EET} - {3541788000 10800 1 EEST} - {3560536800 7200 0 EET} - {3573237600 10800 1 EEST} - {3591986400 7200 0 EET} - {3605292000 10800 1 EEST} - {3623436000 7200 0 EET} - {3636741600 10800 1 EEST} - {3654885600 7200 0 EET} - {3668191200 10800 1 EEST} - {3686335200 7200 0 EET} - {3699640800 10800 1 EEST} - {3718389600 7200 0 EET} - {3731090400 10800 1 EEST} - {3749839200 7200 0 EET} - {3763144800 10800 1 EEST} - {3781288800 7200 0 EET} - {3794594400 10800 1 EEST} - {3812738400 7200 0 EET} - {3826044000 10800 1 EEST} - {3844188000 7200 0 EET} - {3857493600 10800 1 EEST} - {3876242400 7200 0 EET} - {3888943200 10800 1 EEST} - {3907692000 7200 0 EET} - {3920392800 10800 1 EEST} - {3939141600 7200 0 EET} - {3952447200 10800 1 EEST} - {3970591200 7200 0 EET} - {3983896800 10800 1 EEST} - {4002040800 7200 0 EET} - {4015346400 10800 1 EEST} - {4033490400 7200 0 EET} - {4046796000 10800 1 EEST} - {4065544800 7200 0 EET} - {4078245600 10800 1 EEST} - {4096994400 7200 0 EET} + {1351202400 10800 0 AST} } diff --git a/library/tzdata/Asia/Dili b/library/tzdata/Asia/Dili index 36910fd..f783557 100644 --- a/library/tzdata/Asia/Dili +++ b/library/tzdata/Asia/Dili @@ -5,6 +5,6 @@ set TZData(:Asia/Dili) { {-1830414140 28800 0 TLT} {-879152400 32400 0 JST} {-766054800 32400 0 TLT} - {199897200 28800 0 CIT} + {199897200 28800 0 WITA} {969120000 32400 0 TLT} } diff --git a/library/tzdata/Asia/Gaza b/library/tzdata/Asia/Gaza index 43e1847..7d62a96 100644 --- a/library/tzdata/Asia/Gaza +++ b/library/tzdata/Asia/Gaza @@ -88,14 +88,191 @@ set TZData(:Asia/Gaza) { {1158872400 7200 0 EET} {1175378400 10800 1 EEST} {1189638000 7200 0 EET} - {1207000800 10800 1 EEST} - {1219957200 7200 0 EET} + {1206655200 10800 1 EEST} + {1219960800 7200 0 EET} + {1220220000 7200 0 EET} {1238104800 10800 1 EEST} - {1252018800 7200 0 EET} - {1269640860 10800 1 EEST} + {1252015200 7200 0 EET} + {1262296800 7200 0 EET} + {1269640860 10800 0 EEST} {1281474000 7200 0 EET} - {1301738460 10800 1 EEST} - {1312146000 7200 0 EET} + {1301608860 10800 1 EEST} + {1312149600 7200 0 EET} + {1325368800 7200 0 EET} {1333058400 10800 1 EEST} {1348178400 7200 0 EET} + {1364508000 10800 1 EEST} + {1380229200 7200 0 EET} + {1395957600 10800 1 EEST} + {1411678800 7200 0 EET} + {1427407200 10800 1 EEST} + {1443128400 7200 0 EET} + {1459461600 10800 1 EEST} + {1474578000 7200 0 EET} + {1490911200 10800 1 EEST} + {1506027600 7200 0 EET} + {1522360800 10800 1 EEST} + {1537477200 7200 0 EET} + {1553810400 10800 1 EEST} + {1569531600 7200 0 EET} + {1585260000 10800 1 EEST} + {1600981200 7200 0 EET} + {1616709600 10800 1 EEST} + {1632430800 7200 0 EET} + {1648764000 10800 1 EEST} + {1663880400 7200 0 EET} + {1680213600 10800 1 EEST} + {1695330000 7200 0 EET} + {1711663200 10800 1 EEST} + {1727384400 7200 0 EET} + {1743112800 10800 1 EEST} + {1758834000 7200 0 EET} + {1774562400 10800 1 EEST} + {1790283600 7200 0 EET} + {1806012000 10800 1 EEST} + {1821733200 7200 0 EET} + {1838066400 10800 1 EEST} + {1853182800 7200 0 EET} + {1869516000 10800 1 EEST} + {1884632400 7200 0 EET} + {1900965600 10800 1 EEST} + {1916686800 7200 0 EET} + {1932415200 10800 1 EEST} + {1948136400 7200 0 EET} + {1963864800 10800 1 EEST} + {1979586000 7200 0 EET} + {1995919200 10800 1 EEST} + {2011035600 7200 0 EET} + {2027368800 10800 1 EEST} + {2042485200 7200 0 EET} + {2058818400 10800 1 EEST} + {2073934800 7200 0 EET} + {2090268000 10800 1 EEST} + {2105989200 7200 0 EET} + {2121717600 10800 1 EEST} + {2137438800 7200 0 EET} + {2153167200 10800 1 EEST} + {2168888400 7200 0 EET} + {2185221600 10800 1 EEST} + {2200338000 7200 0 EET} + {2216671200 10800 1 EEST} + {2231787600 7200 0 EET} + {2248120800 10800 1 EEST} + {2263842000 7200 0 EET} + {2279570400 10800 1 EEST} + {2295291600 7200 0 EET} + {2311020000 10800 1 EEST} + {2326741200 7200 0 EET} + {2343074400 10800 1 EEST} + {2358190800 7200 0 EET} + {2374524000 10800 1 EEST} + {2389640400 7200 0 EET} + {2405973600 10800 1 EEST} + {2421090000 7200 0 EET} + {2437423200 10800 1 EEST} + {2453144400 7200 0 EET} + {2468872800 10800 1 EEST} + {2484594000 7200 0 EET} + {2500322400 10800 1 EEST} + {2516043600 7200 0 EET} + {2532376800 10800 1 EEST} + {2547493200 7200 0 EET} + {2563826400 10800 1 EEST} + {2578942800 7200 0 EET} + {2595276000 10800 1 EEST} + {2610997200 7200 0 EET} + {2626725600 10800 1 EEST} + {2642446800 7200 0 EET} + {2658175200 10800 1 EEST} + {2673896400 7200 0 EET} + {2689624800 10800 1 EEST} + {2705346000 7200 0 EET} + {2721679200 10800 1 EEST} + {2736795600 7200 0 EET} + {2753128800 10800 1 EEST} + {2768245200 7200 0 EET} + {2784578400 10800 1 EEST} + {2800299600 7200 0 EET} + {2816028000 10800 1 EEST} + {2831749200 7200 0 EET} + {2847477600 10800 1 EEST} + {2863198800 7200 0 EET} + {2879532000 10800 1 EEST} + {2894648400 7200 0 EET} + {2910981600 10800 1 EEST} + {2926098000 7200 0 EET} + {2942431200 10800 1 EEST} + {2957547600 7200 0 EET} + {2973880800 10800 1 EEST} + {2989602000 7200 0 EET} + {3005330400 10800 1 EEST} + {3021051600 7200 0 EET} + {3036780000 10800 1 EEST} + {3052501200 7200 0 EET} + {3068834400 10800 1 EEST} + {3083950800 7200 0 EET} + {3100284000 10800 1 EEST} + {3115400400 7200 0 EET} + {3131733600 10800 1 EEST} + {3147454800 7200 0 EET} + {3163183200 10800 1 EEST} + {3178904400 7200 0 EET} + {3194632800 10800 1 EEST} + {3210354000 7200 0 EET} + {3226687200 10800 1 EEST} + {3241803600 7200 0 EET} + {3258136800 10800 1 EEST} + {3273253200 7200 0 EET} + {3289586400 10800 1 EEST} + {3304702800 7200 0 EET} + {3321036000 10800 1 EEST} + {3336757200 7200 0 EET} + {3352485600 10800 1 EEST} + {3368206800 7200 0 EET} + {3383935200 10800 1 EEST} + {3399656400 7200 0 EET} + {3415989600 10800 1 EEST} + {3431106000 7200 0 EET} + {3447439200 10800 1 EEST} + {3462555600 7200 0 EET} + {3478888800 10800 1 EEST} + {3494610000 7200 0 EET} + {3510338400 10800 1 EEST} + {3526059600 7200 0 EET} + {3541788000 10800 1 EEST} + {3557509200 7200 0 EET} + {3573237600 10800 1 EEST} + {3588958800 7200 0 EET} + {3605292000 10800 1 EEST} + {3620408400 7200 0 EET} + {3636741600 10800 1 EEST} + {3651858000 7200 0 EET} + {3668191200 10800 1 EEST} + {3683912400 7200 0 EET} + {3699640800 10800 1 EEST} + {3715362000 7200 0 EET} + {3731090400 10800 1 EEST} + {3746811600 7200 0 EET} + {3763144800 10800 1 EEST} + {3778261200 7200 0 EET} + {3794594400 10800 1 EEST} + {3809710800 7200 0 EET} + {3826044000 10800 1 EEST} + {3841160400 7200 0 EET} + {3857493600 10800 1 EEST} + {3873214800 7200 0 EET} + {3888943200 10800 1 EEST} + {3904664400 7200 0 EET} + {3920392800 10800 1 EEST} + {3936114000 7200 0 EET} + {3952447200 10800 1 EEST} + {3967563600 7200 0 EET} + {3983896800 10800 1 EEST} + {3999013200 7200 0 EET} + {4015346400 10800 1 EEST} + {4031067600 7200 0 EET} + {4046796000 10800 1 EEST} + {4062517200 7200 0 EET} + {4078245600 10800 1 EEST} + {4093966800 7200 0 EET} } diff --git a/library/tzdata/Asia/Hebron b/library/tzdata/Asia/Hebron index 98bb353..1333d5a 100644 --- a/library/tzdata/Asia/Hebron +++ b/library/tzdata/Asia/Hebron @@ -88,17 +88,190 @@ set TZData(:Asia/Hebron) { {1158872400 7200 0 EET} {1175378400 10800 1 EEST} {1189638000 7200 0 EET} - {1207000800 10800 1 EEST} - {1217541600 10800 1 EEST} + {1206655200 10800 1 EEST} {1220216400 7200 0 EET} {1238104800 10800 1 EEST} - {1252018800 7200 0 EET} - {1269640860 10800 1 EEST} + {1252015200 7200 0 EET} + {1269554400 10800 1 EEST} {1281474000 7200 0 EET} - {1301652060 10800 1 EEST} + {1301608860 10800 1 EEST} {1312146000 7200 0 EET} {1314655200 10800 1 EEST} - {1317340800 7200 0 EET} + {1317330000 7200 0 EET} {1333058400 10800 1 EEST} {1348178400 7200 0 EET} + {1364508000 10800 1 EEST} + {1380229200 7200 0 EET} + {1395957600 10800 1 EEST} + {1411678800 7200 0 EET} + {1427407200 10800 1 EEST} + {1443128400 7200 0 EET} + {1459461600 10800 1 EEST} + {1474578000 7200 0 EET} + {1490911200 10800 1 EEST} + {1506027600 7200 0 EET} + {1522360800 10800 1 EEST} + {1537477200 7200 0 EET} + {1553810400 10800 1 EEST} + {1569531600 7200 0 EET} + {1585260000 10800 1 EEST} + {1600981200 7200 0 EET} + {1616709600 10800 1 EEST} + {1632430800 7200 0 EET} + {1648764000 10800 1 EEST} + {1663880400 7200 0 EET} + {1680213600 10800 1 EEST} + {1695330000 7200 0 EET} + {1711663200 10800 1 EEST} + {1727384400 7200 0 EET} + {1743112800 10800 1 EEST} + {1758834000 7200 0 EET} + {1774562400 10800 1 EEST} + {1790283600 7200 0 EET} + {1806012000 10800 1 EEST} + {1821733200 7200 0 EET} + {1838066400 10800 1 EEST} + {1853182800 7200 0 EET} + {1869516000 10800 1 EEST} + {1884632400 7200 0 EET} + {1900965600 10800 1 EEST} + {1916686800 7200 0 EET} + {1932415200 10800 1 EEST} + {1948136400 7200 0 EET} + {1963864800 10800 1 EEST} + {1979586000 7200 0 EET} + {1995919200 10800 1 EEST} + {2011035600 7200 0 EET} + {2027368800 10800 1 EEST} + {2042485200 7200 0 EET} + {2058818400 10800 1 EEST} + {2073934800 7200 0 EET} + {2090268000 10800 1 EEST} + {2105989200 7200 0 EET} + {2121717600 10800 1 EEST} + {2137438800 7200 0 EET} + {2153167200 10800 1 EEST} + {2168888400 7200 0 EET} + {2185221600 10800 1 EEST} + {2200338000 7200 0 EET} + {2216671200 10800 1 EEST} + {2231787600 7200 0 EET} + {2248120800 10800 1 EEST} + {2263842000 7200 0 EET} + {2279570400 10800 1 EEST} + {2295291600 7200 0 EET} + {2311020000 10800 1 EEST} + {2326741200 7200 0 EET} + {2343074400 10800 1 EEST} + {2358190800 7200 0 EET} + {2374524000 10800 1 EEST} + {2389640400 7200 0 EET} + {2405973600 10800 1 EEST} + {2421090000 7200 0 EET} + {2437423200 10800 1 EEST} + {2453144400 7200 0 EET} + {2468872800 10800 1 EEST} + {2484594000 7200 0 EET} + {2500322400 10800 1 EEST} + {2516043600 7200 0 EET} + {2532376800 10800 1 EEST} + {2547493200 7200 0 EET} + {2563826400 10800 1 EEST} + {2578942800 7200 0 EET} + {2595276000 10800 1 EEST} + {2610997200 7200 0 EET} + {2626725600 10800 1 EEST} + {2642446800 7200 0 EET} + {2658175200 10800 1 EEST} + {2673896400 7200 0 EET} + {2689624800 10800 1 EEST} + {2705346000 7200 0 EET} + {2721679200 10800 1 EEST} + {2736795600 7200 0 EET} + {2753128800 10800 1 EEST} + {2768245200 7200 0 EET} + {2784578400 10800 1 EEST} + {2800299600 7200 0 EET} + {2816028000 10800 1 EEST} + {2831749200 7200 0 EET} + {2847477600 10800 1 EEST} + {2863198800 7200 0 EET} + {2879532000 10800 1 EEST} + {2894648400 7200 0 EET} + {2910981600 10800 1 EEST} + {2926098000 7200 0 EET} + {2942431200 10800 1 EEST} + {2957547600 7200 0 EET} + {2973880800 10800 1 EEST} + {2989602000 7200 0 EET} + {3005330400 10800 1 EEST} + {3021051600 7200 0 EET} + {3036780000 10800 1 EEST} + {3052501200 7200 0 EET} + {3068834400 10800 1 EEST} + {3083950800 7200 0 EET} + {3100284000 10800 1 EEST} + {3115400400 7200 0 EET} + {3131733600 10800 1 EEST} + {3147454800 7200 0 EET} + {3163183200 10800 1 EEST} + {3178904400 7200 0 EET} + {3194632800 10800 1 EEST} + {3210354000 7200 0 EET} + {3226687200 10800 1 EEST} + {3241803600 7200 0 EET} + {3258136800 10800 1 EEST} + {3273253200 7200 0 EET} + {3289586400 10800 1 EEST} + {3304702800 7200 0 EET} + {3321036000 10800 1 EEST} + {3336757200 7200 0 EET} + {3352485600 10800 1 EEST} + {3368206800 7200 0 EET} + {3383935200 10800 1 EEST} + {3399656400 7200 0 EET} + {3415989600 10800 1 EEST} + {3431106000 7200 0 EET} + {3447439200 10800 1 EEST} + {3462555600 7200 0 EET} + {3478888800 10800 1 EEST} + {3494610000 7200 0 EET} + {3510338400 10800 1 EEST} + {3526059600 7200 0 EET} + {3541788000 10800 1 EEST} + {3557509200 7200 0 EET} + {3573237600 10800 1 EEST} + {3588958800 7200 0 EET} + {3605292000 10800 1 EEST} + {3620408400 7200 0 EET} + {3636741600 10800 1 EEST} + {3651858000 7200 0 EET} + {3668191200 10800 1 EEST} + {3683912400 7200 0 EET} + {3699640800 10800 1 EEST} + {3715362000 7200 0 EET} + {3731090400 10800 1 EEST} + {3746811600 7200 0 EET} + {3763144800 10800 1 EEST} + {3778261200 7200 0 EET} + {3794594400 10800 1 EEST} + {3809710800 7200 0 EET} + {3826044000 10800 1 EEST} + {3841160400 7200 0 EET} + {3857493600 10800 1 EEST} + {3873214800 7200 0 EET} + {3888943200 10800 1 EEST} + {3904664400 7200 0 EET} + {3920392800 10800 1 EEST} + {3936114000 7200 0 EET} + {3952447200 10800 1 EEST} + {3967563600 7200 0 EET} + {3983896800 10800 1 EEST} + {3999013200 7200 0 EET} + {4015346400 10800 1 EEST} + {4031067600 7200 0 EET} + {4046796000 10800 1 EEST} + {4062517200 7200 0 EET} + {4078245600 10800 1 EEST} + {4093966800 7200 0 EET} } diff --git a/library/tzdata/Asia/Hong_Kong b/library/tzdata/Asia/Hong_Kong index 928cde6..fcf98a6 100644 --- a/library/tzdata/Asia/Hong_Kong +++ b/library/tzdata/Asia/Hong_Kong @@ -1,8 +1,8 @@ # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Hong_Kong) { - {-9223372036854775808 27396 0 LMT} - {-2056692996 28800 0 HKT} + {-9223372036854775808 27402 0 LMT} + {-2056693002 28800 0 HKT} {-907389000 32400 1 HKST} {-891667800 28800 0 HKT} {-884246400 32400 0 JST} diff --git a/library/tzdata/Asia/Jakarta b/library/tzdata/Asia/Jakarta index 27033e8..75cd659 100644 --- a/library/tzdata/Asia/Jakarta +++ b/library/tzdata/Asia/Jakarta @@ -2,12 +2,12 @@ set TZData(:Asia/Jakarta) { {-9223372036854775808 25632 0 LMT} - {-3231299232 25632 0 JMT} + {-3231299232 25632 0 BMT} {-1451719200 26400 0 JAVT} - {-1172906400 27000 0 WIT} + {-1172906400 27000 0 WIB} {-876641400 32400 0 JST} - {-766054800 27000 0 WIT} - {-683883000 28800 0 WIT} - {-620812800 27000 0 WIT} - {-189415800 25200 0 WIT} + {-766054800 27000 0 WIB} + {-683883000 28800 0 WIB} + {-620812800 27000 0 WIB} + {-189415800 25200 0 WIB} } diff --git a/library/tzdata/Asia/Jayapura b/library/tzdata/Asia/Jayapura index 893da8b..a71228f 100644 --- a/library/tzdata/Asia/Jayapura +++ b/library/tzdata/Asia/Jayapura @@ -2,7 +2,7 @@ set TZData(:Asia/Jayapura) { {-9223372036854775808 33768 0 LMT} - {-1172913768 32400 0 EIT} + {-1172913768 32400 0 WIT} {-799491600 34200 0 CST} - {-189423000 32400 0 EIT} + {-189423000 32400 0 WIT} } diff --git a/library/tzdata/Asia/Jerusalem b/library/tzdata/Asia/Jerusalem index 613eadd..7662680 100644 --- a/library/tzdata/Asia/Jerusalem +++ b/library/tzdata/Asia/Jerusalem @@ -1,8 +1,8 @@ # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Jerusalem) { - {-9223372036854775808 8456 0 LMT} - {-2840149256 8440 0 JMT} + {-9223372036854775808 8454 0 LMT} + {-2840149254 8440 0 JMT} {-1641003640 7200 0 IST} {-933645600 10800 1 IDT} {-857358000 7200 0 IST} @@ -96,177 +96,177 @@ set TZData(:Asia/Jerusalem) { {1333065600 10800 1 IDT} {1348354800 7200 0 IST} {1364515200 10800 1 IDT} - {1381014000 7200 0 IST} + {1382828400 7200 0 IST} {1395964800 10800 1 IDT} - {1412463600 7200 0 IST} + {1414278000 7200 0 IST} {1427414400 10800 1 IDT} - {1443913200 7200 0 IST} + {1445727600 7200 0 IST} {1458864000 10800 1 IDT} - {1475362800 7200 0 IST} + {1477782000 7200 0 IST} {1490313600 10800 1 IDT} - {1507417200 7200 0 IST} + {1509231600 7200 0 IST} {1521763200 10800 1 IDT} - {1538866800 7200 0 IST} + {1540681200 7200 0 IST} {1553817600 10800 1 IDT} - {1570316400 7200 0 IST} + {1572130800 7200 0 IST} {1585267200 10800 1 IDT} - {1601766000 7200 0 IST} + {1603580400 7200 0 IST} {1616716800 10800 1 IDT} - {1633215600 7200 0 IST} + {1635634800 7200 0 IST} {1648166400 10800 1 IDT} - {1664665200 7200 0 IST} + {1667084400 7200 0 IST} {1679616000 10800 1 IDT} - {1696719600 7200 0 IST} + {1698534000 7200 0 IST} {1711670400 10800 1 IDT} - {1728169200 7200 0 IST} + {1729983600 7200 0 IST} {1743120000 10800 1 IDT} - {1759618800 7200 0 IST} + {1761433200 7200 0 IST} {1774569600 10800 1 IDT} - {1791068400 7200 0 IST} + {1792882800 7200 0 IST} {1806019200 10800 1 IDT} - {1822604400 7200 0 IST} + {1824937200 7200 0 IST} {1837468800 10800 1 IDT} - {1854572400 7200 0 IST} + {1856386800 7200 0 IST} {1868918400 10800 1 IDT} - {1886022000 7200 0 IST} + {1887836400 7200 0 IST} {1900972800 10800 1 IDT} - {1917471600 7200 0 IST} + {1919286000 7200 0 IST} {1932422400 10800 1 IDT} - {1948921200 7200 0 IST} + {1950735600 7200 0 IST} {1963872000 10800 1 IDT} - {1980370800 7200 0 IST} + {1982790000 7200 0 IST} {1995321600 10800 1 IDT} - {2011820400 7200 0 IST} + {2014239600 7200 0 IST} {2026771200 10800 1 IDT} - {2043874800 7200 0 IST} + {2045689200 7200 0 IST} {2058220800 10800 1 IDT} - {2075324400 7200 0 IST} + {2077138800 7200 0 IST} {2090275200 10800 1 IDT} - {2106774000 7200 0 IST} + {2108588400 7200 0 IST} {2121724800 10800 1 IDT} - {2138223600 7200 0 IST} + {2140038000 7200 0 IST} {2153174400 10800 1 IDT} - {2169673200 7200 0 IST} + {2172092400 7200 0 IST} {2184624000 10800 1 IDT} - {2201122800 7200 0 IST} + {2203542000 7200 0 IST} {2216073600 10800 1 IDT} - {2233177200 7200 0 IST} + {2234991600 7200 0 IST} {2248128000 10800 1 IDT} - {2264626800 7200 0 IST} + {2266441200 7200 0 IST} {2279577600 10800 1 IDT} - {2296076400 7200 0 IST} + {2297890800 7200 0 IST} {2311027200 10800 1 IDT} - {2327526000 7200 0 IST} + {2329340400 7200 0 IST} {2342476800 10800 1 IDT} - {2358975600 7200 0 IST} + {2361394800 7200 0 IST} {2373926400 10800 1 IDT} - {2391030000 7200 0 IST} + {2392844400 7200 0 IST} {2405376000 10800 1 IDT} - {2422479600 7200 0 IST} + {2424294000 7200 0 IST} {2437430400 10800 1 IDT} - {2453929200 7200 0 IST} + {2455743600 7200 0 IST} {2468880000 10800 1 IDT} - {2485378800 7200 0 IST} + {2487193200 7200 0 IST} {2500329600 10800 1 IDT} - {2516828400 7200 0 IST} + {2519247600 7200 0 IST} {2531779200 10800 1 IDT} - {2548278000 7200 0 IST} + {2550697200 7200 0 IST} {2563228800 10800 1 IDT} - {2580332400 7200 0 IST} + {2582146800 7200 0 IST} {2595283200 10800 1 IDT} - {2611782000 7200 0 IST} + {2613596400 7200 0 IST} {2626732800 10800 1 IDT} - {2643231600 7200 0 IST} + {2645046000 7200 0 IST} {2658182400 10800 1 IDT} - {2674681200 7200 0 IST} + {2676495600 7200 0 IST} {2689632000 10800 1 IDT} - {2706130800 7200 0 IST} + {2708550000 7200 0 IST} {2721081600 10800 1 IDT} - {2738185200 7200 0 IST} + {2739999600 7200 0 IST} {2752531200 10800 1 IDT} - {2769634800 7200 0 IST} + {2771449200 7200 0 IST} {2784585600 10800 1 IDT} - {2801084400 7200 0 IST} + {2802898800 7200 0 IST} {2816035200 10800 1 IDT} - {2832534000 7200 0 IST} + {2834348400 7200 0 IST} {2847484800 10800 1 IDT} - {2863983600 7200 0 IST} + {2866402800 7200 0 IST} {2878934400 10800 1 IDT} - {2895433200 7200 0 IST} + {2897852400 7200 0 IST} {2910384000 10800 1 IDT} - {2927487600 7200 0 IST} + {2929302000 7200 0 IST} {2941833600 10800 1 IDT} - {2958937200 7200 0 IST} + {2960751600 7200 0 IST} {2973888000 10800 1 IDT} - {2990386800 7200 0 IST} + {2992201200 7200 0 IST} {3005337600 10800 1 IDT} - {3021836400 7200 0 IST} + {3023650800 7200 0 IST} {3036787200 10800 1 IDT} - {3053286000 7200 0 IST} + {3055705200 7200 0 IST} {3068236800 10800 1 IDT} - {3084735600 7200 0 IST} + {3087154800 7200 0 IST} {3099686400 10800 1 IDT} - {3116790000 7200 0 IST} + {3118604400 7200 0 IST} {3131740800 10800 1 IDT} - {3148239600 7200 0 IST} + {3150054000 7200 0 IST} {3163190400 10800 1 IDT} - {3179689200 7200 0 IST} + {3181503600 7200 0 IST} {3194640000 10800 1 IDT} - {3211138800 7200 0 IST} + {3212953200 7200 0 IST} {3226089600 10800 1 IDT} - {3242588400 7200 0 IST} + {3245007600 7200 0 IST} {3257539200 10800 1 IDT} - {3274642800 7200 0 IST} + {3276457200 7200 0 IST} {3288988800 10800 1 IDT} - {3306092400 7200 0 IST} + {3307906800 7200 0 IST} {3321043200 10800 1 IDT} - {3337542000 7200 0 IST} + {3339356400 7200 0 IST} {3352492800 10800 1 IDT} - {3368991600 7200 0 IST} + {3370806000 7200 0 IST} {3383942400 10800 1 IDT} - {3400441200 7200 0 IST} + {3402860400 7200 0 IST} {3415392000 10800 1 IDT} - {3431890800 7200 0 IST} + {3434310000 7200 0 IST} {3446841600 10800 1 IDT} - {3463945200 7200 0 IST} + {3465759600 7200 0 IST} {3478896000 10800 1 IDT} - {3495394800 7200 0 IST} + {3497209200 7200 0 IST} {3510345600 10800 1 IDT} - {3526844400 7200 0 IST} + {3528658800 7200 0 IST} {3541795200 10800 1 IDT} - {3558294000 7200 0 IST} + {3560108400 7200 0 IST} {3573244800 10800 1 IDT} - {3589743600 7200 0 IST} + {3592162800 7200 0 IST} {3604694400 10800 1 IDT} - {3621798000 7200 0 IST} + {3623612400 7200 0 IST} {3636144000 10800 1 IDT} - {3653247600 7200 0 IST} + {3655062000 7200 0 IST} {3668198400 10800 1 IDT} - {3684697200 7200 0 IST} + {3686511600 7200 0 IST} {3699648000 10800 1 IDT} - {3716146800 7200 0 IST} + {3717961200 7200 0 IST} {3731097600 10800 1 IDT} - {3747596400 7200 0 IST} + {3750015600 7200 0 IST} {3762547200 10800 1 IDT} - {3779046000 7200 0 IST} + {3781465200 7200 0 IST} {3793996800 10800 1 IDT} - {3811100400 7200 0 IST} + {3812914800 7200 0 IST} {3825446400 10800 1 IDT} - {3842550000 7200 0 IST} + {3844364400 7200 0 IST} {3857500800 10800 1 IDT} - {3873999600 7200 0 IST} + {3875814000 7200 0 IST} {3888950400 10800 1 IDT} - {3905449200 7200 0 IST} + {3907263600 7200 0 IST} {3920400000 10800 1 IDT} - {3936898800 7200 0 IST} + {3939318000 7200 0 IST} {3951849600 10800 1 IDT} - {3968348400 7200 0 IST} + {3970767600 7200 0 IST} {3983299200 10800 1 IDT} - {4000402800 7200 0 IST} + {4002217200 7200 0 IST} {4015353600 10800 1 IDT} - {4031852400 7200 0 IST} + {4033666800 7200 0 IST} {4046803200 10800 1 IDT} - {4063302000 7200 0 IST} + {4065116400 7200 0 IST} {4078252800 10800 1 IDT} - {4094751600 7200 0 IST} + {4096566000 7200 0 IST} } diff --git a/library/tzdata/Asia/Khandyga b/library/tzdata/Asia/Khandyga new file mode 100644 index 0000000..2464b9f --- /dev/null +++ b/library/tzdata/Asia/Khandyga @@ -0,0 +1,72 @@ +# created by tools/tclZIC.tcl - do not edit + +set TZData(:Asia/Khandyga) { + {-9223372036854775808 32533 0 LMT} + {-1579424533 28800 0 YAKT} + {-1247558400 32400 0 YAKMMTT} + {354898800 36000 1 YAKST} + {370706400 32400 0 YAKT} + {386434800 36000 1 YAKST} + {402242400 32400 0 YAKT} + {417970800 36000 1 YAKST} + {433778400 32400 0 YAKT} + {449593200 36000 1 YAKST} + {465325200 32400 0 YAKT} + {481050000 36000 1 YAKST} + {496774800 32400 0 YAKT} + {512499600 36000 1 YAKST} + {528224400 32400 0 YAKT} + {543949200 36000 1 YAKST} + {559674000 32400 0 YAKT} + {575398800 36000 1 YAKST} + {591123600 32400 0 YAKT} + {606848400 36000 1 YAKST} + {622573200 32400 0 YAKT} + {638298000 36000 1 YAKST} + {654627600 32400 0 YAKT} + {670352400 28800 0 YAKMMTT} + {670356000 32400 1 YAKST} + {686080800 28800 0 YAKT} + {695757600 32400 0 YAKMMTT} + {701791200 36000 1 YAKST} + {717512400 32400 0 YAKT} + {733251600 36000 1 YAKST} + {748976400 32400 0 YAKT} + {764701200 36000 1 YAKST} + {780426000 32400 0 YAKT} + {796150800 36000 1 YAKST} + {811875600 32400 0 YAKT} + {828205200 36000 1 YAKST} + {846349200 32400 0 YAKT} + {859654800 36000 1 YAKST} + {877798800 32400 0 YAKT} + {891104400 36000 1 YAKST} + {909248400 32400 0 YAKT} + {922554000 36000 1 YAKST} + {941302800 32400 0 YAKT} + {954003600 36000 1 YAKST} + {972752400 32400 0 YAKT} + {985453200 36000 1 YAKST} + {1004202000 32400 0 YAKT} + {1017507600 36000 1 YAKST} + {1035651600 32400 0 YAKT} + {1048957200 36000 1 YAKST} + {1067101200 32400 0 YAKT} + {1072882800 36000 0 VLAMMTT} + {1080403200 39600 1 VLAST} + {1099152000 36000 0 VLAT} + {1111852800 39600 1 VLAST} + {1130601600 36000 0 VLAT} + {1143302400 39600 1 VLAST} + {1162051200 36000 0 VLAT} + {1174752000 39600 1 VLAST} + {1193500800 36000 0 VLAT} + {1206806400 39600 1 VLAST} + {1224950400 36000 0 VLAT} + {1238256000 39600 1 VLAST} + {1256400000 36000 0 VLAT} + {1269705600 39600 1 VLAST} + {1288454400 36000 0 VLAT} + {1301155200 39600 0 VLAT} + {1315832400 36000 0 YAKT} +} diff --git a/library/tzdata/Asia/Makassar b/library/tzdata/Asia/Makassar index aa604b4..be947f3 100644 --- a/library/tzdata/Asia/Makassar +++ b/library/tzdata/Asia/Makassar @@ -3,7 +3,7 @@ set TZData(:Asia/Makassar) { {-9223372036854775808 28656 0 LMT} {-1577951856 28656 0 MMT} - {-1172908656 28800 0 CIT} + {-1172908656 28800 0 WITA} {-880272000 32400 0 JST} - {-766054800 28800 0 CIT} + {-766054800 28800 0 WITA} } diff --git a/library/tzdata/Asia/Muscat b/library/tzdata/Asia/Muscat index 21b5873..a69b880 100644 --- a/library/tzdata/Asia/Muscat +++ b/library/tzdata/Asia/Muscat @@ -1,6 +1,6 @@ # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Muscat) { - {-9223372036854775808 14060 0 LMT} - {-1577937260 14400 0 GST} + {-9223372036854775808 14064 0 LMT} + {-1577937264 14400 0 GST} } diff --git a/library/tzdata/Asia/Pontianak b/library/tzdata/Asia/Pontianak index f3567dd..728b552 100644 --- a/library/tzdata/Asia/Pontianak +++ b/library/tzdata/Asia/Pontianak @@ -3,11 +3,11 @@ set TZData(:Asia/Pontianak) { {-9223372036854775808 26240 0 LMT} {-1946186240 26240 0 PMT} - {-1172906240 27000 0 WIT} + {-1172906240 27000 0 WIB} {-881220600 32400 0 JST} - {-766054800 27000 0 WIT} - {-683883000 28800 0 WIT} - {-620812800 27000 0 WIT} - {-189415800 28800 0 CIT} - {567964800 25200 0 WIT} + {-766054800 27000 0 WIB} + {-683883000 28800 0 WIB} + {-620812800 27000 0 WIB} + {-189415800 28800 0 WITA} + {567964800 25200 0 WIB} } diff --git a/library/tzdata/Asia/Rangoon b/library/tzdata/Asia/Rangoon index 2b8c4fa..4f3ac02 100644 --- a/library/tzdata/Asia/Rangoon +++ b/library/tzdata/Asia/Rangoon @@ -2,8 +2,8 @@ set TZData(:Asia/Rangoon) { {-9223372036854775808 23080 0 LMT} - {-2840163880 23076 0 RMT} - {-1577946276 23400 0 BURT} + {-2840163880 23080 0 RMT} + {-1577946280 23400 0 BURT} {-873268200 32400 0 JST} {-778410000 23400 0 MMT} } diff --git a/library/tzdata/Asia/Shanghai b/library/tzdata/Asia/Shanghai index aa7dc58..4b3cc3b 100644 --- a/library/tzdata/Asia/Shanghai +++ b/library/tzdata/Asia/Shanghai @@ -1,8 +1,8 @@ # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Shanghai) { - {-9223372036854775808 29152 0 LMT} - {-1325491552 28800 0 CST} + {-9223372036854775808 29157 0 LMT} + {-1325491557 28800 0 CST} {-933494400 32400 1 CDT} {-923130000 28800 0 CST} {-908784000 32400 1 CDT} diff --git a/library/tzdata/Asia/Ust-Nera b/library/tzdata/Asia/Ust-Nera new file mode 100644 index 0000000..c8de7a5 --- /dev/null +++ b/library/tzdata/Asia/Ust-Nera @@ -0,0 +1,70 @@ +# created by tools/tclZIC.tcl - do not edit + +set TZData(:Asia/Ust-Nera) { + {-9223372036854775808 34374 0 LMT} + {-1579426374 28800 0 YAKT} + {354898800 43200 0 MAGST} + {370699200 39600 0 MAGT} + {386427600 43200 1 MAGST} + {402235200 39600 0 MAGT} + {417963600 43200 1 MAGST} + {433771200 39600 0 MAGT} + {449586000 43200 1 MAGST} + {465318000 39600 0 MAGT} + {481042800 43200 1 MAGST} + {496767600 39600 0 MAGT} + {512492400 43200 1 MAGST} + {528217200 39600 0 MAGT} + {543942000 43200 1 MAGST} + {559666800 39600 0 MAGT} + {575391600 43200 1 MAGST} + {591116400 39600 0 MAGT} + {606841200 43200 1 MAGST} + {622566000 39600 0 MAGT} + {638290800 43200 1 MAGST} + {654620400 39600 0 MAGT} + {670345200 36000 0 MAGMMTT} + {670348800 39600 1 MAGST} + {686073600 36000 0 MAGT} + {695750400 39600 0 MAGMMTT} + {701784000 43200 1 MAGST} + {717505200 39600 0 MAGT} + {733244400 43200 1 MAGST} + {748969200 39600 0 MAGT} + {764694000 43200 1 MAGST} + {780418800 39600 0 MAGT} + {796143600 43200 1 MAGST} + {811868400 39600 0 MAGT} + {828198000 43200 1 MAGST} + {846342000 39600 0 MAGT} + {859647600 43200 1 MAGST} + {877791600 39600 0 MAGT} + {891097200 43200 1 MAGST} + {909241200 39600 0 MAGT} + {922546800 43200 1 MAGST} + {941295600 39600 0 MAGT} + {953996400 43200 1 MAGST} + {972745200 39600 0 MAGT} + {985446000 43200 1 MAGST} + {1004194800 39600 0 MAGT} + {1017500400 43200 1 MAGST} + {1035644400 39600 0 MAGT} + {1048950000 43200 1 MAGST} + {1067094000 39600 0 MAGT} + {1080399600 43200 1 MAGST} + {1099148400 39600 0 MAGT} + {1111849200 43200 1 MAGST} + {1130598000 39600 0 MAGT} + {1143298800 43200 1 MAGST} + {1162047600 39600 0 MAGT} + {1174748400 43200 1 MAGST} + {1193497200 39600 0 MAGT} + {1206802800 43200 1 MAGST} + {1224946800 39600 0 MAGT} + {1238252400 43200 1 MAGST} + {1256396400 39600 0 MAGT} + {1269702000 43200 1 MAGST} + {1288450800 39600 0 MAGT} + {1301151600 43200 0 MAGT} + {1315828800 39600 0 VLAT} +} diff --git a/library/tzdata/Atlantic/Bermuda b/library/tzdata/Atlantic/Bermuda index e8b165a..2d4d983 100644 --- a/library/tzdata/Atlantic/Bermuda +++ b/library/tzdata/Atlantic/Bermuda @@ -1,8 +1,8 @@ # created by tools/tclZIC.tcl - do not edit set TZData(:Atlantic/Bermuda) { - {-9223372036854775808 -15544 0 LMT} - {-1262281256 -14400 0 AST} + {-9223372036854775808 -15558 0 LMT} + {-1262281242 -14400 0 AST} {136360800 -10800 0 ADT} {152082000 -14400 0 AST} {167810400 -10800 1 ADT} diff --git a/library/tzdata/Europe/Busingen b/library/tzdata/Europe/Busingen new file mode 100644 index 0000000..62abc29 --- /dev/null +++ b/library/tzdata/Europe/Busingen @@ -0,0 +1,5 @@ +# created by tools/tclZIC.tcl - do not edit +if {![info exists TZData(Europe/Zurich)]} { + LoadTimeZoneFile Europe/Zurich +} +set TZData(:Europe/Busingen) $TZData(:Europe/Zurich) diff --git a/library/tzdata/Europe/Vaduz b/library/tzdata/Europe/Vaduz index 3118331..095e018 100644 --- a/library/tzdata/Europe/Vaduz +++ b/library/tzdata/Europe/Vaduz @@ -1,245 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:Europe/Vaduz) { - {-9223372036854775808 2284 0 LMT} - {-2385247084 3600 0 CET} - {347151600 3600 0 CET} - {354675600 7200 1 CEST} - {370400400 3600 0 CET} - {386125200 7200 1 CEST} - {401850000 3600 0 CET} - {417574800 7200 1 CEST} - {433299600 3600 0 CET} - {449024400 7200 1 CEST} - {465354000 3600 0 CET} - {481078800 7200 1 CEST} - {496803600 3600 0 CET} - {512528400 7200 1 CEST} - {528253200 3600 0 CET} - {543978000 7200 1 CEST} - {559702800 3600 0 CET} - {575427600 7200 1 CEST} - {591152400 3600 0 CET} - {606877200 7200 1 CEST} - {622602000 3600 0 CET} - {638326800 7200 1 CEST} - {654656400 3600 0 CET} - {670381200 7200 1 CEST} - {686106000 3600 0 CET} - {701830800 7200 1 CEST} - {717555600 3600 0 CET} - {733280400 7200 1 CEST} - {749005200 3600 0 CET} - {764730000 7200 1 CEST} - {780454800 3600 0 CET} - {796179600 7200 1 CEST} - {811904400 3600 0 CET} - {828234000 7200 1 CEST} - {846378000 3600 0 CET} - {859683600 7200 1 CEST} - {877827600 3600 0 CET} - {891133200 7200 1 CEST} - {909277200 3600 0 CET} - {922582800 7200 1 CEST} - {941331600 3600 0 CET} - {954032400 7200 1 CEST} - {972781200 3600 0 CET} - {985482000 7200 1 CEST} - {1004230800 3600 0 CET} - {1017536400 7200 1 CEST} - {1035680400 3600 0 CET} - {1048986000 7200 1 CEST} - {1067130000 3600 0 CET} - {1080435600 7200 1 CEST} - {1099184400 3600 0 CET} - {1111885200 7200 1 CEST} - {1130634000 3600 0 CET} - {1143334800 7200 1 CEST} - {1162083600 3600 0 CET} - {1174784400 7200 1 CEST} - {1193533200 3600 0 CET} - {1206838800 7200 1 CEST} - {1224982800 3600 0 CET} - {1238288400 7200 1 CEST} - {1256432400 3600 0 CET} - {1269738000 7200 1 CEST} - {1288486800 3600 0 CET} - {1301187600 7200 1 CEST} - {1319936400 3600 0 CET} - {1332637200 7200 1 CEST} - {1351386000 3600 0 CET} - {1364691600 7200 1 CEST} - {1382835600 3600 0 CET} - {1396141200 7200 1 CEST} - {1414285200 3600 0 CET} - {1427590800 7200 1 CEST} - {1445734800 3600 0 CET} - {1459040400 7200 1 CEST} - {1477789200 3600 0 CET} - {1490490000 7200 1 CEST} - {1509238800 3600 0 CET} - {1521939600 7200 1 CEST} - {1540688400 3600 0 CET} - {1553994000 7200 1 CEST} - {1572138000 3600 0 CET} - {1585443600 7200 1 CEST} - {1603587600 3600 0 CET} - {1616893200 7200 1 CEST} - {1635642000 3600 0 CET} - {1648342800 7200 1 CEST} - {1667091600 3600 0 CET} - {1679792400 7200 1 CEST} - {1698541200 3600 0 CET} - {1711846800 7200 1 CEST} - {1729990800 3600 0 CET} - {1743296400 7200 1 CEST} - {1761440400 3600 0 CET} - {1774746000 7200 1 CEST} - {1792890000 3600 0 CET} - {1806195600 7200 1 CEST} - {1824944400 3600 0 CET} - {1837645200 7200 1 CEST} - {1856394000 3600 0 CET} - {1869094800 7200 1 CEST} - {1887843600 3600 0 CET} - {1901149200 7200 1 CEST} - {1919293200 3600 0 CET} - {1932598800 7200 1 CEST} - {1950742800 3600 0 CET} - {1964048400 7200 1 CEST} - {1982797200 3600 0 CET} - {1995498000 7200 1 CEST} - {2014246800 3600 0 CET} - {2026947600 7200 1 CEST} - {2045696400 3600 0 CET} - {2058397200 7200 1 CEST} - {2077146000 3600 0 CET} - {2090451600 7200 1 CEST} - {2108595600 3600 0 CET} - {2121901200 7200 1 CEST} - {2140045200 3600 0 CET} - {2153350800 7200 1 CEST} - {2172099600 3600 0 CET} - {2184800400 7200 1 CEST} - {2203549200 3600 0 CET} - {2216250000 7200 1 CEST} - {2234998800 3600 0 CET} - {2248304400 7200 1 CEST} - {2266448400 3600 0 CET} - {2279754000 7200 1 CEST} - {2297898000 3600 0 CET} - {2311203600 7200 1 CEST} - {2329347600 3600 0 CET} - {2342653200 7200 1 CEST} - {2361402000 3600 0 CET} - {2374102800 7200 1 CEST} - {2392851600 3600 0 CET} - {2405552400 7200 1 CEST} - {2424301200 3600 0 CET} - {2437606800 7200 1 CEST} - {2455750800 3600 0 CET} - {2469056400 7200 1 CEST} - {2487200400 3600 0 CET} - {2500506000 7200 1 CEST} - {2519254800 3600 0 CET} - {2531955600 7200 1 CEST} - {2550704400 3600 0 CET} - {2563405200 7200 1 CEST} - {2582154000 3600 0 CET} - {2595459600 7200 1 CEST} - {2613603600 3600 0 CET} - {2626909200 7200 1 CEST} - {2645053200 3600 0 CET} - {2658358800 7200 1 CEST} - {2676502800 3600 0 CET} - {2689808400 7200 1 CEST} - {2708557200 3600 0 CET} - {2721258000 7200 1 CEST} - {2740006800 3600 0 CET} - {2752707600 7200 1 CEST} - {2771456400 3600 0 CET} - {2784762000 7200 1 CEST} - {2802906000 3600 0 CET} - {2816211600 7200 1 CEST} - {2834355600 3600 0 CET} - {2847661200 7200 1 CEST} - {2866410000 3600 0 CET} - {2879110800 7200 1 CEST} - {2897859600 3600 0 CET} - {2910560400 7200 1 CEST} - {2929309200 3600 0 CET} - {2942010000 7200 1 CEST} - {2960758800 3600 0 CET} - {2974064400 7200 1 CEST} - {2992208400 3600 0 CET} - {3005514000 7200 1 CEST} - {3023658000 3600 0 CET} - {3036963600 7200 1 CEST} - {3055712400 3600 0 CET} - {3068413200 7200 1 CEST} - {3087162000 3600 0 CET} - {3099862800 7200 1 CEST} - {3118611600 3600 0 CET} - {3131917200 7200 1 CEST} - {3150061200 3600 0 CET} - {3163366800 7200 1 CEST} - {3181510800 3600 0 CET} - {3194816400 7200 1 CEST} - {3212960400 3600 0 CET} - {3226266000 7200 1 CEST} - {3245014800 3600 0 CET} - {3257715600 7200 1 CEST} - {3276464400 3600 0 CET} - {3289165200 7200 1 CEST} - {3307914000 3600 0 CET} - {3321219600 7200 1 CEST} - {3339363600 3600 0 CET} - {3352669200 7200 1 CEST} - {3370813200 3600 0 CET} - {3384118800 7200 1 CEST} - {3402867600 3600 0 CET} - {3415568400 7200 1 CEST} - {3434317200 3600 0 CET} - {3447018000 7200 1 CEST} - {3465766800 3600 0 CET} - {3479072400 7200 1 CEST} - {3497216400 3600 0 CET} - {3510522000 7200 1 CEST} - {3528666000 3600 0 CET} - {3541971600 7200 1 CEST} - {3560115600 3600 0 CET} - {3573421200 7200 1 CEST} - {3592170000 3600 0 CET} - {3604870800 7200 1 CEST} - {3623619600 3600 0 CET} - {3636320400 7200 1 CEST} - {3655069200 3600 0 CET} - {3668374800 7200 1 CEST} - {3686518800 3600 0 CET} - {3699824400 7200 1 CEST} - {3717968400 3600 0 CET} - {3731274000 7200 1 CEST} - {3750022800 3600 0 CET} - {3762723600 7200 1 CEST} - {3781472400 3600 0 CET} - {3794173200 7200 1 CEST} - {3812922000 3600 0 CET} - {3825622800 7200 1 CEST} - {3844371600 3600 0 CET} - {3857677200 7200 1 CEST} - {3875821200 3600 0 CET} - {3889126800 7200 1 CEST} - {3907270800 3600 0 CET} - {3920576400 7200 1 CEST} - {3939325200 3600 0 CET} - {3952026000 7200 1 CEST} - {3970774800 3600 0 CET} - {3983475600 7200 1 CEST} - {4002224400 3600 0 CET} - {4015530000 7200 1 CEST} - {4033674000 3600 0 CET} - {4046979600 7200 1 CEST} - {4065123600 3600 0 CET} - {4078429200 7200 1 CEST} - {4096573200 3600 0 CET} +if {![info exists TZData(Europe/Zurich)]} { + LoadTimeZoneFile Europe/Zurich } +set TZData(:Europe/Vaduz) $TZData(:Europe/Zurich) diff --git a/library/tzdata/Europe/Vienna b/library/tzdata/Europe/Vienna index 41d744d..95283eb 100644 --- a/library/tzdata/Europe/Vienna +++ b/library/tzdata/Europe/Vienna @@ -1,8 +1,8 @@ # created by tools/tclZIC.tcl - do not edit set TZData(:Europe/Vienna) { - {-9223372036854775808 3920 0 LMT} - {-2422055120 3600 0 CET} + {-9223372036854775808 3921 0 LMT} + {-2422055121 3600 0 CET} {-1693706400 7200 1 CEST} {-1680483600 3600 0 CET} {-1663455600 7200 1 CEST} diff --git a/library/tzdata/Europe/Zurich b/library/tzdata/Europe/Zurich index 33831c3..87a20db 100644 --- a/library/tzdata/Europe/Zurich +++ b/library/tzdata/Europe/Zurich @@ -2,8 +2,8 @@ set TZData(:Europe/Zurich) { {-9223372036854775808 2048 0 LMT} - {-3827954048 1784 0 BMT} - {-2385246584 3600 0 CET} + {-3675198848 1786 0 BMT} + {-2385246586 3600 0 CET} {-904435200 7200 1 CEST} {-891129600 3600 0 CET} {-872985600 7200 1 CEST} diff --git a/library/tzdata/Pacific/Easter b/library/tzdata/Pacific/Easter index 38795fb..000c6d1 100644 --- a/library/tzdata/Pacific/Easter +++ b/library/tzdata/Pacific/Easter @@ -98,178 +98,178 @@ set TZData(:Pacific/Easter) { {1313899200 -18000 1 EASST} {1335668400 -21600 0 EAST} {1346558400 -18000 1 EASST} - {1362884400 -21600 0 EAST} - {1381636800 -18000 1 EASST} - {1394334000 -21600 0 EAST} - {1413086400 -18000 1 EASST} - {1426388400 -21600 0 EAST} - {1444536000 -18000 1 EASST} - {1457838000 -21600 0 EAST} - {1475985600 -18000 1 EASST} - {1489287600 -21600 0 EAST} - {1508040000 -18000 1 EASST} - {1520737200 -21600 0 EAST} - {1539489600 -18000 1 EASST} - {1552186800 -21600 0 EAST} - {1570939200 -18000 1 EASST} - {1584241200 -21600 0 EAST} - {1602388800 -18000 1 EASST} - {1615690800 -21600 0 EAST} - {1633838400 -18000 1 EASST} - {1647140400 -21600 0 EAST} - {1665288000 -18000 1 EASST} - {1678590000 -21600 0 EAST} - {1697342400 -18000 1 EASST} - {1710039600 -21600 0 EAST} - {1728792000 -18000 1 EASST} - {1741489200 -21600 0 EAST} - {1760241600 -18000 1 EASST} - {1773543600 -21600 0 EAST} - {1791691200 -18000 1 EASST} - {1804993200 -21600 0 EAST} - {1823140800 -18000 1 EASST} - {1836442800 -21600 0 EAST} - {1855195200 -18000 1 EASST} - {1867892400 -21600 0 EAST} - {1886644800 -18000 1 EASST} - {1899342000 -21600 0 EAST} - {1918094400 -18000 1 EASST} - {1930791600 -21600 0 EAST} - {1949544000 -18000 1 EASST} - {1962846000 -21600 0 EAST} - {1980993600 -18000 1 EASST} - {1994295600 -21600 0 EAST} - {2012443200 -18000 1 EASST} - {2025745200 -21600 0 EAST} - {2044497600 -18000 1 EASST} - {2057194800 -21600 0 EAST} - {2075947200 -18000 1 EASST} - {2088644400 -21600 0 EAST} - {2107396800 -18000 1 EASST} - {2120698800 -21600 0 EAST} - {2138846400 -18000 1 EASST} - {2152148400 -21600 0 EAST} - {2170296000 -18000 1 EASST} - {2183598000 -21600 0 EAST} - {2201745600 -18000 1 EASST} - {2215047600 -21600 0 EAST} - {2233800000 -18000 1 EASST} - {2246497200 -21600 0 EAST} - {2265249600 -18000 1 EASST} - {2277946800 -21600 0 EAST} - {2296699200 -18000 1 EASST} - {2310001200 -21600 0 EAST} - {2328148800 -18000 1 EASST} - {2341450800 -21600 0 EAST} - {2359598400 -18000 1 EASST} - {2372900400 -21600 0 EAST} - {2391652800 -18000 1 EASST} - {2404350000 -21600 0 EAST} - {2423102400 -18000 1 EASST} - {2435799600 -21600 0 EAST} - {2454552000 -18000 1 EASST} - {2467854000 -21600 0 EAST} - {2486001600 -18000 1 EASST} - {2499303600 -21600 0 EAST} - {2517451200 -18000 1 EASST} - {2530753200 -21600 0 EAST} - {2548900800 -18000 1 EASST} - {2562202800 -21600 0 EAST} - {2580955200 -18000 1 EASST} - {2593652400 -21600 0 EAST} - {2612404800 -18000 1 EASST} - {2625102000 -21600 0 EAST} - {2643854400 -18000 1 EASST} - {2657156400 -21600 0 EAST} - {2675304000 -18000 1 EASST} - {2688606000 -21600 0 EAST} - {2706753600 -18000 1 EASST} - {2720055600 -21600 0 EAST} - {2738808000 -18000 1 EASST} - {2751505200 -21600 0 EAST} - {2770257600 -18000 1 EASST} - {2782954800 -21600 0 EAST} - {2801707200 -18000 1 EASST} - {2814404400 -21600 0 EAST} - {2833156800 -18000 1 EASST} - {2846458800 -21600 0 EAST} - {2864606400 -18000 1 EASST} - {2877908400 -21600 0 EAST} - {2896056000 -18000 1 EASST} - {2909358000 -21600 0 EAST} - {2928110400 -18000 1 EASST} - {2940807600 -21600 0 EAST} - {2959560000 -18000 1 EASST} - {2972257200 -21600 0 EAST} - {2991009600 -18000 1 EASST} - {3004311600 -21600 0 EAST} - {3022459200 -18000 1 EASST} - {3035761200 -21600 0 EAST} - {3053908800 -18000 1 EASST} - {3067210800 -21600 0 EAST} - {3085358400 -18000 1 EASST} - {3098660400 -21600 0 EAST} - {3117412800 -18000 1 EASST} - {3130110000 -21600 0 EAST} - {3148862400 -18000 1 EASST} - {3161559600 -21600 0 EAST} - {3180312000 -18000 1 EASST} - {3193614000 -21600 0 EAST} - {3211761600 -18000 1 EASST} - {3225063600 -21600 0 EAST} - {3243211200 -18000 1 EASST} - {3256513200 -21600 0 EAST} - {3275265600 -18000 1 EASST} - {3287962800 -21600 0 EAST} - {3306715200 -18000 1 EASST} - {3319412400 -21600 0 EAST} - {3338164800 -18000 1 EASST} - {3351466800 -21600 0 EAST} - {3369614400 -18000 1 EASST} - {3382916400 -21600 0 EAST} - {3401064000 -18000 1 EASST} - {3414366000 -21600 0 EAST} - {3432513600 -18000 1 EASST} - {3445815600 -21600 0 EAST} - {3464568000 -18000 1 EASST} - {3477265200 -21600 0 EAST} - {3496017600 -18000 1 EASST} - {3508714800 -21600 0 EAST} - {3527467200 -18000 1 EASST} - {3540769200 -21600 0 EAST} - {3558916800 -18000 1 EASST} - {3572218800 -21600 0 EAST} - {3590366400 -18000 1 EASST} - {3603668400 -21600 0 EAST} - {3622420800 -18000 1 EASST} - {3635118000 -21600 0 EAST} - {3653870400 -18000 1 EASST} - {3666567600 -21600 0 EAST} - {3685320000 -18000 1 EASST} - {3698017200 -21600 0 EAST} - {3716769600 -18000 1 EASST} - {3730071600 -21600 0 EAST} - {3748219200 -18000 1 EASST} - {3761521200 -21600 0 EAST} - {3779668800 -18000 1 EASST} - {3792970800 -21600 0 EAST} - {3811723200 -18000 1 EASST} - {3824420400 -21600 0 EAST} - {3843172800 -18000 1 EASST} - {3855870000 -21600 0 EAST} - {3874622400 -18000 1 EASST} - {3887924400 -21600 0 EAST} - {3906072000 -18000 1 EASST} - {3919374000 -21600 0 EAST} - {3937521600 -18000 1 EASST} - {3950823600 -21600 0 EAST} - {3968971200 -18000 1 EASST} - {3982273200 -21600 0 EAST} - {4001025600 -18000 1 EASST} - {4013722800 -21600 0 EAST} - {4032475200 -18000 1 EASST} - {4045172400 -21600 0 EAST} - {4063924800 -18000 1 EASST} - {4077226800 -21600 0 EAST} - {4095374400 -18000 1 EASST} + {1367118000 -21600 0 EAST} + {1378612800 -18000 1 EASST} + {1398567600 -21600 0 EAST} + {1410062400 -18000 1 EASST} + {1430017200 -21600 0 EAST} + {1441512000 -18000 1 EASST} + {1461466800 -21600 0 EAST} + {1472961600 -18000 1 EASST} + {1492916400 -21600 0 EAST} + {1504411200 -18000 1 EASST} + {1524970800 -21600 0 EAST} + {1535860800 -18000 1 EASST} + {1556420400 -21600 0 EAST} + {1567915200 -18000 1 EASST} + {1587870000 -21600 0 EAST} + {1599364800 -18000 1 EASST} + {1619319600 -21600 0 EAST} + {1630814400 -18000 1 EASST} + {1650769200 -21600 0 EAST} + {1662264000 -18000 1 EASST} + {1682218800 -21600 0 EAST} + {1693713600 -18000 1 EASST} + {1714273200 -21600 0 EAST} + {1725768000 -18000 1 EASST} + {1745722800 -21600 0 EAST} + {1757217600 -18000 1 EASST} + {1777172400 -21600 0 EAST} + {1788667200 -18000 1 EASST} + {1808622000 -21600 0 EAST} + {1820116800 -18000 1 EASST} + {1840071600 -21600 0 EAST} + {1851566400 -18000 1 EASST} + {1872126000 -21600 0 EAST} + {1883016000 -18000 1 EASST} + {1903575600 -21600 0 EAST} + {1915070400 -18000 1 EASST} + {1935025200 -21600 0 EAST} + {1946520000 -18000 1 EASST} + {1966474800 -21600 0 EAST} + {1977969600 -18000 1 EASST} + {1997924400 -21600 0 EAST} + {2009419200 -18000 1 EASST} + {2029374000 -21600 0 EAST} + {2040868800 -18000 1 EASST} + {2061428400 -21600 0 EAST} + {2072318400 -18000 1 EASST} + {2092878000 -21600 0 EAST} + {2104372800 -18000 1 EASST} + {2124327600 -21600 0 EAST} + {2135822400 -18000 1 EASST} + {2155777200 -21600 0 EAST} + {2167272000 -18000 1 EASST} + {2187226800 -21600 0 EAST} + {2198721600 -18000 1 EASST} + {2219281200 -21600 0 EAST} + {2230171200 -18000 1 EASST} + {2250730800 -21600 0 EAST} + {2262225600 -18000 1 EASST} + {2282180400 -21600 0 EAST} + {2293675200 -18000 1 EASST} + {2313630000 -21600 0 EAST} + {2325124800 -18000 1 EASST} + {2345079600 -21600 0 EAST} + {2356574400 -18000 1 EASST} + {2376529200 -21600 0 EAST} + {2388024000 -18000 1 EASST} + {2408583600 -21600 0 EAST} + {2419473600 -18000 1 EASST} + {2440033200 -21600 0 EAST} + {2451528000 -18000 1 EASST} + {2471482800 -21600 0 EAST} + {2482977600 -18000 1 EASST} + {2502932400 -21600 0 EAST} + {2514427200 -18000 1 EASST} + {2534382000 -21600 0 EAST} + {2545876800 -18000 1 EASST} + {2565831600 -21600 0 EAST} + {2577326400 -18000 1 EASST} + {2597886000 -21600 0 EAST} + {2609380800 -18000 1 EASST} + {2629335600 -21600 0 EAST} + {2640830400 -18000 1 EASST} + {2660785200 -21600 0 EAST} + {2672280000 -18000 1 EASST} + {2692234800 -21600 0 EAST} + {2703729600 -18000 1 EASST} + {2723684400 -21600 0 EAST} + {2735179200 -18000 1 EASST} + {2755738800 -21600 0 EAST} + {2766628800 -18000 1 EASST} + {2787188400 -21600 0 EAST} + {2798683200 -18000 1 EASST} + {2818638000 -21600 0 EAST} + {2830132800 -18000 1 EASST} + {2850087600 -21600 0 EAST} + {2861582400 -18000 1 EASST} + {2881537200 -21600 0 EAST} + {2893032000 -18000 1 EASST} + {2912986800 -21600 0 EAST} + {2924481600 -18000 1 EASST} + {2945041200 -21600 0 EAST} + {2955931200 -18000 1 EASST} + {2976490800 -21600 0 EAST} + {2987985600 -18000 1 EASST} + {3007940400 -21600 0 EAST} + {3019435200 -18000 1 EASST} + {3039390000 -21600 0 EAST} + {3050884800 -18000 1 EASST} + {3070839600 -21600 0 EAST} + {3082334400 -18000 1 EASST} + {3102894000 -21600 0 EAST} + {3113784000 -18000 1 EASST} + {3134343600 -21600 0 EAST} + {3145838400 -18000 1 EASST} + {3165793200 -21600 0 EAST} + {3177288000 -18000 1 EASST} + {3197242800 -21600 0 EAST} + {3208737600 -18000 1 EASST} + {3228692400 -21600 0 EAST} + {3240187200 -18000 1 EASST} + {3260142000 -21600 0 EAST} + {3271636800 -18000 1 EASST} + {3292196400 -21600 0 EAST} + {3303086400 -18000 1 EASST} + {3323646000 -21600 0 EAST} + {3335140800 -18000 1 EASST} + {3355095600 -21600 0 EAST} + {3366590400 -18000 1 EASST} + {3386545200 -21600 0 EAST} + {3398040000 -18000 1 EASST} + {3417994800 -21600 0 EAST} + {3429489600 -18000 1 EASST} + {3449444400 -21600 0 EAST} + {3460939200 -18000 1 EASST} + {3481498800 -21600 0 EAST} + {3492993600 -18000 1 EASST} + {3512948400 -21600 0 EAST} + {3524443200 -18000 1 EASST} + {3544398000 -21600 0 EAST} + {3555892800 -18000 1 EASST} + {3575847600 -21600 0 EAST} + {3587342400 -18000 1 EASST} + {3607297200 -21600 0 EAST} + {3618792000 -18000 1 EASST} + {3639351600 -21600 0 EAST} + {3650241600 -18000 1 EASST} + {3670801200 -21600 0 EAST} + {3682296000 -18000 1 EASST} + {3702250800 -21600 0 EAST} + {3713745600 -18000 1 EASST} + {3733700400 -21600 0 EAST} + {3745195200 -18000 1 EASST} + {3765150000 -21600 0 EAST} + {3776644800 -18000 1 EASST} + {3796599600 -21600 0 EAST} + {3808094400 -18000 1 EASST} + {3828654000 -21600 0 EAST} + {3839544000 -18000 1 EASST} + {3860103600 -21600 0 EAST} + {3871598400 -18000 1 EASST} + {3891553200 -21600 0 EAST} + {3903048000 -18000 1 EASST} + {3923002800 -21600 0 EAST} + {3934497600 -18000 1 EASST} + {3954452400 -21600 0 EAST} + {3965947200 -18000 1 EASST} + {3986506800 -21600 0 EAST} + {3997396800 -18000 1 EASST} + {4017956400 -21600 0 EAST} + {4029451200 -18000 1 EASST} + {4049406000 -21600 0 EAST} + {4060900800 -18000 1 EASST} + {4080855600 -21600 0 EAST} + {4092350400 -18000 1 EASST} } diff --git a/library/tzdata/Pacific/Fiji b/library/tzdata/Pacific/Fiji index e067377..454ee87 100644 --- a/library/tzdata/Pacific/Fiji +++ b/library/tzdata/Pacific/Fiji @@ -1,8 +1,8 @@ # created by tools/tclZIC.tcl - do not edit set TZData(:Pacific/Fiji) { - {-9223372036854775808 42820 0 LMT} - {-1709985220 43200 0 FJT} + {-9223372036854775808 42944 0 LMT} + {-1709985344 43200 0 FJT} {909842400 46800 1 FJST} {920124000 43200 0 FJT} {941896800 46800 1 FJST} @@ -15,11 +15,11 @@ set TZData(:Pacific/Fiji) { {1327154400 43200 0 FJT} {1350741600 46800 1 FJST} {1358604000 43200 0 FJT} - {1382191200 46800 1 FJST} + {1382796000 46800 1 FJST} {1390053600 43200 0 FJT} - {1413640800 46800 1 FJST} + {1414245600 46800 1 FJST} {1421503200 43200 0 FJT} - {1445090400 46800 1 FJST} + {1445695200 46800 1 FJST} {1453557600 43200 0 FJT} {1477144800 46800 1 FJST} {1485007200 43200 0 FJT} @@ -27,9 +27,9 @@ set TZData(:Pacific/Fiji) { {1516456800 43200 0 FJT} {1540044000 46800 1 FJST} {1547906400 43200 0 FJT} - {1571493600 46800 1 FJST} + {1572098400 46800 1 FJST} {1579356000 43200 0 FJT} - {1602943200 46800 1 FJST} + {1603548000 46800 1 FJST} {1611410400 43200 0 FJT} {1634997600 46800 1 FJST} {1642860000 43200 0 FJT} @@ -37,11 +37,11 @@ set TZData(:Pacific/Fiji) { {1674309600 43200 0 FJT} {1697896800 46800 1 FJST} {1705759200 43200 0 FJT} - {1729346400 46800 1 FJST} + {1729951200 46800 1 FJST} {1737208800 43200 0 FJT} - {1760796000 46800 1 FJST} + {1761400800 46800 1 FJST} {1768658400 43200 0 FJT} - {1792245600 46800 1 FJST} + {1792850400 46800 1 FJST} {1800712800 43200 0 FJT} {1824300000 46800 1 FJST} {1832162400 43200 0 FJT} @@ -49,9 +49,9 @@ set TZData(:Pacific/Fiji) { {1863612000 43200 0 FJT} {1887199200 46800 1 FJST} {1895061600 43200 0 FJT} - {1918648800 46800 1 FJST} + {1919253600 46800 1 FJST} {1926511200 43200 0 FJT} - {1950098400 46800 1 FJST} + {1950703200 46800 1 FJST} {1957960800 43200 0 FJT} {1982152800 46800 1 FJST} {1990015200 43200 0 FJT} @@ -61,9 +61,9 @@ set TZData(:Pacific/Fiji) { {2052914400 43200 0 FJT} {2076501600 46800 1 FJST} {2084364000 43200 0 FJT} - {2107951200 46800 1 FJST} + {2108556000 46800 1 FJST} {2115813600 43200 0 FJT} - {2139400800 46800 1 FJST} + {2140005600 46800 1 FJST} {2147868000 43200 0 FJT} {2171455200 46800 1 FJST} {2179317600 43200 0 FJT} @@ -71,11 +71,11 @@ set TZData(:Pacific/Fiji) { {2210767200 43200 0 FJT} {2234354400 46800 1 FJST} {2242216800 43200 0 FJT} - {2265804000 46800 1 FJST} + {2266408800 46800 1 FJST} {2273666400 43200 0 FJT} - {2297253600 46800 1 FJST} + {2297858400 46800 1 FJST} {2305116000 43200 0 FJT} - {2328703200 46800 1 FJST} + {2329308000 46800 1 FJST} {2337170400 43200 0 FJT} {2360757600 46800 1 FJST} {2368620000 43200 0 FJT} @@ -83,9 +83,9 @@ set TZData(:Pacific/Fiji) { {2400069600 43200 0 FJT} {2423656800 46800 1 FJST} {2431519200 43200 0 FJT} - {2455106400 46800 1 FJST} + {2455711200 46800 1 FJST} {2462968800 43200 0 FJT} - {2486556000 46800 1 FJST} + {2487160800 46800 1 FJST} {2495023200 43200 0 FJT} {2518610400 46800 1 FJST} {2526472800 43200 0 FJT} @@ -93,11 +93,11 @@ set TZData(:Pacific/Fiji) { {2557922400 43200 0 FJT} {2581509600 46800 1 FJST} {2589372000 43200 0 FJT} - {2612959200 46800 1 FJST} + {2613564000 46800 1 FJST} {2620821600 43200 0 FJT} - {2644408800 46800 1 FJST} + {2645013600 46800 1 FJST} {2652271200 43200 0 FJT} - {2675858400 46800 1 FJST} + {2676463200 46800 1 FJST} {2684325600 43200 0 FJT} {2707912800 46800 1 FJST} {2715775200 43200 0 FJT} @@ -105,9 +105,9 @@ set TZData(:Pacific/Fiji) { {2747224800 43200 0 FJT} {2770812000 46800 1 FJST} {2778674400 43200 0 FJT} - {2802261600 46800 1 FJST} + {2802866400 46800 1 FJST} {2810124000 43200 0 FJT} - {2833711200 46800 1 FJST} + {2834316000 46800 1 FJST} {2841573600 43200 0 FJT} {2865765600 46800 1 FJST} {2873628000 43200 0 FJT} @@ -117,9 +117,9 @@ set TZData(:Pacific/Fiji) { {2936527200 43200 0 FJT} {2960114400 46800 1 FJST} {2967976800 43200 0 FJT} - {2991564000 46800 1 FJST} + {2992168800 46800 1 FJST} {2999426400 43200 0 FJT} - {3023013600 46800 1 FJST} + {3023618400 46800 1 FJST} {3031480800 43200 0 FJT} {3055068000 46800 1 FJST} {3062930400 43200 0 FJT} @@ -127,11 +127,11 @@ set TZData(:Pacific/Fiji) { {3094380000 43200 0 FJT} {3117967200 46800 1 FJST} {3125829600 43200 0 FJT} - {3149416800 46800 1 FJST} + {3150021600 46800 1 FJST} {3157279200 43200 0 FJT} - {3180866400 46800 1 FJST} + {3181471200 46800 1 FJST} {3188728800 43200 0 FJT} - {3212316000 46800 1 FJST} + {3212920800 46800 1 FJST} {3220783200 43200 0 FJT} {3244370400 46800 1 FJST} {3252232800 43200 0 FJT} @@ -139,9 +139,9 @@ set TZData(:Pacific/Fiji) { {3283682400 43200 0 FJT} {3307269600 46800 1 FJST} {3315132000 43200 0 FJT} - {3338719200 46800 1 FJST} + {3339324000 46800 1 FJST} {3346581600 43200 0 FJT} - {3370168800 46800 1 FJST} + {3370773600 46800 1 FJST} {3378636000 43200 0 FJT} {3402223200 46800 1 FJST} {3410085600 43200 0 FJT} @@ -149,11 +149,11 @@ set TZData(:Pacific/Fiji) { {3441535200 43200 0 FJT} {3465122400 46800 1 FJST} {3472984800 43200 0 FJT} - {3496572000 46800 1 FJST} + {3497176800 46800 1 FJST} {3504434400 43200 0 FJT} - {3528021600 46800 1 FJST} + {3528626400 46800 1 FJST} {3535884000 43200 0 FJT} - {3559471200 46800 1 FJST} + {3560076000 46800 1 FJST} {3567938400 43200 0 FJT} {3591525600 46800 1 FJST} {3599388000 43200 0 FJT} @@ -161,9 +161,9 @@ set TZData(:Pacific/Fiji) { {3630837600 43200 0 FJT} {3654424800 46800 1 FJST} {3662287200 43200 0 FJT} - {3685874400 46800 1 FJST} + {3686479200 46800 1 FJST} {3693736800 43200 0 FJT} - {3717324000 46800 1 FJST} + {3717928800 46800 1 FJST} {3725186400 43200 0 FJT} {3749378400 46800 1 FJST} {3757240800 43200 0 FJT} @@ -173,9 +173,9 @@ set TZData(:Pacific/Fiji) { {3820140000 43200 0 FJT} {3843727200 46800 1 FJST} {3851589600 43200 0 FJT} - {3875176800 46800 1 FJST} + {3875781600 46800 1 FJST} {3883039200 43200 0 FJT} - {3906626400 46800 1 FJST} + {3907231200 46800 1 FJST} {3915093600 43200 0 FJT} {3938680800 46800 1 FJST} {3946543200 43200 0 FJT} @@ -183,9 +183,9 @@ set TZData(:Pacific/Fiji) { {3977992800 43200 0 FJT} {4001580000 46800 1 FJST} {4009442400 43200 0 FJT} - {4033029600 46800 1 FJST} + {4033634400 46800 1 FJST} {4040892000 43200 0 FJT} - {4064479200 46800 1 FJST} + {4065084000 46800 1 FJST} {4072341600 43200 0 FJT} - {4095928800 46800 1 FJST} + {4096533600 46800 1 FJST} } diff --git a/library/tzdata/Pacific/Johnston b/library/tzdata/Pacific/Johnston index 7f9fee4..21ab39a 100644 --- a/library/tzdata/Pacific/Johnston +++ b/library/tzdata/Pacific/Johnston @@ -1,5 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:Pacific/Johnston) { - {-9223372036854775808 -36000 0 HST} +if {![info exists TZData(Pacific/Honolulu)]} { + LoadTimeZoneFile Pacific/Honolulu } +set TZData(:Pacific/Johnston) $TZData(:Pacific/Honolulu) diff --git a/library/word.tcl b/library/word.tcl index 16a4638..b8f34a5 100644 --- a/library/word.tcl +++ b/library/word.tcl @@ -67,7 +67,7 @@ namespace eval ::tcl { proc tcl_wordBreakAfter {str start} { variable ::tcl::WordBreakRE set result {-1 -1} - regexp -indices -start $start $WordBreakRE(after) $str result + regexp -indices -start $start -- $WordBreakRE(after) $str result return [lindex $result 1] } @@ -85,7 +85,7 @@ proc tcl_wordBreakAfter {str start} { proc tcl_wordBreakBefore {str start} { variable ::tcl::WordBreakRE set result {-1 -1} - regexp -indices $WordBreakRE(before) [string range $str 0 $start] result + regexp -indices -- $WordBreakRE(before) [string range $str 0 $start] result return [lindex $result 1] } @@ -104,7 +104,7 @@ proc tcl_wordBreakBefore {str start} { proc tcl_endOfWord {str start} { variable ::tcl::WordBreakRE set result {-1 -1} - regexp -indices -start $start $WordBreakRE(end) $str result + regexp -indices -start $start -- $WordBreakRE(end) $str result return [lindex $result 1] } @@ -122,7 +122,7 @@ proc tcl_endOfWord {str start} { proc tcl_startOfNextWord {str start} { variable ::tcl::WordBreakRE set result {-1 -1} - regexp -indices -start $start $WordBreakRE(next) $str result + regexp -indices -start $start -- $WordBreakRE(next) $str result return [lindex $result 1] } @@ -138,7 +138,7 @@ proc tcl_startOfNextWord {str start} { proc tcl_startOfPreviousWord {str start} { variable ::tcl::WordBreakRE set word {-1 -1} - regexp -indices $WordBreakRE(previous) [string range $str 0 $start-1] \ + regexp -indices -- $WordBreakRE(previous) [string range $str 0 $start-1] \ result word return [lindex $word 0] } diff --git a/macosx/README b/macosx/README index 6b944ca..bcffde3 100644 --- a/macosx/README +++ b/macosx/README @@ -20,8 +20,8 @@ before asking on the list, many questions have already been answered). http://wiki.tcl.tk/_/ref?N=3753 http://wiki.tcl.tk/_/ref?N=8361 -- Please report bugs with Tcl or Tk on Mac OS X to the sourceforge bug trackers: - http://tcl.sourceforge.net/ +- Please report bugs with Tcl on Mac OS X to the tracker: + http://core.tcl.tk/tcl/reportlist 2. Using Tcl on Mac OS X ------------------------ diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c index f266443..8ecfd0b 100644 --- a/macosx/tclMacOSXFCmd.c +++ b/macosx/tclMacOSXFCmd.c @@ -578,7 +578,7 @@ GetOSTypeFromObj( int result = TCL_OK; if (objPtr->typePtr != &tclOSTypeType) { - result = tclOSTypeType.setFromAnyProc(interp, objPtr); + result = SetOSTypeFromAny(interp, objPtr); } *osTypePtr = (OSType) objPtr->internalRep.longValue; return result; @@ -608,7 +608,7 @@ NewOSTypeObj( Tcl_Obj *objPtr; TclNewObj(objPtr); - Tcl_InvalidateStringRep(objPtr); + TclInvalidateStringRep(objPtr); objPtr->internalRep.longValue = (long) osType; objPtr->typePtr = &tclOSTypeType; return objPtr; diff --git a/pkgs/README b/pkgs/README index 01c6f43..868bd4f 100644 --- a/pkgs/README +++ b/pkgs/README @@ -39,7 +39,7 @@ needs to conform to the following conventions. distclean: Delete all generated files. dist: Produce a copy of the package's source code distribution. - Must respect the DIST_ROOT variable determing where to + Must respect the DIST_ROOT variable determining where to write the generated directory. Packages that are written to make use of the Tcl Extension Architecture (TEA) diff --git a/pkgs/package.list.txt b/pkgs/package.list.txt index a13b0fb..0d5dcf8 100644 --- a/pkgs/package.list.txt +++ b/pkgs/package.list.txt @@ -9,7 +9,10 @@ itcl {[incr Tcl]} Itcl {[incr Tcl]} # SQLite -sqlite SQLite +Sqlite SQLite3 +sqlite SQLite3 +Sqlite3 SQLite3 +sqlite3 SQLite3 # Thread Thread Thread @@ -20,7 +23,13 @@ tdbc TDBC Tdbc TDBC TDBC TDBC # Drivers for TDBC +Tdbcmysql tdbc::mysql tdbcmysql tdbc::mysql +Tdbcodbc tdbc::odbc tdbcodbc tdbc::odbc +Tdbcpostgres tdbc::postgres tdbcpostgres tdbc::postgres +Tdbcsqlite3 tdbc::sqlite3 tdbcsqlite3 tdbc::sqlite3 +Tdbcsqlite tdbc::sqlite3 +tdbcsqlite tdbc::sqlite3 diff --git a/tests/assemble.test b/tests/assemble.test index 7d4e5d1..b0487e6 100644 --- a/tests/assemble.test +++ b/tests/assemble.test @@ -175,8 +175,7 @@ test assemble-4.1 {syntax error} { -match glob -result {1 {extra characters after close-brace} {extra characters after close-brace while executing -"{}extra - " +"{}e" ("assemble" body, line 2)*}} } test assemble-4.2 {null command} { diff --git a/tests/assocd.test b/tests/assocd.test index d1489b3..edf55c4 100644 --- a/tests/assocd.test +++ b/tests/assocd.test @@ -11,10 +11,8 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest - namespace import -force ::tcltest::* -} +package require tcltest 2 +namespace import ::tcltest::* ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] @@ -36,15 +34,21 @@ test assocd-1.4 {testing setting assoc data} testsetassocdata { testsetassocdata abc "abc d e f" } "" -test assocd-2.1 {testing getting assoc data} testgetassocdata { - testgetassocdata a -} 2 -test assocd-2.2 {testing getting assoc data} testgetassocdata { - testgetassocdata 123 -} 456 -test assocd-2.3 {testing getting assoc data} testgetassocdata { +test assocd-2.1 {testing getting assoc data} -setup { + testsetassocdata a 2 +} -constraints {testgetassocdata} -body { + testgetassocdata a +} -result 2 +test assocd-2.2 {testing getting assoc data} -setup { + testsetassocdata 123 456 +} -constraints {testgetassocdata} -body { + testgetassocdata 123 +} -result 456 +test assocd-2.3 {testing getting assoc data} -setup { + testsetassocdata abc "abc d e f" +} -constraints {testgetassocdata} -body { testgetassocdata abc -} {abc d e f} +} -result "abc d e f" test assocd-2.4 {testing getting assoc data} testgetassocdata { testgetassocdata xxx } "" @@ -60,5 +64,5 @@ test assocd-3.3 {testing deleting assoc data} testdelassocdata { } {0 {}} # cleanup -::tcltest::cleanupTests +cleanupTests return diff --git a/tests/autoMkindex.test b/tests/autoMkindex.test index 8f29131..4721553 100644 --- a/tests/autoMkindex.test +++ b/tests/autoMkindex.test @@ -236,6 +236,38 @@ test autoMkindex-3.3 {auto_mkindex_parser::command} -setup { # Reset initCommands to avoid trashing other tests AutoMkindexTestReset } -result "{::buried::mycmd4 $element} {::buried::mycmd5 $element} {mycmd6 $element}" +makeFile { + +namespace eval wok { + namespace ensemble create -subcommands {commands vars} + + proc commands {{pattern *}} { + puts [join [lsort -dictionary [info commands $pattern]] \n] + } + + proc vars {{pattern *}} { + puts [join [lsort -dictionary [info vars $pattern]] \n] + } + +} + +} ensemblecommands.tcl + +test autoMkindex-3.4 {ensemble commands in tclIndex} { + file delete tclIndex + auto_mkindex . ensemblecommands.tcl + set f [open tclIndex r] + set dat [list] + foreach r [split [string trim [read $f]] "\n"] { + if {[string match {set auto_index*} $r]} { + lappend dat $r + } + } + set result [lsort $dat] + close $f + set result +} {{set auto_index(::wok::commands) [list source [file join $dir ensemblecommands.tcl]]} {set auto_index(::wok::vars) [list source [file join $dir ensemblecommands.tcl]]} {set auto_index(wok) [list source [file join $dir ensemblecommands.tcl]]}} +removeFile ensemblecommands.tcl test autoMkindex-4.1 {platform independent source commands} -setup { file delete tclIndex diff --git a/tests/basic.test b/tests/basic.test index 7435571..1a0037c 100644 --- a/tests/basic.test +++ b/tests/basic.test @@ -16,7 +16,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcltest 2 -namespace import -force ::tcltest::* +namespace import ::tcltest::* ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] @@ -31,7 +31,7 @@ catch {interp delete test_interp} catch {rename p ""} catch {rename q ""} catch {rename cmd ""} -catch {unset x} +unset -nocomplain x test basic-1.1 {Tcl_CreateInterp, creates interp's global namespace} { catch {interp delete test_interp} @@ -267,14 +267,24 @@ test basic-18.4 {TclRenameCommand, bad new name} { } rename test_ns_basic::p :::george::martha } {} -test basic-18.5 {TclRenameCommand, new name must not already exist} { +test basic-18.5 {TclRenameCommand, new name must not already exist} -setup { + if {![llength [info commands :::george::martha]]} { + catch {namespace delete {*}[namespace children :: test_ns_*]} + namespace eval test_ns_basic { + proc p {} { + return "p in [namespace current]" + } + } + rename test_ns_basic::p :::george::martha + } +} -body { namespace eval test_ns_basic { proc q {} { return 42 } } list [catch {rename test_ns_basic::q :::george::martha} msg] $msg -} {1 {can't rename to ":::george::martha": command already exists}} +} -result {1 {can't rename to ":::george::martha": command already exists}} test basic-18.6 {TclRenameCommand, check for command shadowing by newly renamed cmd} { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} @@ -302,7 +312,7 @@ test basic-20.1 {Tcl_GetCommandInfo, names for commands created inside namespace catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} catch {rename q ""} - catch {unset x} + unset -nocomplain x set x [namespace eval test_ns_basic::test_ns_basic2 { # the following creates a cmd in the global namespace testcmdtoken create p @@ -355,7 +365,7 @@ test basic-23.1 {Tcl_DeleteCommand} {emptyTest} { test basic-24.1 {Tcl_DeleteCommandFromToken, invalidate all compiled code if cmd has compile proc} { catch {interp delete test_interp} - catch {unset x} + unset -nocomplain x interp create test_interp interp eval test_interp { proc useSet {} { @@ -427,7 +437,7 @@ test basic-26.1 {Tcl_EvalObj: preserve object while evaling it} -setup { # string would have been freed, leaving garbage bytes for the error # message. set f [open $fName w] - fileevent $f writable "fileevent $f writable {}; error foo" + chan event $f writable "chan event $f writable {}; error foo" set x {} vwait x close $f @@ -547,8 +557,8 @@ test basic-46.1 {Tcl_AllowExceptions: exception return not allowed} {stdio} { catch {close $f} set res [catch { set f [open |[list [interpreter]] w+] - fconfigure $f -buffering line - puts $f {fconfigure stdout -buffering line} + chan configure $f -buffering line + puts $f {chan configure stdout -buffering line} puts $f continue puts $f {puts $::errorInfo} puts $f {puts DONE} @@ -972,6 +982,6 @@ catch {rename p ""} catch {rename q ""} catch {rename cmd ""} catch {rename value:at: ""} -catch {unset x} -::tcltest::cleanupTests +unset -nocomplain x +cleanupTests return diff --git a/tests/binary.test b/tests/binary.test index ccd0f29..40b1315 100644 --- a/tests/binary.test +++ b/tests/binary.test @@ -1582,38 +1582,46 @@ test binary-40.4 {ScanNumber: NaN} -body { list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d arg1] $arg1 } -match glob -result {1 -NaN*} -test binary-41.1 {ScanNumber: word alignment} { - unset -nocomplain arg1; unset arg2 +test binary-41.1 {ScanNumber: word alignment} -setup { + unset -nocomplain arg1 arg2 +} -body { list [binary scan \x01\x01\x00 c1s1 arg1 arg2] $arg1 $arg2 -} {2 1 1} -test binary-41.2 {ScanNumber: word alignment} { - unset -nocomplain arg1; unset arg2 +} -result {2 1 1} +test binary-41.2 {ScanNumber: word alignment} -setup { + unset -nocomplain arg1 arg2 +} -body { list [binary scan \x01\x00\x01 c1S1 arg1 arg2] $arg1 $arg2 -} {2 1 1} -test binary-41.3 {ScanNumber: word alignment} { - unset -nocomplain arg1; unset arg2 +} -result {2 1 1} +test binary-41.3 {ScanNumber: word alignment} -setup { + unset -nocomplain arg1 arg2 +} -body { list [binary scan \x01\x01\x00\x00\x00 c1i1 arg1 arg2] $arg1 $arg2 -} {2 1 1} -test binary-41.4 {ScanNumber: word alignment} { - unset -nocomplain arg1; unset arg2 +} -result {2 1 1} +test binary-41.4 {ScanNumber: word alignment} -setup { + unset -nocomplain arg1 arg2 +} -body { list [binary scan \x01\x00\x00\x00\x01 c1I1 arg1 arg2] $arg1 $arg2 -} {2 1 1} -test binary-41.5 {ScanNumber: word alignment} bigEndian { - unset -nocomplain arg1; unset arg2 +} -result {2 1 1} +test binary-41.5 {ScanNumber: word alignment} -setup { + unset -nocomplain arg1 arg2 +} -constraints bigEndian -body { list [binary scan \x01\x3f\xcc\xcc\xcd c1f1 arg1 arg2] $arg1 $arg2 -} {2 1 1.600000023841858} -test binary-41.6 {ScanNumber: word alignment} littleEndian { - unset -nocomplain arg1; unset arg2 +} -result {2 1 1.600000023841858} +test binary-41.6 {ScanNumber: word alignment} -setup { + unset -nocomplain arg1 arg2 +} -constraints littleEndian -body { list [binary scan \x01\xcd\xcc\xcc\x3f c1f1 arg1 arg2] $arg1 $arg2 -} {2 1 1.600000023841858} -test binary-41.7 {ScanNumber: word alignment} bigEndian { - unset -nocomplain arg1; unset arg2 +} -result {2 1 1.600000023841858} +test binary-41.7 {ScanNumber: word alignment} -setup { + unset -nocomplain arg1 arg2 +} -constraints bigEndian -body { list [binary scan \x01\x3f\xf9\x99\x99\x99\x99\x99\x9a c1d1 arg1 arg2] $arg1 $arg2 -} {2 1 1.6} -test binary-41.8 {ScanNumber: word alignment} littleEndian { - unset -nocomplain arg1; unset arg2 +} -result {2 1 1.6} +test binary-41.8 {ScanNumber: word alignment} -setup { + unset -nocomplain arg1 arg2 +} -constraints littleEndian -body { list [binary scan \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f c1d1 arg1 arg2] $arg1 $arg2 -} {2 1 1.6} +} -result {2 1 1.6} test binary-42.1 {Tcl_BinaryObjCmd: bad arguments} -constraints {} -body { binary ? @@ -2491,6 +2499,34 @@ test binary-71.9 {binary decode hex} -body { test binary-71.10 {binary decode hex} -body { string length [binary decode hex " "] } -result 0 +test binary-71.11 {binary decode hex: Bug b98fa55285} -body { + apply {{} { + set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c26\n" + set decoded [binary decode hex $str] + list [string length $decoded] [scan [string index $decoded end] %c] + }} +} -result {29 38} +test binary-71.12 {binary decode hex: Bug b98fa55285 cross check} -body { + apply {{} { + set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n" + set decoded [binary decode hex $str] + list [string length $decoded] [scan [string index $decoded end] %c] + }} +} -result {28 140} +test binary-71.13 {binary decode hex: Bug b98fa55285 cross check} -body { + apply {{} { + set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n\n" + set decoded [binary decode hex $str] + list [string length $decoded] [scan [string index $decoded end] %c] + }} +} -result {28 140} +test binary-71.14 {binary decode hex: Bug b98fa55285 cross check} -body { + apply {{} { + set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n\n\n" + set decoded [binary decode hex $str] + list [string length $decoded] [scan [string index $decoded end] %c] + }} +} -result {28 140} test binary-72.1 {binary encode base64} -body { binary encode base64 @@ -2669,105 +2705,116 @@ test binary-74.1 {binary encode uuencode} -body { } -returnCodes error -match glob -result "wrong # args: *" test binary-74.2 {binary encode uuencode} -body { binary encode uuencode abc -} -result {86)C} +} -result {#86)C +} test binary-74.3 {binary encode uuencode} -body { binary encode uuencode {} } -result {} test binary-74.4 {binary encode uuencode} -body { binary encode uuencode [string repeat abc 20] -} -result [string repeat 86)C 20] +} -result "M[string repeat 86)C 15]\n/[string repeat 86)C 5]\n" test binary-74.5 {binary encode uuencode} -body { binary encode uuencode \0\1\2\3\4\0\1\2\3 -} -result "``\$\"`P0``0(#" +} -result ")``\$\"`P0``0(#\n" test binary-74.6 {binary encode uuencode} -body { binary encode uuencode \0 -} -result {````} +} -result {!`` +} test binary-74.7 {binary encode uuencode} -body { binary encode uuencode \0\0 -} -result {````} +} -result "\"``` +" test binary-74.8 {binary encode uuencode} -body { binary encode uuencode \0\0\0 -} -result {````} +} -result {#```` +} test binary-74.9 {binary encode uuencode} -body { binary encode uuencode \0\0\0\0 -} -result {````````} -test binary-74.10 {binary encode uuencode} -body { - binary encode uuencode -maxlen 0 -wrapchar | abcabcabc -} -result {86)C86)C86)C} -test binary-74.11 {binary encode uuencode} -body { - binary encode uuencode -maxlen 1 -wrapchar | abcabcabc -} -result {8|6|)|C|8|6|)|C|8|6|)|C} +} -result {$`````` +} +test binary-74.10 {binary encode uuencode} -returnCodes error -body { + binary encode uuencode -foo 30 abcabcabc +} -result {bad option "-foo": must be -maxlen or -wrapchar} +test binary-74.11 {binary encode uuencode} -returnCodes error -body { + binary encode uuencode -maxlen 1 abcabcabc +} -result {line length out of range} +test binary-74.12 {binary encode uuencode} -body { + binary encode uuencode -maxlen 3 -wrapchar | abcabcabc +} -result {!80|!8@|!8P|!80|!8@|!8P|!80|!8@|!8P|} test binary-75.1 {binary decode uuencode} -body { binary decode uuencode } -returnCodes error -match glob -result "wrong # args: *" test binary-75.2 {binary decode uuencode} -body { - binary decode uuencode 86)C + binary decode uuencode "#86)C\n" } -result {abc} test binary-75.3 {binary decode uuencode} -body { binary decode uuencode {} } -result {} +test binary-75.3.1 {binary decode uuencode} -body { + binary decode uuencode `\n +} -result {} test binary-75.4 {binary decode uuencode} -body { - binary decode uuencode [string repeat "86)C" 20] + binary decode uuencode "M[string repeat 86)C 15]\n/[string repeat 86)C 5]\n" } -result [string repeat abc 20] test binary-75.5 {binary decode uuencode} -body { - binary decode uuencode "``\$\"`P0``0(#" + binary decode uuencode ")``\$\"`P0``0(#" } -result "\0\1\2\3\4\0\1\2\3" test binary-75.6 {binary decode uuencode} -body { - string length [binary decode uuencode {`}] + string length [binary decode uuencode "`\n"] } -result 0 test binary-75.7 {binary decode uuencode} -body { - string length [binary decode uuencode {``}] + string length [binary decode uuencode "!`\n"] } -result 1 test binary-75.8 {binary decode uuencode} -body { - string length [binary decode uuencode {```}] + string length [binary decode uuencode "\"``\n"] } -result 2 test binary-75.9 {binary decode uuencode} -body { - string length [binary decode uuencode {````}] + string length [binary decode uuencode "#```\n"] } -result 3 test binary-75.10 {binary decode uuencode} -body { - set s "[string repeat 86)C 10]\n[string repeat 86)C 10]" + set s ">[string repeat 86)C 10]\n>[string repeat 86)C 10]" binary decode uuencode $s } -result [string repeat abc 20] test binary-75.11 {binary decode uuencode} -body { - set s "[string repeat 86)C 10]\n [string repeat 86)C 10]" + set s ">[string repeat 86)C 10]\n\t>\t[string repeat 86)C 10]\r" binary decode uuencode $s } -result [string repeat abc 20] test binary-75.12 {binary decode uuencode} -body { binary decode uuencode -strict "|86)C" } -returnCodes error -match glob -result {invalid uuencode character "|" at position 0} test binary-75.13 {binary decode uuencode} -body { - set s "[string repeat 86)C 10]|[string repeat 86)C 10]" + set s ">[string repeat 86)C 10]|[string repeat 86)C 10]" binary decode uuencode -strict $s -} -returnCodes error -match glob -result {invalid uuencode character "|" at position 40} +} -returnCodes error -match glob -result {invalid uuencode character "|" at position 41} test binary-75.14 {binary decode uuencode} -body { - set s "[string repeat 86)C 10]\n [string repeat 86)C 10]" + set s ">[string repeat 86)C 10]\na[string repeat 86)C 10]" binary decode uuencode -strict $s } -returnCodes error -match glob -result {invalid uuencode character *} test binary-75.20 {binary decode uuencode} -body { - set r [binary decode uuencode 8] + set r [binary decode uuencode " 8"] list [string length $r] $r } -result {0 {}} test binary-75.21 {binary decode uuencode} -body { - set r [binary decode uuencode 86] + set r [binary decode uuencode "!86"] list [string length $r] $r } -result {1 a} test binary-75.22 {binary decode uuencode} -body { - set r [binary decode uuencode 86)] + set r [binary decode uuencode "\"86)"] list [string length $r] $r } -result {2 ab} test binary-75.23 {binary decode uuencode} -body { - set r [binary decode uuencode 86)C] + set r [binary decode uuencode "#86)C"] list [string length $r] $r } -result {3 abc} test binary-75.24 {binary decode uuencode} -body { - set s "04)\# " + set s "#04)\# " binary decode uuencode $s } -result ABC test binary-75.25 {binary decode uuencode} -body { - set s "04)\#z" + set s "#04)\#z" binary decode uuencode $s -} -returnCodes error -match glob -result {invalid uuencode character "z" at position 4} +} -returnCodes error -match glob -result {invalid uuencode character "z" at position 5} test binary-75.26 {binary decode uuencode} -body { string length [binary decode uuencode " "] } -result 0 diff --git a/tests/chanio.test b/tests/chanio.test index 665df50..999d0bb 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -2214,13 +2214,17 @@ test chan-io-28.7 {Tcl_CloseEx (half-close) socket} -setup { puts $sok DONE exit 0 } echo.tcl] -} -body { + variable done + unset -nocomplain done + set done "" + set timer "" set ff [openpipe r $echo] gets $ff port +} -body { set s [socket 127.0.0.1 $port] puts $s Hey close $s w - set timer [after 1000 [namespace code {set ::done Failed}]] + set timer [after 1000 [namespace code {set done Failed}]] set acc {} fileevent $s readable [namespace code { if {[gets $s line]<0} { @@ -2230,11 +2234,11 @@ test chan-io-28.7 {Tcl_CloseEx (half-close) socket} -setup { } }] vwait [namespace which -variable done] - after cancel $timer - close $s r - close $ff list $done $acc } -cleanup { + catch {close $s} + close $ff + after cancel $timer removeFile echo.tcl } -result {Succeeded {Hey DONE}} diff --git a/tests/cmdAH.test b/tests/cmdAH.test index 3051bfb..39e9ece 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -954,6 +954,19 @@ test cmdAH-19.11 {Tcl_FileObjCmd: exists} -constraints {unix notRoot} -setup { removeFile /tmp/tcl.foo.dir/file removeDirectory /tmp/tcl.foo.dir } -result 0 +test cmdAH-19.12 {Bug 3608360: [file exists] mustn't do globbing} -setup { + set newdirfile [makeDirectory newdir.file] + set cwd [pwd] + cd $newdirfile + # Content of file is totally unimportant; name is *not* + set innocentBystander [makeFile "abc" [file join $newdirfile foo.bar]] +} -body { + list [file exists foo.bar] [file exists *.bar] +} -cleanup { + cd $cwd + removeFile $innocentBystander + removeDirectory $newdirfile +} -result {1 0} # Stat related commands diff --git a/tests/cmdIL.test b/tests/cmdIL.test index 721773f..23a5f96 100644 --- a/tests/cmdIL.test +++ b/tests/cmdIL.test @@ -417,6 +417,15 @@ test cmdIL-4.34 {SortCompare procedure, -ascii option with -nocase option} { test cmdIL-4.35 {SortCompare procedure, -ascii option with -nocase option} { lsort -ascii -nocase {d E c B a D35 d300 100 20} } {100 20 a B c d d300 D35 E} +test cmdIL-4.36 {SortCompare procedure, UTF-8 with -nocase option} { + scan [lsort -ascii -nocase [list \u101 \u100]] %c%c%c +} {257 32 256} +test cmdIL-4.37 {SortCompare procedure, UTF-8 with -nocase option} { + scan [lsort -ascii -nocase [list a\u0000a a]] %c%c%c%c%c +} {97 32 97 0 97} +test cmdIL-4.38 {SortCompare procedure, UTF-8 with -nocase option} { + scan [lsort -ascii -nocase [list a a\u0000a]] %c%c%c%c%c +} {97 32 97 0 97} test cmdIL-5.1 {lsort with list style index} { lsort -ascii -decreasing -index {0 1} { diff --git a/tests/cmdInfo.test b/tests/cmdInfo.test index 69d7171..0a587e8 100644 --- a/tests/cmdInfo.test +++ b/tests/cmdInfo.test @@ -13,10 +13,8 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest 2 - namespace import -force ::tcltest::* -} +package require tcltest 2 +namespace import ::tcltest::* ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] @@ -101,7 +99,7 @@ test cmdinfo-6.1 {Names for commands created when outside namespaces} \ # cleanup catch {namespace delete cmdInfoNs1::cmdInfoNs2 cmdInfoNs1} catch {rename x1 ""} -::tcltest::cleanupTests +cleanupTests return # Local Variables: diff --git a/tests/compile.test b/tests/compile.test index 4d91940..2852bf2 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -167,6 +167,36 @@ test compile-3.6 {TclCompileCatchCmd: error in storing result [Bug 3098302]} {*} -cleanup {namespace delete catchtest} } +test compile-3.7 {TclCompileCatchCmd: error in storing options [Bug 3098302]} {*}{ + -setup { + namespace eval catchtest { + variable options1 {} + } + trace add variable catchtest::options1 write catchtest::failtrace + proc catchtest::failtrace {n1 n2 op} { + return -code error "trace on $n1 fails by request" + } + } + -body { + proc catchtest::x {} { + variable options1 + set count 0 + for {set i 0} {$i < 10} {incr i} { + set status2 [catch { + set status1 [catch { + return -code error -level 0 "original failure" + } result1 options1] + } result2 options2] + incr count + } + list $count $result2 + } + catchtest::x + } + -result {10 {can't set "options1": trace on options1 fails by request}} + -cleanup {namespace delete catchtest} +} + test compile-4.1 {TclCompileForCmd: command substituted test expression} { set i 0 set j 0 @@ -707,6 +737,76 @@ test compile-18.19 {disassembler - basics} -setup { } -cleanup { foo destroy } -match glob -result * + +test compile-19.0 {Bug 3614102: reset stack housekeeping} -body { + # This will panic in a --enable-symbols=compile build, unless bug is fixed. + apply {{} {list [if 1]}} +} -returnCodes error -match glob -result * + +test compile-20.1 {ensure there are no infinite loops in optimizing} { + tcl::unsupported::disassemble script { + while 1 { + return -code continue -level 0 + } + } + return +} {} +test compile-20.2 {ensure there are no infinite loops in optimizing} { + tcl::unsupported::disassemble script { + while 1 { + while 1 { + return -code break -level 0 + } + } + } + return +} {} + +test compile-21.1 {stack balance management} { + apply {{} { + set result {} + while 1 { + lappend result a + lappend result [list b [break]] + lappend result c + } + return $result + }} +} a +test compile-21.2 {stack balance management} { + apply {{} { + set result {} + while {[incr i] <= 10} { + lappend result $i + lappend result [list b [continue] c] + lappend result c + } + return $result + }} +} {1 2 3 4 5 6 7 8 9 10} +test compile-21.3 {stack balance management} { + apply {args { + set result {} + while 1 { + lappend result a + lappend result [concat {*}$args [break]] + lappend result c + } + return $result + }} P Q R S T +} a +test compile-21.4 {stack balance management} { + apply {args { + set result {} + while {[incr i] <= 10} { + lappend result $i + lappend result [concat {*}$args [continue] c] + lappend result c + } + return $result + }} P Q R S T +} {1 2 3 4 5 6 7 8 9 10} + # TODO sometime - check that bytecode from tbcload is *not* disassembled. # cleanup diff --git a/tests/coroutine.test b/tests/coroutine.test index 8272717..a360fd5 100644 --- a/tests/coroutine.test +++ b/tests/coroutine.test @@ -342,6 +342,9 @@ test coroutine-3.6 {info frame, bug #2910094} -setup { rename stack {} rename a {} } -result {} +test coroutine-3.7 {bug 0b874c344d} { + dict get [coroutine X coroutine Y info frame 0] cmd +} {coroutine X coroutine Y info frame 0} test coroutine-4.1 {bug #2093188} -setup { proc foo {} { @@ -439,7 +442,7 @@ test coroutine-4.5 {bug #2724403} -constraints {memory} \ } -result 0 test coroutine-4.6 {compile context, bug #3282869} -setup { - unset ::x + unset -nocomplain ::x proc f x { coroutine D eval {yield X$x;yield Y} } @@ -609,6 +612,39 @@ test coroutine-7.3 {yielding between coroutines} -body { } -cleanup { catch {rename juggler ""} } -result {{{a b c d e} ::j1 {a b c d} ::j2 {a b c} ::j3 {a b} ::j1 a ::j2} {} {} {}} + +test coroutine-7.4 {Bug 8ff0cb9fe1} -setup { + proc foo {a b} {catch yield; return 1} +} -cleanup { + rename foo {} +} -body { + coroutine demo lsort -command foo {a b} +} -result {b a} + +test coroutine-7.5 {return codes} { + set result {} + foreach code {0 1 2 3 4 5} { + lappend result [catch {coroutine demo return -level 0 -code $code}] + } + set result +} {0 1 2 3 4 5} + +test coroutine-7.6 {Early yield crashes} { + proc foo args {} + trace add execution foo enter {catch yield} + coroutine demo foo + rename foo {} +} {} + +test coroutine-7.7 {Bug 2486550} -setup { + interp hide {} yield +} -body { + coroutine demo interp invokehidden {} yield ok +} -cleanup { + demo + interp expose {} yield +} -result ok + # cleanup unset lambda diff --git a/tests/dcall.test b/tests/dcall.test index 3df0ac8..41dd777 100644 --- a/tests/dcall.test +++ b/tests/dcall.test @@ -11,10 +11,8 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest - namespace import -force ::tcltest::* -} +package require tcltest 2 +namespace import ::tcltest::* ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] @@ -41,5 +39,5 @@ test dcall-1.6 {deletion callbacks} testdcall { } {} # cleanup -::tcltest::cleanupTests +cleanupTests return diff --git a/tests/dict.test b/tests/dict.test index 72a336c..a583de8 100644 --- a/tests/dict.test +++ b/tests/dict.test @@ -668,6 +668,24 @@ test dict-14.20 {dict for stack space compilation: bug 1903325} { concat "c=$y,$args" }} {} 1 2 3 } {c=1,2 3} +test dict-14.21 {compiled dict for and break} { + apply {{} { + dict for {a b} {c d e f} { + lappend result $a,$b + break + } + return $result + }} +} c,d +test dict-14.22 {dict for and exception range depths: Bug 3614382} { + apply {{} { + dict for {a b} {c d} { + dict for {e f} {g h} { + return 5 + } + } + }} +} 5 # There's probably a lot more tests to add here. Really ought to use a # coverage tool for this job... @@ -1586,7 +1604,7 @@ test dict-23.1 {dict compilation crash: Bug 3487626} { } }} [linenumber]}} } 5 -test dict-23.2 {dict compilation crash: Bug 3487626} knownBug { +test dict-23.2 {dict compilation crash: Bug 3487626} { # Something isn't quite right in line number and continuation line # tracking; at time of writing, this test produces 7, not 5, which # indicates that the extra newlines in the non-script argument are @@ -1820,7 +1838,7 @@ test dict-24.20.1 {dict compilation crash: 'dict for' bug 3487626} { } }} [linenumber]}} } 5 -test dict-24.21 {dict compilation crash: 'dict for' bug 3487626} knownBug { +test dict-24.21 {dict compilation crash: 'dict for' bug 3487626} { apply {{} {apply {n { set e {} set k {} @@ -1847,6 +1865,77 @@ j } }} [linenumber]}} } 5 +test dict-23.3 {CompileWord OBOE} { + # segfault when buggy + apply {{} {tcl::dict::lappend foo bar \ + [format baz]}} +} {bar baz} +test dict-23.4 {CompileWord OBOE} { + apply {n { + dict set foo {*}{ + } [return [incr n -[linenumber]]] val + }} [linenumber] +} 1 +test dict-23.5 {CompileWord OBOE} { + # segfault when buggy + apply {{} {tcl::dict::incr foo \ + [format bar]}} +} {bar 1} +test dict-23.6 {CompileWord OBOE} { + apply {n { + dict get {a b} {*}{ + } [return [incr n -[linenumber]]] + }} [linenumber] +} 1 +test dict-23.7 {CompileWord OBOE} { + apply {n { + dict for {a b} [return [incr n -[linenumber]]] {*}{ + } {} + }} [linenumber] +} 2 +test dict-23.8 {CompileWord OBOE} { + apply {n { + dict update foo {*}{ + } [return [incr n -[linenumber]]] x {} + }} [linenumber] +} 1 +test dict-23.9 {CompileWord OBOE} { + apply {n { + dict exists {} {*}{ + } [return [incr n -[linenumber]]] + }} [linenumber] +} 1 +test dict-23.10 {CompileWord OBOE} { + apply {n { + dict with foo {*}{ + } [return [incr n -[linenumber]]] {} + }} [linenumber] +} 1 +test dict-23.11 {CompileWord OBOE} { + apply {n { + dict with ::foo {*}{ + } [return [incr n -[linenumber]]] {} + }} [linenumber] +} 1 +test dict-23.12 {CompileWord OBOE} { + apply {n { + dict with {*}{ + } [return [incr n -[linenumber]]] {} + }} [linenumber] +} 1 +test dict-23.13 {CompileWord OBOE} { + apply {n { + dict with {*}{ + } [return [incr n -[linenumber]]] {bar} + }} [linenumber] +} 1 +test dict-23.14 {CompileWord OBOE} { + apply {n { + dict with foo {*}{ + } [return [incr n -[linenumber]]] {bar} + }} [linenumber] +} 1 + rename linenumber {} test dict-24.22 {dict map results (non-compiled)} { dict map {k v} [dict map {k v} {a 1 b 2 c 3 d 4} { list $v $k }] { diff --git a/tests/env.test b/tests/env.test index 9010f52..83d99e0 100644 --- a/tests/env.test +++ b/tests/env.test @@ -70,7 +70,7 @@ set printenvScript [makeFile { } proc mangle s { regsub -all {\[|\\|\]} $s {\\&} s - regsub -all {[\u0000-\u001f\u007f-\uffff]} $s {[manglechar &]} s + regsub -all "\[\u0000-\u001f\u007f-\uffff\]" $s {[manglechar &]} s return [subst -novariables $s] } proc manglechar c { @@ -89,7 +89,7 @@ set printenvScript [makeFile { SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING __CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM - CommonProgramFiles ProgramFiles + CommonProgramFiles ProgramFiles CommonProgramW6432 ProgramW6432 } { lrem names $name } @@ -121,7 +121,7 @@ foreach name [array names env] { SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING SECURITYSESSIONID LANG WINDIR TERM - CommonProgramFiles ProgramFiles + CONNOMPROGRAMFILES PROGRAMFILES COMMONPROGRAMW6432 PROGRAMW6432 }} { unset env($name) } @@ -218,8 +218,8 @@ test env-4.5 {unsetting international environment variables} -setup { unset env(\ua7) getenv } -constraints {exec} -cleanup { - encoding system $sysenc unset env(\ub6) + encoding system $sysenc } -result {\u00b6=\u00a7} test env-5.0 {corner cases - set a value, it should exist} -body { @@ -291,6 +291,29 @@ test env-6.1 {corner cases - add lots of env variables} {} { expr {[array size env] - $size} } 100 +test env-7.1 {[219226]: whole env array should not be unset by read} { + set n [array size env] + set s [array startsearch env] + while {[array anymore env $s]} { + array nextelement env $s + incr n -1 + } + array donesearch env $s + return $n +} 0 +test env-7.2 {[219226]: links to env elements should not be removed by read} { + apply {{} { + set ::env(test7_2) ok + upvar env(test7_2) elem + set ::env(PATH) + try { + return $elem + } finally { + unset ::env(test7_2) + } + }} +} ok + # Restore the environment variables at the end of the test. foreach name [array names env] { diff --git a/tests/error.test b/tests/error.test index 97bcc0a..0de644c 100644 --- a/tests/error.test +++ b/tests/error.test @@ -17,6 +17,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { } testConstraint memory [llength [info commands memory]] +customMatch pairwise {apply {{a b} { + string equal [lindex $b 0] [lindex $b 1] +}}} namespace eval ::tcl::test::error { if {[testConstraint memory]} { proc getbytes {} { @@ -179,6 +182,16 @@ test error-4.7 {errorstack via options dict } -body { catch {f 12} m d dict get $d -errorstack } -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1} +test error-4.8 {errorstack from exec traces} -body { + proc foo args {} + proc goo {} foo + trace add execution foo enter {error bar;#} + catch goo m d + dict get $d -errorstack +} -cleanup { + rename goo {}; rename foo {} + unset -nocomplain m d +} -result {INNER {error bar} CALL goo UP 1} # Errors in error command itself @@ -314,6 +327,12 @@ test error-8.8 {throw syntax checks} -returnCodes error -body { test error-8.9 {throw syntax checks} -returnCodes error -body { throw {} foo } -result {type must be non-empty list} +test error-8.10 {Bug 33b7abb8a2: throw stack usage} -returnCodes error -body { + apply {code {throw $code foo}} {} +} -result {type must be non-empty list} +test error-8.11 {Bug 7174354ecb: throw error message} -returnCodes error -body { + throw {not {}a list} x[]y +} -result {list element in braces followed by "a" instead of space} # simple try tests: body completes with code ok @@ -601,21 +620,21 @@ test error-16.7 {try with variable assignment and propagation #2} { } list $em [dict get $opts -errorcode] } {bar FOO} -test error-16.8 {exception chaining (try=ok, handler=error)} { +test error-16.8 {exception chaining (try=ok, handler=error)} -body { #FIXME is the intent of this test correct? catch { try { list a b c } on ok {em opts} { throw BAR baz } } tryem tryopts - string equal $opts [dict get $tryopts -during] -} {1} -test error-16.9 {exception chaining (try=error, handler=error)} { + list $opts [dict get $tryopts -during] +} -match pairwise -result equal +test error-16.9 {exception chaining (try=error, handler=error)} -body { # The exception off the handler should chain to the exception off the # try-body (using the -during option) catch { try { throw FOO bar } trap {} {em opts} { throw BAR baz } } tryem tryopts - string equal $opts [dict get $tryopts -during] -} {1} + list $opts [dict get $tryopts -during] +} -match pairwise -result equal test error-16.10 {no exception chaining when handler is successful} { catch { try { throw FOO bar } trap {} {em opts} { list d e f } @@ -628,6 +647,131 @@ test error-16.11 {no exception chaining when handler is a non-error exception} { } tryem tryopts dict exists $tryopts -during } {0} +test error-16.12 {compiled try with successfully executed handler} { + apply {{} { + try { throw FOO bar } trap FOO {} { list a b c } + }} +} {a b c} +test error-16.13 {compiled try with exception (error) in handler} -body { + apply {{} { + try { throw FOO bar } trap FOO {} { throw BAR foo } + }} +} -returnCodes error -result {foo} +test error-16.14 {compiled try with exception (return) in handler} -body { + apply {{} { + list [catch { + try { throw FOO bar } trap FOO {} { return BAR } + } msg] $msg + }} +} -result {2 BAR} +test error-16.15 {compiled try with exception (break) in handler} { + apply {{} { + for { set i 5 } { $i < 10 } { incr i } { + try { throw FOO bar } trap FOO {} { break } + } + return $i + }} +} {5} +test error-16.16 {compiled try with exception (continue) in handler} { + apply {{} { + for { set i 5 } { $i < 10 } { incr i } { + try { throw FOO bar } trap FOO {} { continue } + incr i 20 + } + return $i + }} +} {10} +test error-16.17 {compiled try with variable assignment and propagation #1} { + # Ensure that the handler variables preserve the exception off the + # try-body, and are not modified by the exception off the handler + apply {{} { + catch { + try { throw FOO bar } trap FOO {em} { throw BAR baz } + } + return $em + }} +} {bar} +test error-16.18 {compiled try with variable assignment and propagation #2} { + apply {{} { + catch { + try { throw FOO bar } trap FOO {em opts} { throw BAR baz } + } + list $em [dict get $opts -errorcode] + }} +} {bar FOO} +test error-16.19 {compiled try exception chaining (try=ok, handler=error)} -body { + #FIXME is the intent of this test correct? + apply {{} { + catch { + try { list a b c } on ok {em opts} { throw BAR baz } + } tryem tryopts + list $opts [dict get $tryopts -during] + }} +} -match pairwise -result equal +test error-16.20 {compiled try exception chaining (try=error, handler=error)} -body { + # The exception off the handler should chain to the exception off the + # try-body (using the -during option) + apply {{} { + catch { + try { throw FOO bar } trap {} {em opts} { throw BAR baz } + } tryem tryopts + list $opts [dict get $tryopts -during] + }} +} -match pairwise -result equal +test error-16.21 {compiled try exception chaining (try=error, finally=error)} { + # The exception off the handler should chain to the exception off the + # try-body (using the -during option) + apply {{} { + catch { + try { throw FOO bar } finally { throw BAR baz } + } tryem tryopts + dict get $tryopts -during -errorcode + }} +} FOO +test error-16.22 {compiled try: no exception chaining when handler is successful} { + apply {{} { + catch { + try { throw FOO bar } trap {} {em opts} { list d e f } + } tryem tryopts + dict exists $tryopts -during + }} +} {0} +test error-16.23 {compiled try: no exception chaining when handler is a non-error exception} { + apply {{} { + catch { + try { throw FOO bar } trap {} {em opts} { break } + } tryem tryopts + dict exists $tryopts -during + }} +} {0} +test error-16.24 {compiled try exception chaining (try=ok, handler=error, finally=error)} -body { + apply {{} { + catch { + try { + list a b c + } on ok {em opts} { + throw BAR baz + } finally { + throw DING dong + } + } tryem tryopts + list $opts [dict get $tryopts -during -during] + }} +} -match pairwise -result equal +test error-16.25 {compiled try exception chaining (all errors)} -body { + apply {{} { + catch { + try { + throw FOO bar + } on error {em opts} { + throw BAR baz + } finally { + throw DING dong + } + } tryem tryopts + list $opts [dict get $tryopts -during -during] + }} +} -match pairwise -result equal # try tests - finally @@ -709,15 +853,15 @@ test error-18.5 {exception in finally doesn't affect variable assignment} { } list $em [dict get $opts -errorcode] } {bar FOO} -test error-18.6 {exception chaining in finally (try=ok)} { +test error-18.6 {exception chaining in finally (try=ok)} -body { catch { list a b c } em expopts catch { try { list a b c } finally { throw BAR foo } } em opts - string equal $expopts [dict get $opts -during] -} {1} + list $expopts [dict get $opts -during] +} -match pairwise -result equal test error-18.7 {exception chaining in finally (try=error)} { catch { try { throw FOO bar } finally { throw BAR baz } diff --git a/tests/exec.test b/tests/exec.test index 64d3517..871c0c5 100644 --- a/tests/exec.test +++ b/tests/exec.test @@ -157,7 +157,7 @@ test exec-2.6 {redirecting input from immediate source, with UTF} -setup { encoding system iso8859-1 proc quotenonascii s { regsub -all {\[|\\|\]} $s {\\&} s - regsub -all {[\u007f-\uffff]} $s \ + regsub -all "\[\u007f-\uffff\]" $s \ {[apply {c {format {\u%04x} [scan $c %c]}} &]} s return [subst -novariables $s] } diff --git a/tests/expr-old.test b/tests/expr-old.test index 4f3cb2e..06a00ba 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -13,10 +13,8 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest 2.1 - namespace import -force ::tcltest::* -} +package require tcltest 2.1 +namespace import ::tcltest::* ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] @@ -145,7 +143,7 @@ test expr-old-1.50 {integer operators} {expr +36} 36 test expr-old-1.51 {integer operators} {expr +--++36} 36 test expr-old-1.52 {integer operators} {expr +36%+5} 1 test expr-old-1.53 {integer operators} { - catch {unset x} + unset -nocomplain x set x yes list [expr {1 && $x}] [expr {$x && 1}] \ [expr {0 || $x}] [expr {$x || 0}] @@ -453,7 +451,7 @@ test expr-old-23.3 {double quotes} { test expr-old-23.4 {double quotes} {expr {"11\}\}22"}} 11}}22 test expr-old-23.5 {double quotes} {expr {"\*bc"}} {*bc} test expr-old-23.6 {double quotes} { - catch {unset bogus__} + unset -nocomplain bogus__ list [catch {expr {"$bogus__"}} msg] $msg } {1 {can't read "bogus__": no such variable}} test expr-old-23.7 {double quotes} { @@ -502,7 +500,7 @@ test expr-old-26.2 {error conditions} -body { test expr-old-26.3 {error conditions} -body { expr 2+4*( } -returnCodes error -match glob -result * -catch {unset _non_existent_} +unset -nocomplain _non_existent_ test expr-old-26.4 {error conditions} { list [catch {expr 2+$_non_existent_} msg] $msg } {1 {can't read "_non_existent_": no such variable}} @@ -581,7 +579,7 @@ test expr-old-27.4 {cancelled evaluation} { expr {1?2:[set a 2]} set a } 1 -catch {unset x} +unset -nocomplain x test expr-old-27.5 {cancelled evaluation} { list [catch {expr {[info exists x] && $x}} msg] $msg } {0 0} diff --git a/tests/fCmd.test b/tests/fCmd.test index 325b374..8f27ad4 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -2441,14 +2441,17 @@ test fCmd-28.12 {file link: cd into a link} -setup { return "ok" } } -cleanup { + file delete -force abc.link cd [workingDirectory] } -result ok test fCmd-28.13 {file link} -constraints {linkDirectory} -setup { cd [temporaryDirectory] + file link abc.link abc.dir } -body { # duplicate link throws error file link abc.link abc.dir } -returnCodes error -cleanup { + file delete -force abc.link cd [workingDirectory] } -result {could not create new link "abc.link": that path already exists} test fCmd-28.14 {file link: deletes link not dir} -setup { @@ -2469,6 +2472,7 @@ test fCmd-28.15.1 {file link: copies link not dir} -setup { # directory, not a link (links trace to endpoint). list [file type abc2.link] [file tail [file link abc.link]] } -cleanup { + file delete -force abc.link cd [workingDirectory] } -result {directory abc.dir} test fCmd-28.15.2 {file link: copies link not dir} -setup { @@ -2479,6 +2483,7 @@ test fCmd-28.15.2 {file link: copies link not dir} -setup { file copy abc.link abc2.link list [file type abc2.link] [file tail [file link abc2.link]] } -cleanup { + file delete -force abc.link cd [workingDirectory] } -result {link abc.dir} cd [temporaryDirectory] @@ -2498,20 +2503,25 @@ test fCmd-28.16 {file link: glob inside link} -setup { file link abc.link abc.dir lsort [glob -dir abc.link -tails *] } -cleanup { + file delete -force abc.link cd [workingDirectory] } -result {abc.file abc2.file} test fCmd-28.17 {file link: glob -type l} -setup { cd [temporaryDirectory] + file link abc.link abc.dir } -constraints {linkDirectory} -body { glob -dir [pwd] -type l -tails abc* } -cleanup { + file delete -force abc.link cd [workingDirectory] } -result {abc.link} test fCmd-28.18 {file link: glob -type d} -constraints linkDirectory -setup { cd [temporaryDirectory] + file link abc.link abc.dir } -body { lsort [glob -dir [pwd] -type d -tails abc*] } -cleanup { + file delete -force abc.link cd [workingDirectory] } -result [lsort [list abc.link abc.dir abc2.dir]] test fCmd-28.19 {file link: relative paths} -setup { diff --git a/tests/fileSystem.test b/tests/fileSystem.test index b098f35..942a86c 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -138,13 +138,18 @@ test filesystem-1.9 {link normalisation} -setup { testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \ [file normalize [file join dir.link inside.file foo]] } -result ok -test filesystem-1.10 {link normalisation: double link} {unix hasLinks} { +test filesystem-1.10 {link normalisation: double link} -constraints { + unix hasLinks +} -body { file link dir2.link dir.link testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \ [file normalize [file join dir2.link inside.file foo]] -} ok +} -cleanup { + file delete dir2.link +} -result ok makeDirectory dir2.file test filesystem-1.11 {link normalisation: double link, back in tree} {unix hasLinks} { + file link dir2.link dir.link file link [file join dir2.file dir2.link] [file join .. dir2.link] testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \ [file normalize [file join dir2.file dir2.link inside.file foo]] @@ -373,7 +378,9 @@ test filesystem-2.0 {new native path} {unix} { # Make sure the testfilesystem hasn't been registered. if {[testConstraint testfilesystem]} { + proc resetfs {} { while {![catch {testfilesystem 0}]} {} + } } test filesystem-3.1 {Tcl_FSRegister & Tcl_FSUnregister} testfilesystem { @@ -388,12 +395,14 @@ test filesystem-3.3 {Tcl_FSRegister} testfilesystem { testfilesystem 0 testfilesystem 0 } {unregistered} -test filesystem-3.4 {Tcl_FSRegister} testfilesystem { +test filesystem-3.4 {Tcl_FSRegister} -constraints testfilesystem -body { testfilesystem 1 file system bar -} {reporting} -test filesystem-3.5 {Tcl_FSUnregister} testfilesystem { +} -cleanup { testfilesystem 0 +} -result {reporting} +test filesystem-3.5 {Tcl_FSUnregister} testfilesystem { + resetfs lindex [file system bar] 0 } {native} @@ -632,7 +641,7 @@ test filesystem-7.4 {cross-filesystem file copy with -force} -setup { file delete -force simplefile file delete -force file2 cd $dir -} -result {0 10 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 10 1} +} -result {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 {} 1} test filesystem-7.5 {cross-filesystem file copy with -force} -setup { set dir [pwd] cd [tcltest::temporaryDirectory] @@ -657,7 +666,7 @@ test filesystem-7.5 {cross-filesystem file copy with -force} -setup { file delete -force simplefile file delete -force file2 cd $dir -} -result {0 10 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 10 1} +} -result {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 {} 1} test filesystem-7.6 {cross-filesystem dir copy with -force} -setup { set dir [pwd] cd [tcltest::temporaryDirectory] diff --git a/tests/for.test b/tests/for.test index ff4dc0e..8abd270 100644 --- a/tests/for.test +++ b/tests/for.test @@ -14,6 +14,12 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +# Used for constraining memory leak tests +testConstraint memory [llength [info commands memory]] +if {[testConstraint memory]} { + proc meminfo {} {lindex [split [memory info] "\n"] 3 3} +} + # Basic "for" operation. test for-1.1 {TclCompileForCmd: missing initial command} { @@ -345,7 +351,6 @@ proc formatMail {} { 64 { UNIX (Solaris 2.* and SunOS, other systems soon to follow). Easy to install} \ 65 { binary packages are now for sale at the Sun Labs Tcl/Tk Shop. Check it out!} \ } - set result "" set NL " " @@ -365,7 +370,6 @@ proc formatMail {} { } else { set break 1 } - set xmailer 0 set inheaders 1 set last [array size lines] @@ -386,9 +390,7 @@ proc formatMail {} { set limit 55 } else { set limit 55 - # Decide whether or not to break the body line - if {$plen > 0} { if {[string first {> } $line] == 0} { # This is quoted text from previous message, don't reformat @@ -431,7 +433,7 @@ proc formatMail {} { set climit [expr $limit-1] set cutoff 50 set continuation 0 - + while {[string length $line] > $limit} { for {set c [expr $limit-1]} {$c >= $cutoff} {incr c -1} { set char [string index $line $c] @@ -824,7 +826,369 @@ test for-6.18 {Tcl_ForObjCmd: for command result} { 1 {invoked "continue" outside of a loop} \ ] - +test for-7.1 {Bug 3614226: ensure that break cleans up the stack} memory { + apply {{} { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {$x < 5} {incr x} { + list a b c [break] d e f + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.2 {Bug 3614226: ensure that continue cleans up the stack} memory { + apply {{} { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {$x < 5} {incr x} { + list a b c [continue] d e f + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.3 {Bug 3614226: ensure that break cleans up the expansion stack} memory { + apply {{} { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts {*}[puts a b c {*}[break] d e f] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.4 {Bug 3614226: ensure that continue cleans up the expansion stack} memory { + apply {{} { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts {*}[puts a b c {*}[continue] d e f] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.5 {Bug 3614226: ensure that break cleans up the combination of main and expansion stack} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[break] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.6 {Bug 3614226: ensure that continue cleans up the combination of main and expansion stack} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[continue] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.7 {Bug 3614226: ensure that break only cleans up the right amount} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[break] d e f]] + }] + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.8 {Bug 3614226: ensure that continue only cleans up the right amount} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[continue] d e f]] + }] + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.9 {Bug 3614226: ensure that break from invoked command cleans up the stack} memory { + apply {{} { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {$x < 5} {incr x} { + list a b c [apply {{} {return -code break}}] d e f + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.10 {Bug 3614226: ensure that continue from invoked command cleans up the stack} memory { + apply {{} { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {$x < 5} {incr x} { + list a b c [apply {{} {return -code continue}}] d e f + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.11 {Bug 3614226: ensure that break from invoked command cleans up the expansion stack} memory { + apply {{} { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts {*}[puts a b c {*}[apply {{} {return -code break}}] d e f] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.12 {Bug 3614226: ensure that continue from invoked command cleans up the expansion stack} memory { + apply {{} { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts {*}[puts a b c {*}[apply {{} { + return -code continue + }}] d e f] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.13 {Bug 3614226: ensure that break from invoked command cleans up the combination of main and expansion stack} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} { + return -code break + }}] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.14 {Bug 3614226: ensure that continue from invoked command cleans up the combination of main and expansion stack} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} { + return -code continue + }}] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.15 {Bug 3614226: ensure that break from invoked command only cleans up the right amount} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} { + return -code break + }}] d e f]] + }] + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.16 {Bug 3614226: ensure that continue from invoked command only cleans up the right amount} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} { + return -code continue + }}] d e f]] + }] + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.17 {Bug 3614226: ensure that break from expanded command cleans up the stack} memory { + apply {op { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {$x < 5} {incr x} { + list a b c [{*}$op] d e f + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code break} +} 0 +test for-7.18 {Bug 3614226: ensure that continue from expanded command cleans up the stack} memory { + apply {op { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {$x < 5} {incr x} { + list a b c [{*}$op] d e f + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code continue} +} 0 +test for-7.19 {Bug 3614226: ensure that break from expanded command cleans up the expansion stack} memory { + apply {op { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts {*}[puts a b c {*}[{*}$op] d e f] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code break} +} 0 +test for-7.20 {Bug 3614226: ensure that continue from expanded command cleans up the expansion stack} memory { + apply {op { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts {*}[puts a b c {*}[{*}$op] d e f] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code continue} +} 0 +test for-7.21 {Bug 3614226: ensure that break from expanded command cleans up the combination of main and expansion stack} memory { + apply {op { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code break} +} 0 +test for-7.22 {Bug 3614226: ensure that continue from expanded command cleans up the combination of main and expansion stack} memory { + apply {op { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code continue} +} 0 +test for-7.23 {Bug 3614226: ensure that break from expanded command only cleans up the right amount} memory { + apply {op { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]] + }] + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code break} +} 0 +test for-7.24 {Bug 3614226: ensure that continue from expanded command only cleans up the right amount} memory { + apply {op { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]] + }] + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code continue} +} 0 + # cleanup ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# End: diff --git a/tests/foreach.test b/tests/foreach.test index 6c69b29..6fd5476 100644 --- a/tests/foreach.test +++ b/tests/foreach.test @@ -254,6 +254,17 @@ test foreach-9.1 {compiled empty var list} { list [catch { foo } msg] $msg } {1 {foreach varlist is empty}} +test foreach-9.2 {line numbers} -setup { + proc linenumber {} {dict get [info frame -1] line} +} -body { + apply {n { + foreach x y {*}{ + } {return [incr n -[linenumber]]} + }} [linenumber] +} -cleanup { + rename linenumber {} +} -result 1 + test foreach-10.1 {foreach: [Bug 1671087]} -setup { proc demo {} { set vals {1 2 3 4} diff --git a/tests/http.test b/tests/http.test index 9861e0e..a52cfb1 100644 --- a/tests/http.test +++ b/tests/http.test @@ -119,7 +119,7 @@ test http-3.2 {http::geturl} -returnCodes error -body { http::geturl http:junk } -result {Unsupported URL: http:junk} set url //[info hostname]:$port -set badurl //[info hostname]:6666 +set badurl //[info hostname]:[expr $port+1] test http-3.3 {http::geturl} -body { set token [http::geturl $url] http::data $token @@ -131,10 +131,11 @@ test http-3.3 {http::geturl} -body { </body></html>" set tail /a/b/c set url //[info hostname]:$port/a/b/c -set fullurl http://user:pass@[info hostname]:$port/a/b/c +set fullurl HTTP://user:pass@[info hostname]:$port/a/b/c set binurl //[info hostname]:$port/binary set posturl //[info hostname]:$port/post set badposturl //[info hostname]:$port/droppost +set authorityurl //[info hostname]:$port set ipv6url http://\[::1\]:$port/ test http-3.4 {http::geturl} -body { set token [http::geturl $url] @@ -391,7 +392,7 @@ Connection close Content-Type {text/plain;charset=utf-8} Accept-Encoding .* Content-Length 5} -test http-3.29 "http::geturl $ipv6url" -body { +test http-3.29 {http::geturl IPv6 address} -body { # We only want to see if the URL gets parsed correctly. This is # the case if http::geturl succeeds or returns a socket related # error. If the parsing is wrong, we'll get a parse error. @@ -405,7 +406,18 @@ test http-3.29 "http::geturl $ipv6url" -body { } -cleanup { catch { http::cleanup $token } } -result 0 - +test http-3.30 {http::geturl query without path} -body { + set token [http::geturl $authorityurl?var=val] + http::ncode $token +} -cleanup { + catch { http::cleanup $token } +} -result 200 +test http-3.31 {http::geturl fragment without path} -body { + set token [http::geturl "$authorityurl#fragment42"] + http::ncode $token +} -cleanup { + catch { http::cleanup $token } +} -result 200 test http-4.1 {http::Event} -body { set token [http::geturl $url -keepalive 0] upvar #0 $token data @@ -547,11 +559,10 @@ test http-4.14 {http::Event} -body { error "bogus return from http::geturl" } http::wait $token - http::status $token - # error code varies among platforms. -} -returnCodes 1 -match regexp -cleanup { + lindex [http::error $token] 0 +} -cleanup { catch {http::cleanup $token} -} -result {(connect failed|couldn't open socket)} +} -result {connect failed connection refused} # Bogus host test http-4.15 {http::Event} -body { # This test may fail if you use a proxy server. That is to be diff --git a/tests/httpd b/tests/httpd index f810797..232e80a 100644 --- a/tests/httpd +++ b/tests/httpd @@ -40,7 +40,7 @@ proc httpdAccept {newsock ipaddr port} { fconfigure $newsock -blocking 0 -translation {auto crlf} httpd_log $newsock Connect $ipaddr $port set data(ipaddr) $ipaddr - fileevent $newsock readable [list httpdRead $newsock] + after 50 [list fileevent $newsock readable [list httpdRead $newsock]] } # read data from a client request diff --git a/tests/info.test b/tests/info.test index ebc853a..3057dd2 100644 --- a/tests/info.test +++ b/tests/info.test @@ -1962,6 +1962,440 @@ test info-9.13 {info level option, value in global context} -body { } -returnCodes error -result {bad level "2"} # ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + catch {*}{ + {info frame 0} + res + } + return $res +} +test info-33.4 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 1968 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + dict for {a b} {c d} {*}{ + {set res [info frame 0]} + } + return $res +} +test info-33.5 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 1983 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + set d {a b} + dict update d x y {*}{ + {set res [info frame 0]} + } + return $res +} +test info-33.6 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 1998 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + set d {} + dict with d {*}{ + {set res [info frame 0]} + } + return $res +} +test info-33.7 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2013 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + for {*}{ + {set res [info frame 0]} + {1} {} {break} + } + return $res +} +test info-33.8 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2027 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + for {*}{ + {} {1} {} + {set res [info frame 0]; break} + } + return $res +} +test info-33.9 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2043 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + for {*}{ + {} {1} + {return [info frame 0]} + {} + } +} +test info-33.10 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2058 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + for {*}{ + {} + {[return [info frame 0]]} + {} {} + } +} +test info-33.11 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2073 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + foreach {*}{ + x + } [return [info frame 0]] {} +} +test info-33.12 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2088 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + foreach {*}{ + x y + {set res [info frame 0]} + } + return $res +} +test info-33.13 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2101 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + if {*}{ + {[return [info frame 0]]} + {} + } +} +test info-33.14 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2115 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + if 0 {*}{ + {} else + {return [info frame 0]} + } +} +test info-33.15 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2130 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + incr {*}{ + x + } [return [info frame 0]] +} +test info-33.16 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2144 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + info level {*}{ + } [return [info frame 0]] +} +test info-33.17 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2156 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + string match {*}{ + } [return [info frame 0]] {} +} +test info-33.18 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2168 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + string match {*}{ + {} + } [return [info frame 0]] +} +test info-33.19 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2181 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + string length {*}{ + } [return [info frame 0]] +} +test info-33.20 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2193 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + while {*}{ + {[return [info frame 0]]} + } {} +} +test info-33.21 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2205 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + switch -- {*}{ + } [return [info frame 0]] {*}{ + } x y +} +test info-33.22 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2218 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + try {*}{ + {set res [info frame 0]} + } + return $res +} +test info-33.23 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2231 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + try {*}{ + {set res [info frame 0]} + } finally {} + return $res +} +test info-33.24 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2245 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + try {*}{ + {set res [info frame 0]} + } on ok {} {} + return $res +} +test info-33.25 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2259 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + try {*}{ + {set res [info frame 0]} + } on ok {} {} finally {} + return $res +} +test info-33.26 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2273 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + while 1 {*}{ + {return [info frame 0]} + } +} +test info-33.27 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2287 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + try {} finally {*}{ + {return [info frame 0]} + } +} +test info-33.28 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2300 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + try {} on ok {} {} finally {*}{ + {return [info frame 0]} + } +} +test info-33.29 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2313 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + try {} on ok {} {*}{ + {return [info frame 0]} + } +} +test info-33.30 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2326 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + try {} on ok {} {*}{ + {return [info frame 0]} + } finally {} +} +test info-33.31 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2339 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + binary format {*}{ + } [return [info frame 0]] +} +test info-33.32 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2352 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + set format format + binary $format {*}{ + } [return [info frame 0]] +} +test info-33.33 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2365 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + append x {*}{ + } [return [info frame 0]] +} +test info-33.34 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2377 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + append {*}{ + } x([return [info frame 0]]) {*}{ + } a +} +test info-33.35 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 2389 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- unset -nocomplain res # cleanup diff --git a/tests/interp.test b/tests/interp.test index 0af9887..ad99fac 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -1599,6 +1599,20 @@ test interp-20.50 {Bug 2486550} -setup { } -cleanup { interp delete slave } -returnCodes error -match glob -result * +test interp-20.50.1 {Bug 2486550} -setup { + interp create slave +} -body { + slave hide coroutine + catch {slave invokehidden coroutine} m o + dict get $o -errorinfo +} -cleanup { + unset -nocomplain m 0 + interp delete slave +} -returnCodes ok -result {wrong # args: should be "coroutine name cmd ?arg ...?" + while executing +"coroutine" + invoked from within +"slave invokehidden coroutine"} test interp-21.1 {interp hidden} { interp hidden {} diff --git a/tests/listObj.test b/tests/listObj.test index 937fb1d..d7fb46c 100644 --- a/tests/listObj.test +++ b/tests/listObj.test @@ -196,7 +196,7 @@ test listobj-10.1 {Bug [2971669]} {*}{ -result {{a b c d e} {} {a b c d e f}} } -test listobj-11.1 {bug 3598580} { +test listobj-11.1 {Bug 3598580: Tcl_ListObjReplace refcount management} testobj { testobj bug3598580 } 123 diff --git a/tests/lmap.test b/tests/lmap.test index 7baa77b..08035d9 100644 --- a/tests/lmap.test +++ b/tests/lmap.test @@ -18,7 +18,7 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } -unset -nocomplain a i x +unset -nocomplain a b i x # ----- Non-compiled operation ----------------------------------------------- @@ -404,14 +404,21 @@ test lmap-7.6 {lmap: related to "foreach" [Bug 1671087]} -setup { rename demo {} } -result {2 4} # Huge lists must not overflow the bytecode interpreter (development bug) -test lmap-7.7 {huge list non-compiled} { +test lmap-7.7 {huge list non-compiled} -setup { + unset -nocomplain a b x +} -body { set x [lmap a [lrepeat 1000000 x] { set b y$a }] list $b [llength $x] [string length $x] -} {yx 1000000 2999999} -test lmap-7.8 {huge list compiled} { - set x [apply {{times} { lmap a [lrepeat $times x] { set b y$a }}} 1000000] +} -result {yx 1000000 2999999} +test lmap-7.8 {huge list compiled} -setup { + unset -nocomplain a b x +} -body { + set x [apply {{times} { + global b + lmap a [lrepeat $times x] { set b Y$a } + }} 1000000] list $b [llength $x] [string length $x] -} {yx 1000000 2999999} +} -result {Yx 1000000 2999999} test lmap-7.9 {error then dereference loop var (dev bug)} { catch { lmap a 0 b {1 2 3} { error x } } set a diff --git a/tests/load.test b/tests/load.test index cded85d..9536271 100644 --- a/tests/load.test +++ b/tests/load.test @@ -215,6 +215,12 @@ test load-10.1 {load from vfs} \ -body {list [catch {load simplefs:/pkgd$ext pkgd} msg] $msg} \ -result {0 {}} \ -cleanup {testsimplefilesystem 0; cd $dir; unset dir} + +test load-11.1 {Load TclOO extension using Stubs (Bug [f51efe99a7])} \ + [list $dll $loaded] { + load [file join $testDir pkgooa$ext] + list [pkgooa_stubsok] [lsort [info commands pkgooa_*]] +} {1 pkgooa_stubsok} # cleanup unset ext diff --git a/tests/main.test b/tests/main.test index f1dc7fd..351fd4f 100644 --- a/tests/main.test +++ b/tests/main.test @@ -129,7 +129,7 @@ namespace eval ::tcl::test::main { set script [makeFile {} script] file delete $script set f [open $script w] - fconfigure $f -encoding utf-8 + chan configure $f -encoding utf-8 puts $f {puts [list $argv0 $argv $tcl_interactive]} puts -nonewline $f {puts [string equal \u20ac } puts $f "\u20ac]" @@ -150,7 +150,7 @@ namespace eval ::tcl::test::main { set script [makeFile {} script] file delete $script set f [open $script w] - fconfigure $f -encoding utf-8 + chan configure $f -encoding utf-8 puts $f {puts [list $argv0 $argv $tcl_interactive]} puts -nonewline $f {puts [string equal \u20ac } puts $f "\u20ac]" @@ -171,7 +171,7 @@ namespace eval ::tcl::test::main { set script [makeFile {} script] file delete $script set f [open $script w] - fconfigure $f -encoding utf-8 + chan configure $f -encoding utf-8 puts $f {puts [list $argv0 $argv $tcl_interactive]} puts -nonewline $f {puts [string equal \u20ac } puts $f "\u20ac]" @@ -592,7 +592,7 @@ namespace eval ::tcl::test::main { catch {set f [open "|[list [interpreter]]" w+]} } -body { type $f { - fconfigure stdin -blocking 0 + chan configure stdin -blocking 0 puts SUCCESS } list [catch {gets $f} line] $line @@ -606,19 +606,19 @@ namespace eval ::tcl::test::main { exec } -setup { catch {set f [open "|[list [interpreter]]" w+]} - catch {fconfigure $f -blocking 0} + catch {chan configure $f -blocking 0} } -body { - type $f "fconfigure stdin -eofchar \\032 + type $f "chan configure stdin -eofchar \\032 if 1 \{\n\032" variable wait - fileevent $f readable \ + chan event $f readable \ [list set [namespace which -variable wait] "child exit"] set id [after 2000 [list set [namespace which -variable wait] timeout]] vwait [namespace which -variable wait] after cancel $id set wait } -cleanup { - if {[string equal timeout $wait] && [testConstraint unix]} { + if {$wait eq "timeout" && [testConstraint unix]} { exec kill [pid $f] } close $f @@ -631,17 +631,17 @@ namespace eval ::tcl::test::main { } -setup { set cmd {makeFile "if 1 \{" script} catch {set f [open "|[list [interpreter]] < [list [eval $cmd]]" r]} - catch {fconfigure $f -blocking 0} + catch {chan configure $f -blocking 0} } -body { variable wait - fileevent $f readable \ + chan event $f readable \ [list set [namespace which -variable wait] "child exit"] set id [after 2000 [list set [namespace which -variable wait] timeout]] vwait [namespace which -variable wait] after cancel $id set wait } -cleanup { - if {[string equal timeout $wait] && [testConstraint unix]} { + if {$wait eq "timeout" && [testConstraint unix]} { exec kill [pid $f] } close $f @@ -748,7 +748,7 @@ namespace eval ::tcl::test::main { exec Tcltest } -setup { catch {set f [open "|[list [interpreter]]" w+]} - catch {fconfigure $f -blocking 0} + catch {chan configure $f -blocking 0} } -body { type $f "testsetmainloop after 2000 testexitmainloop @@ -983,7 +983,7 @@ namespace eval ::tcl::test::main { } -body { exec [interpreter] << { testsetmainloop - fconfigure stdin -blocking 0 + chan configure stdin -blocking 0 testexitmainloop } >& result set f [open result] diff --git a/tests/misc.test b/tests/misc.test index 6ddc718..d4ece74 100644 --- a/tests/misc.test +++ b/tests/misc.test @@ -59,12 +59,7 @@ test misc-1.2 {error in variable ref. in command in array reference} { missing close-brace for variable name missing close-brace for variable name while executing -"set tst $a([winfo name $\{zz) - # this is a bogus comment - # this is a bogus comment - # this is a bogus comment - # this is a bogus comment - # this is a ..." +"set tst $a([winfo name $\{" (procedure "tstProc" line 4) invoked from within "tstProc"}] diff --git a/tests/msgcat.test b/tests/msgcat.test index 1522354..050b592 100644 --- a/tests/msgcat.test +++ b/tests/msgcat.test @@ -12,13 +12,13 @@ # Note that after running these tests, entries will be left behind in the # message catalogs for locales foo, foo_BAR, and foo_BAR_baz. -package require Tcl 8.2 +package require Tcl 8.5 if {[catch {package require tcltest 2}]} { puts stderr "Skipping tests in [info script]. tcltest 2 required." return } -if {[catch {package require msgcat 1.5.0}]} { - puts stderr "Skipping tests in [info script]. No msgcat 1.5.0 found to test." +if {[catch {package require msgcat 1.5}]} { + puts stderr "Skipping tests in [info script]. No msgcat 1.5 found to test." return } @@ -56,7 +56,7 @@ namespace eval ::msgcat::test { set result [string tolower \ [msgcat::ConvertLocale $::tcl::mac::locale]] } else { - if {([info sharedlibextension] == ".dll") + if {([info sharedlibextension] eq ".dll") && ![catch {package require registry}]} { # Windows and Cygwin have other ways to determine the # locale when the environment variables are missing @@ -72,7 +72,7 @@ namespace eval ::msgcat::test { variable var foreach var $envVars { catch {variable $var $::env($var)} - catch {unset ::env($var)} + unset -nocomplain ::env($var) } foreach var $setVars { set ::env($var) $var @@ -84,13 +84,13 @@ namespace eval ::msgcat::test { } -cleanup { interp delete [namespace current]::i foreach var $envVars { - catch {unset ::env($var)} + unset -nocomplain ::env($var) catch {set ::env($var) [set [namespace current]::$var]} } } -body {i eval msgcat::mclocale} -result $result incr count } - catch {unset result} + unset -nocomplain result # Could add tests of initialization from Windows registry here. # Use a fake registry package. @@ -324,7 +324,7 @@ namespace eval ::msgcat::test { incr count } } - catch {unset result} + unset -nocomplain result # Tests msgcat-4.*: [mcunknown] diff --git a/tests/namespace.test b/tests/namespace.test index 1d46bf0..f6688f1 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -1111,6 +1111,14 @@ test namespace-26.7 {NamespaceExportCmd, -clear resets export list} { } list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd4 hello] } [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}] +test namespace-26.8 {NamespaceExportCmd, -clear resets export list} { + catch {namespace delete foo} + namespace eval foo { + namespace export x + namespace export -clear + } + list [namespace eval foo namespace export] [namespace delete foo] +} {{} {}} test namespace-27.1 {NamespaceForgetCmd, no args} { catch {namespace delete {*}[namespace children :: test_ns_*]} diff --git a/tests/oo.test b/tests/oo.test index 5d34077..d63e931 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -2,12 +2,12 @@ # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # -# Copyright (c) 2006-2012 Donal K. Fellows +# Copyright (c) 2006-2013 Donal K. Fellows # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require TclOO 1.0 +package require TclOO 1.0.1 package require tcltest 2 if {"::tcltest" in [namespace children]} { namespace import -force ::tcltest::* @@ -101,7 +101,7 @@ test oo-0.8 {leak in variable management} -setup { test oo-0.9 {various types of presence of the TclOO package} { list [lsearch -nocase -all -inline [package names] tcloo] \ [package present TclOO] [package versions TclOO] -} [list TclOO $::oo::version $::oo::version] +} [list TclOO $::oo::patchlevel $::oo::patchlevel] test oo-1.1 {basic test of OO functionality: no classes} { set result {} @@ -936,6 +936,69 @@ test oo-6.18 {Bug 3408830: more forwarding cases} -setup { } -returnCodes error -cleanup { fooClass destroy } -result {wrong # args: should be "::foo len string"} +test oo-6.19 {Bug 3610404: forwarding resolution + traces} -setup { + oo::object create foo + unset -nocomplain ::result + set ::result {} +} -body { + proc ::my {method} {lappend ::result global} + oo::objdefine foo { + method target {} {lappend ::result instance} + forward bar my target + method bump {} { + set ns [info object namespace ::foo] + rename ${ns}::my ${ns}:: + rename ${ns}:: ${ns}::my + } + } + proc harness {} { + foo target + foo bar + foo target + } + trace add execution harness enterstep {apply {{cmd args} {foo bump}}} + foo target + foo bar + foo bump + foo bar + harness +} -cleanup { + catch {rename harness {}} + catch {rename ::my {}} + foo destroy +} -result {instance instance instance instance instance instance} +test oo-6.20 {Bug 3610404: forwarding resolution + traces} -setup { + oo::class create fooClass + fooClass create foo + unset -nocomplain ::result + set ::result {} +} -body { + proc ::my {method} {lappend ::result global} + oo::define fooClass { + method target {} {lappend ::result class} + forward bar my target + method bump {} { + set ns [info object namespace [self]] + rename ${ns}::my ${ns}:: + rename ${ns}:: ${ns}::my + } + } + proc harness {} { + foo target + foo bar + foo target + } + trace add execution harness enterstep {apply {{cmd args} {foo bump}}} + foo target + foo bar + foo bump + foo bar + harness +} -cleanup { + catch {rename harness {}} + catch {rename ::my {}} + fooClass destroy +} -result {class class class class class class} test oo-7.1 {OO: inheritance 101} -setup { oo::class create superClass @@ -1776,6 +1839,36 @@ test oo-15.9 {ensemble rewriting must not bleed through oo::copy} -setup { } -returnCodes error -cleanup { Foo destroy } -result {wrong # args: should be "::bar <cloned> a b"} +test oo-15.10 {variable binding must not bleed through oo::copy} -setup { + oo::class create FooClass + set result {} +} -body { + set obj1 [FooClass new] + oo::objdefine $obj1 { + variable var + method m {} { + set var foo + } + method get {} { + return $var + } + export eval + } + + $obj1 m + lappend result [$obj1 get] + set obj2 [oo::copy $obj1] + $obj2 eval { + set var bar + } + lappend result [$obj2 get] + $obj1 eval { + set var grill + } + lappend result [$obj1 get] [$obj2 get] +} -cleanup { + FooClass destroy +} -result {foo bar grill bar} test oo-16.1 {OO: object introspection} -body { info object @@ -2204,6 +2297,25 @@ test oo-19.2 {OO: varname method: Bug 2883857} -setup { } -cleanup { SpecialClass destroy } -result ::oo_test::x(y) +test oo-19.3 {OO: varname method and variable decl: Bug 3603695} -setup { + oo::class create testClass { + variable foo + export varname + constructor {} { + variable foo x + } + method bar {obj} { + my varname foo + $obj varname foo + } + } +} -body { + testClass create A + testClass create B + lsearch [list [A varname foo] [B varname foo]] [B bar A] +} -cleanup { + testClass destroy +} -result 0 test oo-20.1 {OO: variable method} -body { oo::class create testClass { @@ -3355,6 +3467,42 @@ test oo-34.8 {TIP 380: slots - presence} { test oo-34.9 {TIP 380: slots - presence} { getMethods oo::objdefine::variable } {{-append -clear -set} {Get Set}} + +test oo-35.1 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup { + oo::class create fruit { + method eat {} {} + } + set result {} +} -body { + lappend result [fruit create ::apple] [info class superclasses fruit] + oo::define fruit superclass + lappend result [info class superclasses fruit] \ + [info object class apple oo::object] \ + [info class call fruit destroy] \ + [catch { apple }] +} -cleanup { + unset -nocomplain result + fruit destroy +} -result {::apple ::oo::object ::oo::object 1 {{method destroy ::oo::object {core method: "destroy"}}} 1} +test oo-35.2 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup { + oo::class create fruitMetaclass { + superclass oo::class + method eat {} {} + } + set result {} +} -body { + lappend result [fruitMetaclass create ::appleClass] \ + [appleClass create orange] \ + [info class superclasses fruitMetaclass] + oo::define fruitMetaclass superclass + lappend result [info class superclasses fruitMetaclass] \ + [info object class appleClass oo::class] \ + [catch { orange }] [info object class orange] \ + [appleClass create pear] +} -cleanup { + unset -nocomplain result + fruitMetaclass destroy +} -result {::appleClass ::orange ::oo::class ::oo::class 1 1 ::appleClass ::pear} cleanupTests return diff --git a/tests/ooNext2.test b/tests/ooNext2.test index d77e8d1..a47aa91 100644 --- a/tests/ooNext2.test +++ b/tests/ooNext2.test @@ -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. -package require TclOO 1.0 +package require TclOO 1.0.1 package require tcltest 2 if {"::tcltest" in [namespace children]} { namespace import -force ::tcltest::* diff --git a/tests/parse.test b/tests/parse.test index 0f76d64..01443c9 100644 --- a/tests/parse.test +++ b/tests/parse.test @@ -26,6 +26,8 @@ testConstraint testparsevarname [llength [info commands testparsevarname]] testConstraint testparsevar [llength [info commands testparsevar]] testConstraint testasync [llength [info commands testasync]] testConstraint testcmdtrace [llength [info commands testcmdtrace]] +testConstraint testevent [llength [info commands testevent]] +testConstraint memory [llength [info commands memory]] test parse-1.1 {Tcl_ParseCommand procedure, computing string length} testparser { testparser [bytestring "foo\0 bar"] -1 @@ -438,7 +440,7 @@ test parse-8.12 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} { test parse-9.1 {Tcl_LogCommandInfo, line numbers} testevalex { - catch {unset x} + unset -nocomplain x list [catch {testevalex {for {} 1 {} { @@ -479,7 +481,7 @@ test parse-10.3 {Tcl_EvalTokens, nested commands} testevalex { testevalex {concat [expr 2 + 6]} } {8} test parse-10.4 {Tcl_EvalTokens, nested commands} testevalex { - catch {unset a} + unset -nocomplain a list [catch {testevalex {concat xxx[expr $a]}} msg] $msg } {1 {can't read "a": no such variable}} test parse-10.5 {Tcl_EvalTokens, simple variables} testevalex { @@ -487,21 +489,21 @@ test parse-10.5 {Tcl_EvalTokens, simple variables} testevalex { testevalex {concat $a} } {hello} test parse-10.6 {Tcl_EvalTokens, array variables} testevalex { - catch {unset a} + unset -nocomplain a set a(12) 46 testevalex {concat $a(12)} } {46} test parse-10.7 {Tcl_EvalTokens, array variables} testevalex { - catch {unset a} + unset -nocomplain a set a(12) 46 testevalex {concat $a(1[expr 3 - 1])} } {46} test parse-10.8 {Tcl_EvalTokens, array variables} testevalex { - catch {unset a} + unset -nocomplain a list [catch {testevalex {concat $x($a)}} msg] $msg } {1 {can't read "a": no such variable}} test parse-10.9 {Tcl_EvalTokens, array variables} testevalex { - catch {unset a} + unset -nocomplain a list [catch {testevalex {concat xyz$a(1)}} msg] $msg } {1 {can't read "a(1)": no such variable}} test parse-10.10 {Tcl_EvalTokens, object values} testevalex { @@ -541,11 +543,11 @@ test parse-11.2 {Tcl_EvalEx, error while parsing} testevalex { list [catch {testevalex {concat "abc}} msg] $msg } {1 {missing "}} test parse-11.3 {Tcl_EvalEx, error while collecting words} testevalex { - catch {unset a} + unset -nocomplain a list [catch {testevalex {concat xyz $a}} msg] $msg } {1 {can't read "a": no such variable}} test parse-11.4 {Tcl_EvalEx, error in Tcl_EvalObjv call} testevalex { - catch {unset a} + unset -nocomplain a list [catch {testevalex {_bogus_ a b c d}} msg] $msg } {1 {invalid command name "_bogus_"}} test parse-11.5 {Tcl_EvalEx, exceptional return} testevalex { @@ -564,7 +566,7 @@ test parse-11.8 {Tcl_EvalEx, multiple commands in script} testevalex { }] $a $c } {d b d} test parse-11.9 {Tcl_EvalEx, freeing memory after error} testevalex { - catch {unset a} + unset -nocomplain a list [catch {testevalex {concat a b c d e f g h i j k l m n o p q r s t u v w x y z $a}} msg] $msg } {1 {can't read "a": no such variable}} test parse-11.10 {Tcl_EvalTokens, empty commands} testevalex { @@ -670,13 +672,33 @@ test parse-13.3 {Tcl_ParseVar procedure, no variable name} testparsevar { testparsevar {$.123} } {{$} .123} test parse-13.4 {Tcl_ParseVar procedure, error looking up variable} testparsevar { - catch {unset abc} + unset -nocomplain abc list [catch {testparsevar {$abc}} msg] $msg } {1 {can't read "abc": no such variable}} test parse-13.5 {Tcl_ParseVar procedure, error looking up variable} testparsevar { - catch {unset abc} + unset -nocomplain abc list [catch {testparsevar {$abc([bogus x y z])}} msg] $msg } {1 {invalid command name "bogus"}} +test parse-13.6 {Tcl_ParseVar memory leak} -constraints memory -setup { + proc getbytes {} { + return [lindex [split [memory info] \n] 3 3] + } +} -body { + set a() foo + set end [getbytes] + for {set i 0} {$i < 5} {incr i} { + set vn {} + set res [testparsevar [append vn $ a([string repeat {[]} 19]) bar]] + if {$res ne {foo bar}} {error "Unexpected result: $res"} + + set tmp $end + set end [getbytes] + } + expr {$end - $tmp} +} -cleanup { + unset -nocomplain a end i vn res tmp + rename getbytes {} +} -result 0 test parse-14.1 {Tcl_ParseBraces procedure, computing string length} testparser { testparser [bytestring "foo\0 bar"] -1 @@ -1090,6 +1112,19 @@ test parse-20.12 {TclParseBackslash: truncated escape} testparser { testparser {\x12X} 5 } {- {\x12X} 1 word {\x12X} 2 backslash {\x12} 0 text X 0 {}} +test parse-21.0 {Bug 1884496} testevent { + set ::script {testevent delete a; set a [p]; set ::done $a} + proc ::p {} {string first s $::script} + testevent queue a head $::script + vwait done +} {} +test parse-21.1 {TCL_EVAL_DIRECT coverage} testevent { + testevent queue a head {testevent delete a; \ + set ::done [dict get [info frame 0] line]} + vwait done + set ::done +} 2 + cleanupTests } diff --git a/tests/parseExpr.test b/tests/parseExpr.test index 7910974..714c45b 100644 --- a/tests/parseExpr.test +++ b/tests/parseExpr.test @@ -8,10 +8,8 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest 2 - namespace import -force ::tcltest::* -} +package require tcltest 2 +namespace import ::tcltest::* ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] @@ -1067,5 +1065,5 @@ test parseExpr-22.18 {Bug 3401704} -constraints testexprparser -body { # cleanup -::tcltest::cleanupTests +cleanupTests return diff --git a/tests/parseOld.test b/tests/parseOld.test index 0edcbf0..f3b1591 100644 --- a/tests/parseOld.test +++ b/tests/parseOld.test @@ -13,10 +13,8 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest - namespace import -force ::tcltest::* -} +package require tcltest +namespace import ::tcltest::* ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] @@ -166,25 +164,25 @@ test parseOld-5.6 {variable substitution} { set msg } {can't read "_non_existent_": no such variable} test parseOld-5.7 {array variable substitution} { - catch {unset a} + unset -nocomplain a set a(xyz) 123 set b $a(xyz)foo set b } 123foo test parseOld-5.8 {array variable substitution} { - catch {unset a} + unset -nocomplain a set "a(x y z)" 123 set b $a(x y z)foo set b } 123foo test parseOld-5.9 {array variable substitution} { - catch {unset a}; catch {unset qqq} + unset -nocomplain a qqq set "a(x y z)" qqq set $a([format x]\ y [format z]) foo set qqq } foo test parseOld-5.10 {array variable substitution} { - catch {unset a} + unset -nocomplain a list [catch {set b $a(22)} msg] $msg } {1 {can't read "a(22)": no such variable}} test parseOld-5.11 {array variable substitution} { @@ -194,9 +192,9 @@ test parseOld-5.11 {array variable substitution} { test parseOld-5.12 {empty array name support} { list [catch {set b a$()} msg] $msg } {1 {can't read "()": no such variable}} -catch {unset a} +unset -nocomplain a test parseOld-5.13 {array variable substitution} { - catch {unset a} + unset -nocomplain a set long {This is a very long variable, long enough to cause storage \ allocation to occur in Tcl_ParseVar. If that storage isn't getting \ freed up correctly, then a core leak will occur when this test is \ @@ -211,13 +209,13 @@ test parseOld-5.13 {array variable substitution} { run. This text is probably beginning to sound like drivel, but I've \ run out of things to say and I need more characters still.}}} test parseOld-5.14 {array variable substitution} { - catch {unset a}; catch {unset b}; catch {unset a1} + unset -nocomplain a b a1 set a1(22) foo set a(foo) bar set b $a($a1(22)) set b } bar -catch {unset a}; catch {unset a1} +unset -nocomplain a a1 test parseOld-7.1 {backslash substitution} { set a "\a\c\n\]\}" diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test index 0fe394e..84c82ce 100644 --- a/tests/pkgMkIndex.test +++ b/tests/pkgMkIndex.test @@ -8,10 +8,8 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest 2 - namespace import -force ::tcltest::* -} +package require tcltest 2 +namespace import ::tcltest::* set fullPkgPath [makeDirectory pkg] @@ -45,7 +43,7 @@ proc pkgtest::parseArgs { args } { set a [lindex $args $iarg] if {[regexp {^-} $a]} { lappend options $a - if {[string compare -load $a] == 0} { + if {$a eq "-load"} { incr iarg lappend options [lindex $args $iarg] } @@ -81,7 +79,7 @@ proc pkgtest::parseIndex { filePath } { $slave eval { rename package package_original proc package { args } { - if {[string compare [lindex $args 0] ifneeded] == 0} { + if {[lindex $args 0] eq "ifneeded"} { set pkg [lindex $args 1] set ver [lindex $args 2] set ::PKGS($pkg:$ver) [lindex $args 3] @@ -111,9 +109,9 @@ proc pkgtest::parseIndex { filePath } { foreach k [lsort [array names P]] { lappend PKGS $k $P($k) } - } err]} { - set ei $::errorInfo - set ec $::errorCode + } err opts]} { + set ei [dict get $opts -errorinfo] + set ec [dict get $opts -errorcode] catch {interp delete $slave} diff --git a/tests/platform.test b/tests/platform.test index aab7c78..6596975 100644 --- a/tests/platform.test +++ b/tests/platform.test @@ -9,10 +9,14 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest - namespace import -force ::tcltest::* -} +package require tcltest 2 + +namespace eval ::tcl::test::platform { + namespace import ::tcltest::testConstraint + namespace import ::tcltest::test + namespace import ::tcltest::cleanupTests + + variable ::tcl_platform ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] @@ -54,7 +58,10 @@ test platform-3.1 {CPU ID on Windows/UNIX} \ -result {^(?:AuthenticAMD|CentaurHauls|CyrixInstead|GenuineIntel)$} # cleanup -::tcltest::cleanupTests +cleanupTests + +} +namespace delete ::tcl::test::platform return # Local Variables: diff --git a/tests/reg.test b/tests/reg.test index a0ea850..e6ce42c 100644 --- a/tests/reg.test +++ b/tests/reg.test @@ -1080,6 +1080,84 @@ test reg-33.13 {Bug 1810264 - infinite loop} { test reg-33.14 {Bug 1810264 - super-expensive expression} nonPortable { regexp {(x{200}){200}$y} {x} } 0 +test reg-33.15 {Bug 3603557 - an "in the wild" RE} { + lindex [regexp -expanded -about { + ^TETRA_MODE_CMD # Message Type + ([[:blank:]]+) # Pad + (ETS_1_1|ETS_1_2|ETS_2_2) # SystemCode + ([[:blank:]]+) # Pad + (CONTINUOUS|CARRIER|MCCH|TRAFFIC) # SharingMode + ([[:blank:]]+) # Pad + ([[:digit:]]{1,2}) # ColourCode + ([[:blank:]]+) # Pad + (1|2|3|4|6|9|12|18) # TSReservedFrames + ([[:blank:]]+) # Pad + (PASS|TRUE|FAIL|FALSE) # UPlaneDTX + ([[:blank:]]+) # Pad + (PASS|TRUE|FAIL|FALSE) # Frame18Extension + ([[:blank:]]+) # Pad + ([[:digit:]]{1,4}) # MCC + ([[:blank:]]+) # Pad + ([[:digit:]]{1,5}) # MNC + ([[:blank:]]+) # Pad + (BOTH|BCAST|ENQRY|NONE) # NbrCellBcast + ([[:blank:]]+) # Pad + (UNKNOWN|LOW|MEDIUM|HIGH) # CellServiceLevel + ([[:blank:]]+) # Pad + (PASS|TRUE|FAIL|FALSE) # LateEntryInfo + ([[:blank:]]+) # Pad + (300|400) # FrequencyBand + ([[:blank:]]+) # Pad + (NORMAL|REVERSE) # ReverseOperation + ([[:blank:]]+) # Pad + (NONE|\+6\.25|\-6\.25|\+12\.5) # Offset + ([[:blank:]]+) # Pad + (10) # DuplexSpacing + ([[:blank:]]+) # Pad + ([[:digit:]]{1,4}) # MainCarrierNr + ([[:blank:]]+) # Pad + (0|1|2|3) # NrCSCCH + ([[:blank:]]+) # Pad + (15|20|25|30|35|40|45) # MSTxPwrMax + ([[:blank:]]+) # Pad + (\-125|\-120|\-115|\-110|\-105|\-100|\-95|\-90|\-85|\-80|\-75|\-70|\-65|\-60|\-55|\-50) + # RxLevAccessMin + ([[:blank:]]+) # Pad + (\-53|\-51|\-49|\-47|\-45|\-43|\-41|\-39|\-37|\-35|\-33|\-31|\-29|\-27|\-25|\-23) + # AccessParameter + ([[:blank:]]+) # Pad + (DISABLE|[[:digit:]]{3,4}) # RadioDLTimeout + ([[:blank:]]+) # Pad + (\-[[:digit:]]{2,3}) # RSSIThreshold + ([[:blank:]]+) # Pad + ([[:digit:]]{1,5}) # CCKIdSCKVerNr + ([[:blank:]]+) # Pad + ([[:digit:]]{1,5}) # LocationArea + ([[:blank:]]+) # Pad + ([(1|0)]{16}) # SubscriberClass + ([[:blank:]]+) # Pad + ([(1|0)]{12}) # BSServiceDetails + ([[:blank:]]+) # Pad + (RANDOMIZE|IMMEDIATE|[[:digit:]]{1,2}) # IMM + ([[:blank:]]+) # Pad + ([[:digit:]]{1,2}) # WT + ([[:blank:]]+) # Pad + ([[:digit:]]{1,2}) # Nu + ([[:blank:]]+) # Pad + ([0-1]) # FrameLngFctr + ([[:blank:]]+) # Pad + ([[:digit:]]{1,2}) # TSPtr + ([[:blank:]]+) # Pad + ([0-7]) # MinPriority + ([[:blank:]]+) # Pad + (PASS|TRUE|FAIL|FALSE) # ExtdSrvcsEnabled + ([[:blank:]]+) # Pad + (.*) # ConditionalFields + }] 0 +} 68 +test reg-33.16 {Bug [8d2c0da36d]- another "in the wild" RE} { + lindex [regexp -about "^MRK:client1: =1339 14HKelly Talisman 10011000 (\[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]*) \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 8 0 8 0 0 0 77 77 1 1 2 0 11 { 1 3 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 13HC6 My Creator 2 3 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 31HC7 Slightly offensive name, huh 3 8 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 23HE-mail:kelly@hotbox.com 4 9 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 17Hcompface must die 5 10 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 3HAir 6 12 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 14HPGP public key 7 13 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 16Hkelly@hotbox.com 8 30 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 12H2 text/plain 9 30 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 13H2 x-kom/basic 10 33 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 1H0 11 14 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 1H3 }\r?"] 0 +} 1 # cleanup ::tcltest::cleanupTests diff --git a/tests/regexp.test b/tests/regexp.test index 7cafd1b..1b2bec9 100644 --- a/tests/regexp.test +++ b/tests/regexp.test @@ -819,6 +819,67 @@ test regexp-22.1 {Bug 1810038} { test regexp-22.2 {regexp compile and backrefs, Bug 1857126} { regexp -- {([bc])\1} bb } 1 +test regexp-22.3 {Bug 3604074} { + # This will hang in interps where the bug is not fixed + regexp ((((((((a)*)*)*)*)*)*)*)* a +} 1 +test regexp-22.4 {Bug 3606139} -setup { + interp alias {} a {} string repeat a +} -body { + # This crashes in interps where the bug is not fixed + regexp [join [list [a 160]([a 55])[a 668]([a 55])[a 669]([a 55]) \ + [a 668]([a 55])[a 649]([a 55])[a 668]([a 55])[a 668]([a 55]) \ + [a 672]([a 55])[a 669]([a 55])[a 671]([a 55])[a 671]([a 55]) \ + [a 672]([a 55])[a 652]([a 55])[a 672]([a 55])[a 671]([a 55]) \ + [a 671]([a 55])[a 671]([a 55])[a 653]([a 55])[a 672]([a 55]) \ + [a 653]([a 55])[a 672]([a 55])[a 672]([a 55])[a 652]([a 55]) \ + [a 671]([a 55])[a 652]([a 55])[a 652]([a 55])[a 672]([a 55]) \ + [a 672]([a 55])[a 672]([a 55])[a 653]([a 55])[a 671]([a 55]) \ + [a 669]([a 55])[a 649]([a 55])[a 668]([a 55])[a 668]([a 55]) \ + [a 668]([a 55])[a 650]([a 55])[a 650]([a 55])[a 672]([a 55]) \ + [a 669]([a 55])[a 669]([a 55])[a 668]([a 55])[a 668]([a 55]) \ + [a 668]([a 55])[a 669]([a 55])[a 672]([a 55])[a 669]([a 55]) \ + [a 669]([a 55])[a 669]([a 55])[a 669]([a 55])[a 672]([a 55]) \ + [a 670]([a 55])[a 671]([a 55])[a 672]([a 55])[a 672]([a 55]) \ + [a 671]([a 55])[a 671]([a 55])[a 672]([a 55])[a 669]([a 55]) \ + [a 668]([a 55])[a 668]([a 55])[a 669]([a 55])[a 668]([a 55]) \ + [a 669]([a 55])[a 668]([a 55])[a 669]([a 55])[a 669]([a 55]) \ + [a 668]([a 55])[a 668]([a 55])[a 669]([a 55])[a 668]([a 55]) \ + [a 669]([a 55])[a 669]([a 55])[a 669]([a 55])[a 669]([a 55]) \ + [a 668]([a 55])[a 669]([a 55])[a 672]([a 55])[a 669]([a 55]) \ + [a 669]([a 55])[a 669]([a 55])[a 669]([a 55])[a 668]([a 55]) \ + [a 669]([a 55])[a 669]([a 55])[a 668]([a 55])[a 668]([a 55]) \ + [a 668]([a 55])[a 669]([a 55])[a 668]([a 55])[a 669]([a 55]) \ + [a 672]([a 55])[a 669]([a 55])[a 669]([a 55])[a 710]([a 55]) \ + [a 668]([a 55])[a 669]([a 55])[a 668]([a 55])[a 669]([a 55]) \ + [a 668]([a 55])[a 669]([a 55])[a 668]([a 55])[a 668]([a 55]) \ + [a 668]([a 55])[a 668]([a 55])[a 668]([a 55])[a 669]([a 55]) \ + [a 672]([a 55])[a 669]([a 55])[a 669]([a 55])[a 668]([a 55]) \ + [a 669]([a 55])[a 669]([a 55])[a 668]([a 55])[a 668]([a 55]) \ + [a 668]([a 55])[a 668]([a 55])[a 668]([a 55])[a 668]([a 55]) \ + [a 667]([a 55])[a 668]([a 55])[a 669]([a 55])[a 668]([a 55]) \ + [a 671]([a 55])[a 669]([a 55])[a 668]([a 55])[a 669]([a 55]) \ + [a 669]([a 55])[a 669]([a 55])[a 668]([a 55])[a 669]([a 55]) \ + [a 668]([a 55])[a 710]([a 55])[a 668]([a 55])[a 668]([a 55]) \ + [a 668]([a 55])[a 668]([a 55])[a 668]([a 55])[a 511]] {}] a +} -cleanup { + rename a {} +} -returnCodes 1 -result {couldn't compile regular expression pattern: nfa has too many states} +test regexp-22.5 {Bug 3610026} -setup { + set e {} + set cp 99 + while {$cp < 32864} { + append e [format %c [incr cp]] + } +} -body { + regexp -about $e +} -cleanup { + unset -nocomplain e cp +} -returnCodes error -match glob -result {*too many colors*} +test regexp-22.6 {Bug 6585b21ca8} { + expr {[regexp {(\w).*?\1} Programmer m] ? $m : "<NONE>"} +} rogr + test regexp-23.1 {regexp -all and -line} { set string "" diff --git a/tests/rename.test b/tests/rename.test index 1fa0441..ebf5425 100644 --- a/tests/rename.test +++ b/tests/rename.test @@ -140,6 +140,13 @@ test rename-4.7 {reentrancy issues with command deletion and renaming} testdel { if {[info exists env(value)]} { unset env(value) } +test rename-4.8 {Bug a16752c252} testdel { + set x broken + testdel {} foo {set x ok} + proc foo args {} + rename foo {} + return -level 0 $x[unset x] +} ok # Save the unknown procedure which is modified by the following test. diff --git a/tests/result.test b/tests/result.test index 3391ce1..9e8a66b 100644 --- a/tests/result.test +++ b/tests/result.test @@ -10,10 +10,8 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest 2 - namespace import -force ::tcltest::* -} +package require tcltest 2 +namespace import ::tcltest::* ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] diff --git a/tests/safe.test b/tests/safe.test index 4a2792e..859f352 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -425,6 +425,19 @@ test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup { } -returnCodes error -cleanup { safe::interpDelete $i } -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure} +test safe-10.1.1 {testing statics loading} -constraints TcltestPackage -setup { + set i [safe::interpCreate] +} -body { + catch {interp eval $i {load {} Safepkg1}} m o + dict get $o -errorinfo +} -returnCodes ok -cleanup { + unset -nocomplain m o + safe::interpDelete $i +} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure + invoked from within +"load {} Safepkg1" + invoked from within +"interp eval $i {load {} Safepkg1}"} test safe-10.2 {testing statics loading / -nostatics} -constraints TcltestPackage -body { set i [safe::interpCreate -nostatics] interp eval $i {load {} Safepkg1} @@ -444,6 +457,18 @@ test safe-10.4 {testing nested statics loading / -nestedloadok} -constraints Tcl } -returnCodes error -cleanup { safe::interpDelete $i } -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure} +test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints TcltestPackage -body { + set i [safe::interpCreate -nestedloadok] + catch {interp eval $i {interp create x; load {} Safepkg1 x}} m o + dict get $o -errorinfo +} -returnCodes ok -cleanup { + unset -nocomplain m o + safe::interpDelete $i +} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure + invoked from within +"load {} Safepkg1 x" + invoked from within +"interp eval $i {interp create x; load {} Safepkg1 x}"} test safe-11.1 {testing safe encoding} -setup { set i [safe::interpCreate] @@ -501,6 +526,23 @@ test safe-11.7 {testing safe encoding} -setup { } -returnCodes error -cleanup { safe::interpDelete $i } -result {wrong # args: should be "encoding convertfrom ?encoding? data"} +test safe-11.7.1 {testing safe encoding} -setup { + set i [safe::interpCreate] +} -body { + catch {interp eval $i encoding convertfrom} m o + dict get $o -errorinfo +} -returnCodes ok -cleanup { + unset -nocomplain m o + safe::interpDelete $i +} -result {wrong # args: should be "encoding convertfrom ?encoding? data" + while executing +"encoding convertfrom" + invoked from within +"::interp invokehidden interp1 encoding convertfrom" + invoked from within +"encoding convertfrom" + invoked from within +"interp eval $i encoding convertfrom"} test safe-11.8 {testing safe encoding} -setup { set i [safe::interpCreate] } -body { @@ -508,6 +550,23 @@ test safe-11.8 {testing safe encoding} -setup { } -returnCodes error -cleanup { safe::interpDelete $i } -result {wrong # args: should be "encoding convertto ?encoding? data"} +test safe-11.8.1 {testing safe encoding} -setup { + set i [safe::interpCreate] +} -body { + catch {interp eval $i encoding convertto} m o + dict get $o -errorinfo +} -returnCodes ok -cleanup { + unset -nocomplain m o + safe::interpDelete $i +} -result {wrong # args: should be "encoding convertto ?encoding? data" + while executing +"encoding convertto" + invoked from within +"::interp invokehidden interp1 encoding convertto" + invoked from within +"encoding convertto" + invoked from within +"interp eval $i encoding convertto"} test safe-12.1 {glob is restricted [Bug 2906841]} -setup { set i [safe::interpCreate] @@ -715,8 +774,29 @@ test safe-15.1 {safe file ensemble does not surprise code} -setup { lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg lappend result [catch {interp eval $i {file isdirectory .}} msg] $msg } -cleanup { + unset -nocomplain msg interp delete $i } -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file}} +test safe-15.1.1 {safe file ensemble does not surprise code} -setup { + set i [interp create -safe] +} -body { + set result [expr {"file" in [interp hidden $i]}] + lappend result [interp eval $i {tcl::file::split a/b/c}] + lappend result [catch {interp eval $i {tcl::file::isdirectory .}}] + lappend result [interp invokehidden $i file split a/b/c] + lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg + lappend result [catch {interp invokehidden $i file isdirectory .}] + interp expose $i file + lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg + lappend result [catch {interp eval $i {file isdirectory .}} msg o] [dict get $o -errorinfo] +} -cleanup { + unset -nocomplain msg o + interp delete $i +} -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file + while executing +"file isdirectory ." + invoked from within +"interp eval $i {file isdirectory .}"}} ### ~ should have no special meaning in paths in safe interpreters test safe-16.1 {Bug 3529949: defang ~ in paths} -setup { diff --git a/tests/scan.test b/tests/scan.test index 97ad5eb..b57b641 100644 --- a/tests/scan.test +++ b/tests/scan.test @@ -1,8 +1,8 @@ # Commands covered: scan # -# This file contains a collection of tests for one or more of the Tcl -# built-in commands. Sourcing this file into Tcl runs the tests and -# generates output for errors. No output means no errors were found. +# This file contains a collection of tests for one or more of the Tcl built-in +# commands. Sourcing this file into Tcl runs the tests and generates output +# for errors. No output means no errors were found. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -11,14 +11,83 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {"::tcltest" ni [namespace children]} { package require tcltest 2 namespace import -force ::tcltest::* } +# procedure that returns the range of integers + +proc int_range {} { + for { set MIN_INT 1 } { int($MIN_INT) > 0 } {} { + set MIN_INT [expr { $MIN_INT << 1 }] + } + set MIN_INT [expr {int($MIN_INT)}] + set MAX_INT [expr { ~ $MIN_INT }] + return [list $MIN_INT $MAX_INT] +} + +# Big test for correct ordering of data in [expr] + +proc testIEEE {} { + variable ieeeValues + binary scan [binary format dd -1.0 1.0] c* c + switch -exact -- $c { + {0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} { + # little endian + binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \ + ieeeValues(-Infinity) + binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \ + ieeeValues(-Normal) + binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \ + ieeeValues(-Subnormal) + binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \ + ieeeValues(-0) + binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \ + ieeeValues(+0) + binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \ + ieeeValues(+Subnormal) + binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \ + ieeeValues(+Normal) + binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \ + ieeeValues(+Infinity) + binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \ + ieeeValues(NaN) + set ieeeValues(littleEndian) 1 + return 1 + } + {-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} { + binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \ + ieeeValues(-Infinity) + binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \ + ieeeValues(-Normal) + binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \ + ieeeValues(-Subnormal) + binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \ + ieeeValues(-0) + binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \ + ieeeValues(+0) + binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \ + ieeeValues(+Subnormal) + binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \ + ieeeValues(+Normal) + binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \ + ieeeValues(+Infinity) + binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \ + ieeeValues(NaN) + set ieeeValues(littleEndian) 0 + return 1 + } + default { + return 0 + } + } +} + +testConstraint ieeeFloatingPoint [testIEEE] testConstraint wideIs64bit \ [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}] - + test scan-1.1 {BuildCharSet, CharInSet} { list [scan foo {%[^o]} x] $x } {1 f} @@ -43,10 +112,11 @@ test scan-1.7 {BuildCharSet, CharInSet} { test scan-1.8 {BuildCharSet, CharInSet} { list [scan def-abc {%[^c-a]} x] $x } {1 def-} -test scan-1.9 {BuildCharSet, CharInSet no match} { - catch {unset x} +test scan-1.9 {BuildCharSet, CharInSet no match} -setup { + unset -nocomplain x +} -body { list [scan {= f} {= %[TF]} x] [info exists x] -} {0 0} +} -result {0 0} test scan-2.1 {ReleaseCharSet} { list [scan abcde {%[abc]} x] $x @@ -55,53 +125,53 @@ test scan-2.2 {ReleaseCharSet} { list [scan abcde {%[a-c]} x] $x } {1 abc} -test scan-3.1 {ValidateFormat} { - list [catch {scan {} {%d%1$d} x} msg] $msg -} {1 {cannot mix "%" and "%n$" conversion specifiers}} -test scan-3.2 {ValidateFormat} { - list [catch {scan {} {%d%1$d} x} msg] $msg -} {1 {cannot mix "%" and "%n$" conversion specifiers}} -test scan-3.3 {ValidateFormat} { - list [catch {scan {} {%2$d%d} x} msg] $msg -} {1 {"%n$" argument index out of range}} +test scan-3.1 {ValidateFormat} -returnCodes error -body { + scan {} {%d%1$d} x +} -result {cannot mix "%" and "%n$" conversion specifiers} +test scan-3.2 {ValidateFormat} -returnCodes error -body { + scan {} {%d%1$d} x +} -result {cannot mix "%" and "%n$" conversion specifiers} +test scan-3.3 {ValidateFormat} -returnCodes error -body { + scan {} {%2$d%d} x +} -result {"%n$" argument index out of range} test scan-3.4 {ValidateFormat} { # degenerate case, before changed from 8.2 to 8.3 list [catch {scan {} %d} msg] $msg } {0 {}} -test scan-3.5 {ValidateFormat} { - list [catch {scan {} {%10c} a} msg] $msg -} {1 {field width may not be specified in %c conversion}} -test scan-3.6 {ValidateFormat} { - list [catch {scan {} {%*1$d} a} msg] $msg -} {1 {bad scan conversion character "$"}} -test scan-3.7 {ValidateFormat} { - list [catch {scan {} {%1$d%1$d} a} msg] $msg -} {1 {variable is assigned by multiple "%n$" conversion specifiers}} -test scan-3.8 {ValidateFormat} { - list [catch {scan {} a x} msg] $msg -} {1 {variable is not assigned by any conversion specifiers}} -test scan-3.9 {ValidateFormat} { - list [catch {scan {} {%2$s} x y} msg] $msg -} {1 {variable is not assigned by any conversion specifiers}} -test scan-3.10 {ValidateFormat} { - list [catch {scan {} {%[a} x} msg] $msg -} {1 {unmatched [ in format string}} -test scan-3.11 {ValidateFormat} { - list [catch {scan {} {%[^a} x} msg] $msg -} {1 {unmatched [ in format string}} -test scan-3.12 {ValidateFormat} { - list [catch {scan {} {%[]a} x} msg] $msg -} {1 {unmatched [ in format string}} -test scan-3.13 {ValidateFormat} { - list [catch {scan {} {%[^]a} x} msg] $msg -} {1 {unmatched [ in format string}} +test scan-3.5 {ValidateFormat} -returnCodes error -body { + scan {} {%10c} a +} -result {field width may not be specified in %c conversion} +test scan-3.6 {ValidateFormat} -returnCodes error -body { + scan {} {%*1$d} a +} -result {bad scan conversion character "$"} +test scan-3.7 {ValidateFormat} -returnCodes error -body { + scan {} {%1$d%1$d} a +} -result {variable is assigned by multiple "%n$" conversion specifiers} +test scan-3.8 {ValidateFormat} -returnCodes error -body { + scan {} a x +} -result {variable is not assigned by any conversion specifiers} +test scan-3.9 {ValidateFormat} -returnCodes error -body { + scan {} {%2$s} x y +} -result {variable is not assigned by any conversion specifiers} +test scan-3.10 {ValidateFormat} -returnCodes error -body { + scan {} {%[a} x +} -result {unmatched [ in format string} +test scan-3.11 {ValidateFormat} -returnCodes error -body { + scan {} {%[^a} x +} -result {unmatched [ in format string} +test scan-3.12 {ValidateFormat} -returnCodes error -body { + scan {} {%[]a} x +} -result {unmatched [ in format string} +test scan-3.13 {ValidateFormat} -returnCodes error -body { + scan {} {%[^]a} x +} -result {unmatched [ in format string} -test scan-4.1 {Tcl_ScanObjCmd, argument checks} { - list [catch {scan} msg] $msg -} {1 {wrong # args: should be "scan string format ?varName ...?"}} -test scan-4.2 {Tcl_ScanObjCmd, argument checks} { - list [catch {scan string} msg] $msg -} {1 {wrong # args: should be "scan string format ?varName ...?"}} +test scan-4.1 {Tcl_ScanObjCmd, argument checks} -returnCodes error -body { + scan +} -result {wrong # args: should be "scan string format ?varName ...?"} +test scan-4.2 {Tcl_ScanObjCmd, argument checks} -returnCodes error -body { + scan string +} -result {wrong # args: should be "scan string format ?varName ...?"} test scan-4.3 {Tcl_ScanObjCmd, argument checks} { # degenerate case, before changed from 8.2 to 8.3 list [catch {scan string format} msg] $msg @@ -191,99 +261,126 @@ test scan-4.29 {Tcl_ScanObjCmd, character scanning} { list [scan {abcdef} {%*c%n} x] $x } {1 1} -test scan-4.30 {Tcl_ScanObjCmd, base-10 integer scanning} { +test scan-4.30 {Tcl_ScanObjCmd, base-10 integer scanning} -setup { set x {} +} -body { list [scan {1234567890a} {%3d} x] $x -} {1 123} -test scan-4.31 {Tcl_ScanObjCmd, base-10 integer scanning} { +} -result {1 123} +test scan-4.31 {Tcl_ScanObjCmd, base-10 integer scanning} -setup { set x {} +} -body { list [scan {1234567890a} {%d} x] $x -} {1 1234567890} -test scan-4.32 {Tcl_ScanObjCmd, base-10 integer scanning} { +} -result {1 1234567890} +test scan-4.32 {Tcl_ScanObjCmd, base-10 integer scanning} -setup { set x {} +} -body { list [scan {01234567890a} {%d} x] $x -} {1 1234567890} -test scan-4.33 {Tcl_ScanObjCmd, base-10 integer scanning} { +} -result {1 1234567890} +test scan-4.33 {Tcl_ScanObjCmd, base-10 integer scanning} -setup { set x {} +} -body { list [scan {+01234} {%d} x] $x -} {1 1234} -test scan-4.34 {Tcl_ScanObjCmd, base-10 integer scanning} { +} -result {1 1234} +test scan-4.34 {Tcl_ScanObjCmd, base-10 integer scanning} -setup { set x {} +} -body { list [scan {-01234} {%d} x] $x -} {1 -1234} -test scan-4.35 {Tcl_ScanObjCmd, base-10 integer scanning} { +} -result {1 -1234} +test scan-4.35 {Tcl_ScanObjCmd, base-10 integer scanning} -setup { set x {} +} -body { list [scan {a01234} {%d} x] $x -} {0 {}} -test scan-4.36 {Tcl_ScanObjCmd, base-10 integer scanning} { +} -result {0 {}} +test scan-4.36 {Tcl_ScanObjCmd, base-10 integer scanning} -setup { set x {} +} -body { list [scan {0x10} {%d} x] $x -} {1 0} -test scan-4.37 {Tcl_ScanObjCmd, base-8 integer scanning} { +} -result {1 0} +test scan-4.37 {Tcl_ScanObjCmd, base-8 integer scanning} -setup { set x {} +} -body { list [scan {012345678} {%o} x] $x -} {1 342391} -test scan-4.38 {Tcl_ScanObjCmd, base-8 integer scanning} { +} -result {1 342391} +test scan-4.38 {Tcl_ScanObjCmd, base-8 integer scanning} -setup { set x {} +} -body { list [scan {+1238 -1239 123a} {%o%*s%o%*s%o} x y z] $x $y $z -} {3 83 -83 83} -test scan-4.39 {Tcl_ScanObjCmd, base-16 integer scanning} { +} -result {3 83 -83 83} +test scan-4.39 {Tcl_ScanObjCmd, base-16 integer scanning} -setup { set x {} +} -body { list [scan {+1238 -123a 0123} {%x%x%x} x y z] $x $y $z -} {3 4664 -4666 291} -test scan-4.40 {Tcl_ScanObjCmd, base-16 integer scanning} { +} -result {3 4664 -4666 291} +test scan-4.40 {Tcl_ScanObjCmd, base-16 integer scanning} -setup { + set x {} +} -body { # The behavior changed in 8.4a4/8.3.4cvs (6 Feb) to correctly # return '1' for 0x1 scanned via %x, to comply with 8.0 and C scanf. # Bug #495213 - set x {} list [scan {aBcDeF AbCdEf 0x1} {%x%x%x} x y z] $x $y $z -} {3 11259375 11259375 1} -test scan-4.40.1 {Tcl_ScanObjCmd, base-16 integer scanning} { +} -result {3 11259375 11259375 1} +test scan-4.40.1 {Tcl_ScanObjCmd, base-16 integer scanning} -setup { set x {} +} -body { list [scan {0xF 0x00A0B 0X0XF} {%x %x %x} x y z] $x $y $z -} {3 15 2571 0} -test scan-4.40.2 {Tcl_ScanObjCmd, base-16 integer scanning} { - catch {unset x} +} -result {3 15 2571 0} +test scan-4.40.2 {Tcl_ScanObjCmd, base-16 integer scanning} -setup { + unset -nocomplain x +} -body { list [scan {xF} {%x} x] [info exists x] -} {0 0} -test scan-4.40.3 {Tcl_ScanObjCmd, base-2 integer scanning} { +} -result {0 0} +test scan-4.40.3 {Tcl_ScanObjCmd, base-2 integer scanning} -setup { set x {} +} -body { list [scan {1001 0b101 100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000} {%b %b %llb} x y z] $x $y $z -} {3 9 5 340282366920938463463374607431768211456} -test scan-4.41 {Tcl_ScanObjCmd, base-unknown integer scanning} { +} -result {3 9 5 340282366920938463463374607431768211456} +test scan-4.41 {Tcl_ScanObjCmd, base-unknown integer scanning} -setup { set x {} +} -body { list [scan {10 010 0x10 0b10} {%i%i%i%i} x y z t] $x $y $z $t -} {4 10 8 16 0} -test scan-4.42 {Tcl_ScanObjCmd, base-unknown integer scanning} { +} -result {4 10 8 16 0} +test scan-4.42 {Tcl_ScanObjCmd, base-unknown integer scanning} -setup { set x {} +} -body { list [scan {10 010 0X10} {%i%i%i} x y z] $x $y $z -} {3 10 8 16} -test scan-4.43 {Tcl_ScanObjCmd, integer scanning, odd cases} { +} -result {3 10 8 16} +test scan-4.43 {Tcl_ScanObjCmd, integer scanning, odd cases} -setup { set x {} +} -body { list [scan {+ } {%i} x] $x -} {0 {}} -test scan-4.44 {Tcl_ScanObjCmd, integer scanning, odd cases} { +} -result {0 {}} +test scan-4.44 {Tcl_ScanObjCmd, integer scanning, odd cases} -setup { set x {} +} -body { list [scan {+} {%i} x] $x -} {-1 {}} -test scan-4.45 {Tcl_ScanObjCmd, integer scanning, odd cases} { +} -result {-1 {}} +test scan-4.45 {Tcl_ScanObjCmd, integer scanning, odd cases} -setup { set x {} +} -body { list [scan {0x} {%i%s} x y] $x $y -} {2 0 x} -test scan-4.46 {Tcl_ScanObjCmd, integer scanning, odd cases} { +} -result {2 0 x} +test scan-4.46 {Tcl_ScanObjCmd, integer scanning, odd cases} -setup { set x {} +} -body { list [scan {0X} {%i%s} x y] $x $y -} {2 0 X} -test scan-4.47 {Tcl_ScanObjCmd, integer scanning, suppressed} { +} -result {2 0 X} +test scan-4.47 {Tcl_ScanObjCmd, integer scanning, suppressed} -setup { set x {} +} -body { list [scan {123def} {%*i%s} x] $x -} {1 def} +} -result {1 def} test scan-4.48 {Tcl_ScanObjCmd, float scanning} { list [scan {1 2 3} {%e %f %g} x y z] $x $y $z } {3 1.0 2.0 3.0} test scan-4.49 {Tcl_ScanObjCmd, float scanning} { list [scan {.1 0.2 3.} {%e %f %g} x y z] $x $y $z } {3 0.1 0.2 3.0} +test scan-4.49-uc-1 {Tcl_ScanObjCmd, float scanning} { + list [scan {0.5*0.75} {%E%c%G} x y z] $x $y $z +} {3 0.5 42 0.75} +test scan-4.49-uc-2 {Tcl_ScanObjCmd, float scanning} { + list [scan {5e-1*75E-2} {%E%c%G} x y z] $x $y $z +} {3 0.5 42 0.75} test scan-4.50 {Tcl_ScanObjCmd, float scanning} { list [scan {1234567890a} %f x] $x } {1 1234567890.0} @@ -299,133 +396,137 @@ test scan-4.53 {Tcl_ScanObjCmd, float scanning} { test scan-4.54 {Tcl_ScanObjCmd, float scanning} { list [scan {1.0e-1} %f x] $x } {1 0.1} -test scan-4.55 {Tcl_ScanObjCmd, odd cases} { +test scan-4.55 {Tcl_ScanObjCmd, odd cases} -setup { set x {} +} -body { list [scan {+} %f x] $x -} {-1 {}} -test scan-4.56 {Tcl_ScanObjCmd, odd cases} { +} -result {-1 {}} +test scan-4.56 {Tcl_ScanObjCmd, odd cases} -setup { set x {} +} -body { list [scan {1.0e} %f%s x y] $x $y -} {2 1.0 e} -test scan-4.57 {Tcl_ScanObjCmd, odd cases} { +} -result {2 1.0 e} +test scan-4.57 {Tcl_ScanObjCmd, odd cases} -setup { set x {} +} -body { list [scan {1.0e+} %f%s x y] $x $y -} {2 1.0 e+} -test scan-4.58 {Tcl_ScanObjCmd, odd cases} { +} -result {2 1.0 e+} +test scan-4.58 {Tcl_ScanObjCmd, odd cases} -setup { set x {} set y {} +} -body { list [scan {e1} %f%s x y] $x $y -} {0 {} {}} +} -result {0 {} {}} test scan-4.59 {Tcl_ScanObjCmd, float scanning} { list [scan {1.0e-1x} %*f%n x] $x } {1 6} -test scan-4.60 {Tcl_ScanObjCmd, set errors} { +test scan-4.60 {Tcl_ScanObjCmd, set errors} -setup { set x {} set y {} - catch {unset z}; array set z {} - set result [list [catch {scan {abc def ghi} {%s%s%s} x z y} msg] \ - $msg $x $y] - unset z - set result -} {1 {can't set "z": variable is array} abc ghi} -test scan-4.61 {Tcl_ScanObjCmd, set errors} { + unset -nocomplain z +} -body { + array set z {} + list [catch {scan {abc def ghi} {%s%s%s} x z y} msg] $msg $x $y +} -cleanup { + unset -nocomplain z +} -result {1 {can't set "z": variable is array} abc ghi} +test scan-4.61 {Tcl_ScanObjCmd, set errors} -setup { set x {} - catch {unset y}; array set y {} - catch {unset z}; array set z {} - set result [list [catch {scan {abc def ghi} {%s%s%s} x z y} msg] \ - $msg $x] - unset y - unset z - set result -} {1 {can't set "z": variable is array} abc} - -# procedure that returns the range of integers - -proc int_range {} { - for { set MIN_INT 1 } { int($MIN_INT) > 0 } {} { - set MIN_INT [expr { $MIN_INT << 1 }] - } - set MIN_INT [expr {int($MIN_INT)}] - set MAX_INT [expr { ~ $MIN_INT }] - return [list $MIN_INT $MAX_INT] -} + unset -nocomplain y + unset -nocomplain z +} -body { + array set y {} + array set z {} + list [catch {scan {abc def ghi} {%s%s%s} x z y} msg] $msg $x +} -cleanup { + unset -nocomplain y + unset -nocomplain z +} -result {1 {can't set "z": variable is array} abc} test scan-4.62 {scanning of large and negative octal integers} { - foreach { MIN_INT MAX_INT } [int_range] {} + lassign [int_range] MIN_INT MAX_INT set scanstring [format {%o %o %o} -1 $MIN_INT $MAX_INT] list [scan $scanstring {%o %o %o} a b c] \ [expr { $a == -1 }] [expr { $b == $MIN_INT }] [expr { $c == $MAX_INT }] } {3 1 1 1} test scan-4.63 {scanning of large and negative hex integers} { - foreach { MIN_INT MAX_INT } [int_range] {} + lassign [int_range] MIN_INT MAX_INT set scanstring [format {%x %x %x} -1 $MIN_INT $MAX_INT] list [scan $scanstring {%x %x %x} a b c] \ [expr { $a == -1 }] [expr { $b == $MIN_INT }] [expr { $c == $MAX_INT }] } {3 1 1 1} +test scan-4.64 {scanning of hex with %X} { + scan "123 abc f78" %X%X%X +} {291 2748 3960} -# clean up from last two tests - -catch { - rename int_range {} -} - -test scan-5.1 {integer scanning} { +test scan-5.1 {integer scanning} -setup { set a {}; set b {}; set c {}; set d {} +} -body { list [scan "-20 1476 \n33 0" "%d %d %d %d" a b c d] $a $b $c $d -} {4 -20 1476 33 0} -test scan-5.2 {integer scanning} { +} -result {4 -20 1476 33 0} +test scan-5.2 {integer scanning} -setup { set a {}; set b {}; set c {} +} -body { list [scan "-45 16 7890 +10" "%2d %*d %10d %d" a b c] $a $b $c -} {3 -4 16 7890} -test scan-5.3 {integer scanning} { +} -result {3 -4 16 7890} +test scan-5.3 {integer scanning} -setup { set a {}; set b {}; set c {}; set d {} +} -body { list [scan "-45 16 +10 987" "%ld %d %ld %d" a b c d] $a $b $c $d -} {4 -45 16 10 987} -test scan-5.4 {integer scanning} { +} -result {4 -45 16 10 987} +test scan-5.4 {integer scanning} -setup { set a {}; set b {}; set c {}; set d {} +} -body { list [scan "14 1ab 62 10" "%d %x %lo %x" a b c d] $a $b $c $d -} {4 14 427 50 16} -test scan-5.5 {integer scanning} { +} -result {4 14 427 50 16} +test scan-5.5 {integer scanning} -setup { set a {}; set b {}; set c {}; set d {} +} -body { list [scan "12345670 1234567890ab cdefg" "%o %o %x %lx" a b c d] \ $a $b $c $d -} {4 2739128 342391 561323 52719} -test scan-5.6 {integer scanning} { +} -result {4 2739128 342391 561323 52719} +test scan-5.6 {integer scanning} -setup { set a {}; set b {}; set c {}; set d {} +} -body { list [scan "ab123-24642" "%2x %3x %3o %2o" a b c d] $a $b $c $d -} {4 171 291 -20 52} -test scan-5.7 {integer scanning} { +} -result {4 171 291 -20 52} +test scan-5.7 {integer scanning} -setup { set a {}; set b {} +} -body { list [scan "1234567 234 567 " "%*3x %x %*o %4o" a b] $a $b -} {2 17767 375} -test scan-5.8 {integer scanning} { +} -result {2 17767 375} +test scan-5.8 {integer scanning} -setup { set a {}; set b {} +} -body { list [scan "a 1234" "%d %d" a b] $a $b -} {0 {} {}} -test scan-5.9 {integer scanning} { - set a {}; set b {}; set c {}; set d {}; +} -result {0 {} {}} +test scan-5.9 {integer scanning} -setup { + set a {}; set b {}; set c {}; set d {} +} -body { list [scan "12345678" "%2d %2d %2ld %2d" a b c d] $a $b $c $d -} {4 12 34 56 78} -test scan-5.10 {integer scanning} { +} -result {4 12 34 56 78} +test scan-5.10 {integer scanning} -setup { set a {}; set b {}; set c {}; set d {} +} -body { list [scan "1 2 " "%hd %d %d %d" a b c d] $a $b $c $d -} {2 1 2 {} {}} +} -result {2 1 2 {} {}} # -# The behavior for scaning intergers larger than MAX_INT is -# not defined by the ANSI spec. Some implementations wrap the -# input (-16) some return MAX_INT. +# The behavior for scaning intergers larger than MAX_INT is not defined by the +# ANSI spec. Some implementations wrap the input (-16) some return MAX_INT. # -test scan-5.11 {integer scanning} {nonPortable} { - set a {}; set b {}; +test scan-5.11 {integer scanning} -constraints {nonPortable} -setup { + set a {}; set b {} +} -body { list [scan "4294967280 4294967280" "%u %d" a b] $a \ [expr {$b == -16 || $b == 0x7fffffff}] -} {2 4294967280 1} -test scan-5.12 {integer scanning} {wideIs64bit} { +} -result {2 4294967280 1} +test scan-5.12 {integer scanning} -constraints {wideIs64bit} -setup { set a {}; set b {}; set c {} +} -body { list [scan "7810179016327718216,6c63546f6c6c6548,661432506755433062510" \ %ld,%lx,%lo a b c] $a $b $c -} {3 7810179016327718216 7810179016327718216 7810179016327718216} +} -result {3 7810179016327718216 7810179016327718216 7810179016327718216} test scan-5.13 {integer scanning and overflow} { # This test used to fail on some 64-bit systems. [Bug 1011860] scan {300000000 3000000000 30000000000} {%ld %ld %ld} @@ -435,153 +536,184 @@ test scan-5.14 {integer scanning} { scan 0xff %u } 0 -test scan-6.1 {floating-point scanning} { +test scan-6.1 {floating-point scanning} -setup { set a {}; set b {}; set c {}; set d {} +} -body { list [scan "2.1 -3.0e8 .99962 a" "%f%g%e%f" a b c d] $a $b $c $d -} {3 2.1 -300000000.0 0.99962 {}} -test scan-6.2 {floating-point scanning} { +} -result {3 2.1 -300000000.0 0.99962 {}} +test scan-6.2 {floating-point scanning} -setup { set a {}; set b {}; set c {}; set d {} +} -body { list [scan "-1.2345 +8.2 9" "%3e %3lf %f %f" a b c d] $a $b $c $d -} {4 -1.0 234.0 5.0 8.2} -test scan-6.3 {floating-point scanning} { +} -result {4 -1.0 234.0 5.0 8.2} +test scan-6.3 {floating-point scanning} -setup { set a {}; set b {}; set c {} +} -body { list [scan "1e00004 332E-4 3e+4" "%Lf %*2e %f %f" a b c] $a $c -} {3 10000.0 30000.0} +} -result {3 10000.0 30000.0} # -# Some libc implementations consider 3.e- bad input. The ANSI -# spec states that digits must follow the - sign. +# Some libc implementations consider 3.e- bad input. The ANSI spec states +# that digits must follow the - sign. # -test scan-6.4 {floating-point scanning} { +test scan-6.4 {floating-point scanning} -setup { set a {}; set b {}; set c {} +} -body { list [scan "1. 47.6 2.e2 3.e-" "%f %*f %f %f" a b c] $a $b $c -} {3 1.0 200.0 3.0} -test scan-6.5 {floating-point scanning} { +} -result {3 1.0 200.0 3.0} +test scan-6.5 {floating-point scanning} -setup { set a {}; set b {}; set c {}; set d {} +} -body { list [scan "4.6 99999.7 876.43e-1 118" "%f %f %f %e" a b c d] $a $b $c $d -} {4 4.6 99999.7 87.643 118.0} -test scan-6.6 {floating-point scanning} { +} -result {4 4.6 99999.7 87.643 118.0} +test scan-6.6 {floating-point scanning} -setup { set a {}; set b {}; set c {}; set d {} +} -body { list [scan "1.2345 697.0e-3 124 .00005" "%f %e %f %e" a b c d] $a $b $c $d -} {4 1.2345 0.697 124.0 5e-5} -test scan-6.7 {floating-point scanning} { +} -result {4 1.2345 0.697 124.0 5e-5} +test scan-6.7 {floating-point scanning} -setup { set a {}; set b {}; set c {}; set d {} +} -body { list [scan "4.6abc" "%f %f %f %f" a b c d] $a $b $c $d -} {1 4.6 {} {} {}} -test scan-6.8 {floating-point scanning} { +} -result {1 4.6 {} {} {}} +test scan-6.8 {floating-point scanning} -setup { set a {}; set b {}; set c {}; set d {} +} -body { list [scan "4.6 5.2" "%f %f %f %f" a b c d] $a $b $c $d -} {2 4.6 5.2 {} {}} +} -result {2 4.6 5.2 {} {}} -test scan-7.1 {string and character scanning} { +test scan-7.1 {string and character scanning} -setup { set a {}; set b {}; set c {}; set d {} +} -body { list [scan "abc defghijk dum " "%s %3s %20s %s" a b c d] $a $b $c $d -} {4 abc def ghijk dum} -test scan-7.2 {string and character scanning} { +} -result {4 abc def ghijk dum} +test scan-7.2 {string and character scanning} -setup { set a {}; set b {}; set c {}; set d {} +} -body { list [scan "a bcdef" "%c%c%1s %s" a b c d] $a $b $c $d -} {4 97 32 b cdef} -test scan-7.3 {string and character scanning} { +} -result {4 97 32 b cdef} +test scan-7.3 {string and character scanning} -setup { set a {}; set b {}; set c {} +} -body { list [scan "123456 test " "%*c%*s %s %s %s" a b c] $a $b $c -} {1 test {} {}} -test scan-7.4 {string and character scanning} { - set a {}; set b {}; set c {}; set d +} -result {1 test {} {}} +test scan-7.4 {string and character scanning} -setup { + set a {}; set b {}; set c {}; set d {} +} -body { list [scan "ababcd01234 f 123450" {%4[abcd] %4[abcd] %[^abcdef] %[^0]} a b c d] $a $b $c $d -} {4 abab cd {01234 } {f 12345}} -test scan-7.5 {string and character scanning} { +} -result {4 abab cd {01234 } {f 12345}} +test scan-7.5 {string and character scanning} -setup { set a {}; set b {}; set c {} +} -body { list [scan "aaaaaabc aaabcdefg + + XYZQR" {%*4[a] %s %*4[a]%s%*4[ +]%c} a b c] $a $b $c -} {3 aabc bcdefg 43} -test scan-7.6 {string and character scanning, unicode} { +} -result {3 aabc bcdefg 43} +test scan-7.6 {string and character scanning, unicode} -setup { set a {}; set b {}; set c {}; set d {} +} -body { list [scan "abc d\u00c7fghijk dum " "%s %3s %20s %s" a b c d] $a $b $c $d -} "4 abc d\u00c7f ghijk dum" -test scan-7.7 {string and character scanning, unicode} { +} -result "4 abc d\u00c7f ghijk dum" +test scan-7.7 {string and character scanning, unicode} -setup { set a {}; set b {} +} -body { list [scan "ab\u00c7cdef" "ab%c%c" a b] $a $b -} "2 199 99" -test scan-7.8 {string and character scanning, unicode} { +} -result "2 199 99" +test scan-7.8 {string and character scanning, unicode} -setup { set a {}; set b {} +} -body { list [scan "ab\ufeffdef" "%\[ab\ufeff\]" a] $a -} "1 ab\ufeff" +} -result "1 ab\ufeff" -test scan-8.1 {error conditions} { - catch {scan a} -} 1 -test scan-8.2 {error conditions} { - catch {scan a} msg - set msg -} {wrong # args: should be "scan string format ?varName ...?"} -test scan-8.3 {error conditions} { - list [catch {scan a %D x} msg] $msg -} {1 {bad scan conversion character "D"}} -test scan-8.4 {error conditions} { - list [catch {scan a %O x} msg] $msg -} {1 {bad scan conversion character "O"}} -test scan-8.5 {error conditions} { - list [catch {scan a %X x} msg] $msg -} {1 {bad scan conversion character "X"}} -test scan-8.6 {error conditions} { - list [catch {scan a %F x} msg] $msg -} {1 {bad scan conversion character "F"}} -test scan-8.7 {error conditions} { - list [catch {scan a %E x} msg] $msg -} {1 {bad scan conversion character "E"}} -test scan-8.8 {error conditions} { - list [catch {scan a "%d %d" a} msg] $msg -} {1 {different numbers of variable names and field specifiers}} -test scan-8.9 {error conditions} { - list [catch {scan a "%d %d" a b c} msg] $msg -} {1 {variable is not assigned by any conversion specifiers}} -test scan-8.10 {error conditions} { +test scan-8.1 {error conditions} -body { + scan a +} -returnCodes error -match glob -result * +test scan-8.2 {error conditions} -returnCodes error -body { + scan a +} -result {wrong # args: should be "scan string format ?varName ...?"} +test scan-8.3 {error conditions} -returnCodes error -body { + scan a %D x +} -result {bad scan conversion character "D"} +test scan-8.4 {error conditions} -returnCodes error -body { + scan a %O x +} -result {bad scan conversion character "O"} +test scan-8.5 {error conditions} -returnCodes error -body { + scan a %B x +} -result {bad scan conversion character "B"} +test scan-8.6 {error conditions} -returnCodes error -body { + scan a %F x +} -result {bad scan conversion character "F"} +test scan-8.7 {error conditions} -returnCodes error -body { + scan a %p x +} -result {bad scan conversion character "p"} +test scan-8.8 {error conditions} -returnCodes error -body { + scan a "%d %d" a +} -result {different numbers of variable names and field specifiers} +test scan-8.9 {error conditions} -returnCodes error -body { + scan a "%d %d" a b c +} -result {variable is not assigned by any conversion specifiers} +test scan-8.10 {error conditions} -setup { set a {}; set b {}; set c {}; set d {} +} -body { list [expr {[scan " a" " a %d %d %d %d" a b c d] <= 0}] $a $b $c $d -} {1 {} {} {} {}} -test scan-8.11 {error conditions} { +} -result {1 {} {} {} {}} +test scan-8.11 {error conditions} -setup { set a {}; set b {}; set c {}; set d {} +} -body { list [scan "1 2" "%d %d %d %d" a b c d] $a $b $c $d -} {2 1 2 {} {}} -test scan-8.12 {error conditions} { - catch {unset a} +} -result {2 1 2 {} {}} +test scan-8.12 {error conditions} -setup { + unset -nocomplain a +} -body { set a(0) 44 - list [catch {scan 44 %d a} msg] $msg -} {1 {can't set "a": variable is array}} -test scan-8.13 {error conditions} { - catch {unset a} + scan 44 %d a +} -returnCodes error -cleanup { + unset -nocomplain a +} -result {can't set "a": variable is array} +test scan-8.13 {error conditions} -setup { + unset -nocomplain a +} -body { set a(0) 44 - list [catch {scan 44 %c a} msg] $msg -} {1 {can't set "a": variable is array}} -test scan-8.14 {error conditions} { - catch {unset a} + scan 44 %c a +} -returnCodes error -cleanup { + unset -nocomplain a +} -result {can't set "a": variable is array} +test scan-8.14 {error conditions} -setup { + unset -nocomplain a +} -body { set a(0) 44 - list [catch {scan 44 %s a} msg] $msg -} {1 {can't set "a": variable is array}} -test scan-8.15 {error conditions} { - catch {unset a} + scan 44 %s a +} -returnCodes error -cleanup { + unset -nocomplain a +} -result {can't set "a": variable is array} +test scan-8.15 {error conditions} -setup { + unset -nocomplain a +} -body { set a(0) 44 - list [catch {scan 44 %f a} msg] $msg -} {1 {can't set "a": variable is array}} -test scan-8.16 {error conditions} { - catch {unset a} + scan 44 %f a +} -returnCodes error -cleanup { + unset -nocomplain a +} -result {can't set "a": variable is array} +test scan-8.16 {error conditions} -setup { + unset -nocomplain a +} -body { set a(0) 44 - list [catch {scan 44 %f a} msg] $msg -} {1 {can't set "a": variable is array}} -catch {unset a} -test scan-8.17 {error conditions} { - list [catch {scan 44 %2c a} msg] $msg -} {1 {field width may not be specified in %c conversion}} -test scan-8.18 {error conditions} { - list [catch {scan abc {%[} x} msg] $msg -} {1 {unmatched [ in format string}} -test scan-8.19 {error conditions} { - list [catch {scan abc {%[^a} x} msg] $msg -} {1 {unmatched [ in format string}} -test scan-8.20 {error conditions} { - list [catch {scan abc {%[^]a} x} msg] $msg -} {1 {unmatched [ in format string}} -test scan-8.21 {error conditions} { - list [catch {scan abc {%[]a} x} msg] $msg -} {1 {unmatched [ in format string}} + scan 44 %f a +} -returnCodes error -cleanup { + unset -nocomplain a +} -result {can't set "a": variable is array} +test scan-8.17 {error conditions} -returnCodes error -body { + scan 44 %2c a +} -result {field width may not be specified in %c conversion} +test scan-8.18 {error conditions} -returnCodes error -body { + scan abc {%[} x +} -result {unmatched [ in format string} +test scan-8.19 {error conditions} -returnCodes error -body { + scan abc {%[^a} x +} -result {unmatched [ in format string} +test scan-8.20 {error conditions} -returnCodes error -body { + scan abc {%[^]a} x +} -result {unmatched [ in format string} +test scan-8.21 {error conditions} -returnCodes error -body { + scan abc {%[]a} x +} -result {unmatched [ in format string} test scan-9.1 {lots of arguments} { scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200" "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d" a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 @@ -591,27 +723,32 @@ test scan-9.2 {lots of arguments} { set a20 } 200 -test scan-10.1 {miscellaneous tests} { +test scan-10.1 {miscellaneous tests} -setup { set a {} +} -body { list [scan ab16c ab%dc a] $a -} {1 16} -test scan-10.2 {miscellaneous tests} { +} -result {1 16} +test scan-10.2 {miscellaneous tests} -setup { set a {} +} -body { list [scan ax16c ab%dc a] $a -} {0 {}} -test scan-10.3 {miscellaneous tests} { +} -result {0 {}} +test scan-10.3 {miscellaneous tests} -setup { set a {} +} -body { list [catch {scan ab%c114 ab%%c%d a} msg] $msg $a -} {0 1 114} -test scan-10.4 {miscellaneous tests} { +} -result {0 1 114} +test scan-10.4 {miscellaneous tests} -setup { set a {} +} -body { list [catch {scan ab%c14 ab%%c%d a} msg] $msg $a -} {0 1 14} -test scan-10.5 {miscellaneous tests} { - catch {unset arr} +} -result {0 1 14} +test scan-10.5 {miscellaneous tests} -setup { + unset -nocomplain arr +} -body { set arr(2) {} list [catch {scan ab%c14 ab%%c%d arr(2)} msg] $msg $arr(2) -} {0 1 14} +} -result {0 1 14} test scan-10.6 {miscellaneous tests} { scan 5a {%i%[a]} } {5 a} @@ -671,9 +808,9 @@ test scan-13.1 {Tcl_ScanObjCmd, inline XPG case} { test scan-13.2 {Tcl_ScanObjCmd, inline XPG case} { scan abc {%1$c%2$c%3$c%4$c} } {97 98 99 {}} -test scan-13.3 {Tcl_ScanObjCmd, inline XPG case} { - list [catch {scan abc {%1$c%1$c}} msg] $msg -} {1 {variable is assigned by multiple "%n$" conversion specifiers}} +test scan-13.3 {Tcl_ScanObjCmd, inline XPG case} -returnCodes error -body { + scan abc {%1$c%1$c} +} -result {variable is assigned by multiple "%n$" conversion specifiers} test scan-13.4 {Tcl_ScanObjCmd, inline XPG case} { scan abc {%2$s%1$c} } {{} abc} @@ -692,77 +829,20 @@ test scan-13.8 {Tcl_ScanObjCmd, inline XPG case lots of arguments} { list [llength $msg] [lindex $msg 99] [lindex $msg 4] [lindex $msg 199] } {200 10 20 30} -# Big test for correct ordering of data in [expr] - -proc testIEEE {} { - variable ieeeValues - binary scan [binary format dd -1.0 1.0] c* c - switch -exact -- $c { - {0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} { - # little endian - binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \ - ieeeValues(-Infinity) - binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \ - ieeeValues(-Normal) - binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \ - ieeeValues(-Subnormal) - binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \ - ieeeValues(-0) - binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \ - ieeeValues(+0) - binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \ - ieeeValues(+Subnormal) - binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \ - ieeeValues(+Normal) - binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \ - ieeeValues(+Infinity) - binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \ - ieeeValues(NaN) - set ieeeValues(littleEndian) 1 - return 1 - } - {-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} { - binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \ - ieeeValues(-Infinity) - binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \ - ieeeValues(-Normal) - binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \ - ieeeValues(-Subnormal) - binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \ - ieeeValues(-0) - binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \ - ieeeValues(+0) - binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \ - ieeeValues(+Subnormal) - binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \ - ieeeValues(+Normal) - binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \ - ieeeValues(+Infinity) - binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \ - ieeeValues(NaN) - set ieeeValues(littleEndian) 0 - return 1 - } - default { - return 0 - } - } -} - -testConstraint ieeeFloatingPoint [testIEEE] - # scan infinities - not working -test scan-14.1 {infinity} { +test scan-14.1 {positive infinity} { scan Inf %g d - set d + return $d } Inf -test scan-14.2 {infinity} { +test scan-14.2 {negative infinity} { scan -Inf %g d - set d + return $d } -Inf # TODO - also need to scan NaN's + +catch {rename int_range {}} # cleanup ::tcltest::cleanupTests diff --git a/tests/set-old.test b/tests/set-old.test index 52dc0ff..4c25ec5 100644 --- a/tests/set-old.test +++ b/tests/set-old.test @@ -678,6 +678,11 @@ test set-old-8.57 {array command, array get with trivial pattern} { set a(y) 2 array get a x } {x 1} +test set-old-8.58 {array command, array set with LVT and odd length literal} { + list [catch {apply {{} { + array set a {b c d} + }}} msg] $msg +} {1 {list must have an even number of elements}} test set-old-9.1 {ids for array enumeration} { catch {unset a} diff --git a/tests/set.test b/tests/set.test index 1d88553..18119f5 100644 --- a/tests/set.test +++ b/tests/set.test @@ -524,6 +524,11 @@ test set-5.1 {error on malformed array name} testset2 { list $msg $msg1 } {{can't read "z(a)(b)": variable isn't array} {can't read "z(b)(a)": variable isn't array}} +# In a mem-debug build, this test will crash unless Bug 3602706 is fixed. +test set-5.2 {Bug 3602706} -body { + testset2 ::tcl_platform not-in-there +} -returnCodes error -result * -match glob + # cleanup catch {unset a} catch {unset b} diff --git a/tests/socket.test b/tests/socket.test index 5542c09..51219e6 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -1841,6 +1841,7 @@ test socket-14.4 {[socket -async] and both, readdable and writable fileevents} \ after cancel $after close $client close $server + unset x } -result {{} bye} test socket-14.5 {[socket -async] which fails before any connect() can be made} \ -constraints [list socket supported_any] \ @@ -1850,6 +1851,33 @@ test socket-14.5 {[socket -async] which fails before any connect() can be made} } \ -returnCodes 1 \ -result {couldn't open socket: cannot assign requested address} +test socket-14.6 {[socket -async] with no event loop and [fconfigure -error] before the socket is connected} \ + -constraints [list socket supported_inet supported_inet6] \ + -setup { + proc accept {s a p} { + puts $s bye + close $s + } + set server [socket -server accept -myaddr 127.0.0.1 0] + set port [lindex [fconfigure $server -sockname] 2] + set x "" + } \ + -body { + set client [socket -async localhost $port] + foreach _ {1 2} { + lappend x [lindex [fconfigure $client -sockname] 0] + lappend x [fconfigure $client -error] + update + } + lappend x [gets $client] + } \ + -cleanup { + close $server + close $client + unset x + } \ + -result [list ::1 "connection refused" 127.0.0.1 "" bye] + ::tcltest::cleanupTests flush stdout return diff --git a/tests/source.test b/tests/source.test index d71212d..0235bd1 100644 --- a/tests/source.test +++ b/tests/source.test @@ -187,6 +187,16 @@ test source-3.5 {return with special code etc.} -setup { invoked from within "source $sourcefile"} {a b c}} +test source-4.1 {continuation line parsing} -setup { + set sourcefile [makeFile [string map {CL \\\n} { + format %s "[dict get [info frame 0] type]:CL[dict get [info frame 0] line]CL[dict get [info frame 0] line]CL[dict get [info frame 0] line]" + }] source.file] +} -body { + source $sourcefile +} -cleanup { + removeFile source.file +} -result {source: 3 4 5} + test source-6.1 {source is binary ok} -setup { # Note [makeFile] writes in the system encoding. # [source] defaults to reading in the system encoding. diff --git a/tests/stack.test b/tests/stack.test index 873cb08..13bc524 100644 --- a/tests/stack.test +++ b/tests/stack.test @@ -9,10 +9,8 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest 2 - namespace import -force ::tcltest::* -} +package require tcltest 2 +namespace import ::tcltest::* # Note that a failure in this test may result in a crash of the executable. diff --git a/tests/string.test b/tests/string.test index f558d30..740cdc6 100644 --- a/tests/string.test +++ b/tests/string.test @@ -408,13 +408,15 @@ test string-6.35 {string is double, false} { test string-6.36 {string is double, false} { list [string is double -fail var "\n"] $var } {0 0} -test string-6.37 {string is double, false on int overflow} { +test string-6.37 {string is double, false on int overflow} -setup { + set var priorValue +} -body { # Make it the largest int recognizable, with one more digit for overflow # Since bignums arrived in Tcl 8.5, the sense of this test changed. # Now integer values that exceed native limits become bignums, and # bignums can convert to doubles without error. list [string is double -fail var [largest_int]0] $var -} {1 0} +} -result {1 priorValue} # string-6.38 removed, underflow on input is no longer an error. test string-6.39 {string is double, false} { # This test is non-portable because IRIX thinks diff --git a/tests/subst.test b/tests/subst.test index 4be4798..7466895 100644 --- a/tests/subst.test +++ b/tests/subst.test @@ -293,6 +293,10 @@ test subst-13.1 {Bug 3081065} -setup { } -cleanup { removeFile subst13.tcl } +test subst-13.2 {Test for segfault} -body { + subst {[} +} -returnCodes error -result * -match glob + # cleanup ::tcltest::cleanupTests diff --git a/tests/tcltest.test b/tests/tcltest.test index 86aca6f..ce8d617 100755 --- a/tests/tcltest.test +++ b/tests/tcltest.test @@ -80,10 +80,7 @@ proc slave {msgVar args} { # Need to capture output in msg - set code [catch {i eval {source $argv0}} foo] -if $code { -#puts "$code: $foo\n$::errorInfo" -} + set code [catch {i eval {source $argv0}}] i eval {close $tcltest::outputChannel} interp delete [namespace current]::i set f [open $of] @@ -99,8 +96,6 @@ if $code { append msg \n$err } return $code - -# return [catch {uplevel 1 [linsert $args 0 exec [interpreter]]} msg] } test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrPc} { set result [slave msg test.tcl] @@ -549,7 +544,7 @@ set notWriteableDir [file join [temporaryDirectory] notwriteable] makeDirectory notreadable makeDirectory notwriteable switch -- $::tcl_platform(platform) { - "unix" { + unix { file attributes $notReadableDir -permissions 00333 file attributes $notWriteableDir -permissions 00555 } @@ -716,8 +711,8 @@ test tcltest-8.60 {::workingDirectory} { # clean up from directory testing -switch $::tcl_platform(platform) { - "unix" { +switch -- $::tcl_platform(platform) { + unix { file attributes $notReadableDir -permissions 777 file attributes $notWriteableDir -permissions 777 } @@ -727,7 +722,7 @@ switch $::tcl_platform(platform) { } } -file delete -force $notReadableDir $notWriteableDir +file delete -force -- $notReadableDir $notWriteableDir removeFile a.tcl removeFile thisdirectoryisafile removeDirectory normaldirectory @@ -1150,7 +1145,7 @@ test tcltest-19.1 {TCLTEST_OPTIONS default} -setup { } -cleanup { interp delete slave2 interp delete slave1 - if {$oldoptions == "none"} { + if {$oldoptions eq "none"} { unset ::env(TCLTEST_OPTIONS) } else { set ::env(TCLTEST_OPTIONS) $oldoptions diff --git a/tests/thread.test b/tests/thread.test index d79f693..f32ef61 100644 --- a/tests/thread.test +++ b/tests/thread.test @@ -84,28 +84,6 @@ if {[testConstraint testthread]} { } testthread errorproc ThreadError - - set mainThread [testthread id] - - proc ThreadNullError {id info} { - # ignore - } - - proc threadReap {} { - testthread errorproc ThreadNullError - while {[llength [testthread names]] > 1} { - foreach tid [testthread names] { - if {$tid != [testthread id]} { - catch { - testthread send -async $tid {testthread exit} - } - } - } - after 1 - } - testthread errorproc ThreadError - return [llength [testthread names]] - } } # Some tests require manual draining of the event queue diff --git a/tests/tm.test b/tests/tm.test index 149a65d..1b22f8c 100644 --- a/tests/tm.test +++ b/tests/tm.test @@ -200,7 +200,7 @@ test tm-3.11 {tm: module path management, remove ignores unknown path} -setup { proc genpaths {base} { # Normalizing picks up drive letters on windows [Bug 1053568] set base [file normalize $base] - foreach {major minor} [split [info tclversion] .] break + lassign [split [package present Tcl] .] major minor set results {} set base [file join $base tcl$major] lappend results [file join $base site-tcl] diff --git a/tests/trace.test b/tests/trace.test index 0f48dcf..d830f3c 100644 --- a/tests/trace.test +++ b/tests/trace.test @@ -11,10 +11,8 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest - namespace import -force ::tcltest::* -} +package require tcltest +namespace import ::tcltest::* ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] @@ -32,15 +30,15 @@ proc getbytes {} { proc traceScalar {name1 name2 op} { global info - set info [list $name1 $name2 $op [catch {uplevel set $name1} msg] $msg] + set info [list $name1 $name2 $op [catch {uplevel 1 set $name1} msg] $msg] } proc traceScalarAppend {name1 name2 op} { global info - lappend info $name1 $name2 $op [catch {uplevel set $name1} msg] $msg + lappend info $name1 $name2 $op [catch {uplevel 1 set $name1} msg] $msg } proc traceArray {name1 name2 op} { global info - set info [list $name1 $name2 $op [catch {uplevel set [set name1]($name2)} msg] $msg] + set info [list $name1 $name2 $op [catch {uplevel 1 set [set name1]($name2)} msg] $msg] } proc traceArray2 {name1 name2 op} { global info @@ -62,7 +60,7 @@ proc traceCheck {cmd args} { set info [list [catch $cmd msg] $msg] } proc traceCrtElement {value name1 name2 op} { - uplevel set ${name1}($name2) $value + uplevel 1 set ${name1}($name2) $value } proc traceCommand {oldName newName op} { global info @@ -72,10 +70,10 @@ proc traceCommand {oldName newName op} { test trace-0.0 {memory corruption in trace (Tcl Bug 484339)} { # You may need Purify or Electric Fence to reliably # see this one fail. - catch {unset z} + unset -nocomplain z trace add variable z array {set z(foo) 1 ;#} set res "names: [array names z]" - catch {unset ::z} + unset -nocomplain ::z trace variable ::z w {unset ::z; error "memory corruption";#} list [catch {set ::z 1} msg] $msg } {1 {can't set "::z": memory corruption}} @@ -83,40 +81,40 @@ test trace-0.0 {memory corruption in trace (Tcl Bug 484339)} { # Read-tracing on variables test trace-1.1 {trace variable reads} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x read traceScalar list [catch {set x} msg] $msg $info } {1 {can't read "x": no such variable} {x {} read 1 {can't read "x": no such variable}}} test trace-1.2 {trace variable reads} { - catch {unset x} + unset -nocomplain x set x 123 set info {} trace add variable x read traceScalar list [catch {set x} msg] $msg $info } {0 123 {x {} read 0 123}} test trace-1.3 {trace variable reads} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x read traceScalar set x 123 set info } {} test trace-1.4 {trace array element reads} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x(2) read traceArray list [catch {set x(2)} msg] $msg $info } {1 {can't read "x(2)": no such element in array} {x 2 read 1 {can't read "x(2)": no such element in array}}} test trace-1.5 {trace array element reads} { - catch {unset x} + unset -nocomplain x set x(2) zzz set info {} trace add variable x(2) read traceArray list [catch {set x(2)} msg] $msg $info } {0 zzz {x 2 read 0 zzz}} test trace-1.6 {trace array element reads} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x read traceArray2 proc p {} { @@ -127,7 +125,7 @@ test trace-1.6 {trace array element reads} { list [catch {p} msg] $msg $info } {0 willi {x 2 read}} test trace-1.7 {trace array element reads, create element undefined if nonexistant} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x read q proc q {name1 name2 op} { @@ -144,20 +142,20 @@ test trace-1.7 {trace array element reads, create element undefined if nonexista list [catch {p} msg] $msg $info } {0 wolf {x Y read}} test trace-1.8 {trace reads on whole arrays} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x read traceArray list [catch {set x(2)} msg] $msg $info } {1 {can't read "x(2)": no such variable} {}} test trace-1.9 {trace reads on whole arrays} { - catch {unset x} + unset -nocomplain x set x(2) zzz set info {} trace add variable x read traceArray list [catch {set x(2)} msg] $msg $info } {0 zzz {x 2 read 0 zzz}} test trace-1.10 {trace variable reads} { - catch {unset x} + unset -nocomplain x set x 444 set info {} trace add variable x read traceScalar @@ -165,28 +163,28 @@ test trace-1.10 {trace variable reads} { set info } {} test trace-1.11 {read traces that modify the array structure} { - catch {unset x} + unset -nocomplain x set x(bar) 0 trace variable x r {set x(foo) 1 ;#} trace variable x r {unset -nocomplain x(bar) ;#} array get x } {} test trace-1.12 {read traces that modify the array structure} { - catch {unset x} + unset -nocomplain x set x(bar) 0 trace variable x r {unset -nocomplain x(bar) ;#} trace variable x r {set x(foo) 1 ;#} array get x } {} test trace-1.13 {read traces that modify the array structure} { - catch {unset x} + unset -nocomplain x set x(bar) 0 trace variable x r {set x(foo) 1 ;#} trace variable x r {unset -nocomplain x;#} list [catch {array get x} res] $res } {1 {can't read "x(bar)": no such variable}} test trace-1.14 {read traces that modify the array structure} { - catch {unset x} + unset -nocomplain x set x(bar) 0 trace variable x r {unset -nocomplain x;#} trace variable x r {set x(foo) 1 ;#} @@ -196,28 +194,28 @@ test trace-1.14 {read traces that modify the array structure} { # Basic write-tracing on variables test trace-2.1 {trace variable writes} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x write traceScalar set x 123 set info } {x {} write 0 123} test trace-2.2 {trace writes to array elements} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x(33) write traceArray set x(33) 444 set info } {x 33 write 0 444} test trace-2.3 {trace writes on whole arrays} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x write traceArray set x(abc) qq set info } {x abc write 0 qq} test trace-2.4 {trace variable writes} { - catch {unset x} + unset -nocomplain x set x 1234 set info {} trace add variable x write traceScalar @@ -225,7 +223,7 @@ test trace-2.4 {trace variable writes} { set info } {} test trace-2.5 {trace variable writes} { - catch {unset x} + unset -nocomplain x set x 1234 set info {} trace add variable x write traceScalar @@ -238,7 +236,7 @@ test trace-2.6 {trace variable writes on compiled local} { # arrays [Bug 1770591]. The corresponding function for read traces is # already indirectly tested in trace-1.7 # - catch {unset x} + unset -nocomplain x set info {} proc p {} { trace add variable x write traceArray @@ -267,7 +265,7 @@ test trace-2.7 {trace variable writes on errorInfo} -body { # trace: after appending all arguments to the list. test trace-3.1 {trace variable read-modify-writes} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x read traceScalarAppend append x 123 @@ -276,7 +274,7 @@ test trace-3.1 {trace variable read-modify-writes} { set info } {x {} read 0 123456} test trace-3.2 {trace variable read-modify-writes} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x {read write} traceScalarAppend append x 123 @@ -287,14 +285,14 @@ test trace-3.2 {trace variable read-modify-writes} { # Basic unset-tracing on variables test trace-4.1 {trace variable unsets} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x unset traceScalar - catch {unset x} + unset -nocomplain x set info } {x {} unset 1 {can't read "x": no such variable}} test trace-4.2 {variable mustn't exist during unset trace} { - catch {unset x} + unset -nocomplain x set x 1234 set info {} trace add variable x unset traceScalar @@ -302,7 +300,7 @@ test trace-4.2 {variable mustn't exist during unset trace} { set info } {x {} unset 1 {can't read "x": no such variable}} test trace-4.3 {unset traces mustn't be called during reads and writes} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x unset traceScalar set x 44 @@ -310,15 +308,15 @@ test trace-4.3 {unset traces mustn't be called during reads and writes} { set info } {} test trace-4.4 {trace unsets on array elements} { - catch {unset x} + unset -nocomplain x set x(0) 18 set info {} trace add variable x(1) unset traceArray - catch {unset x(1)} + unset -nocomplain x(1) set info } {x 1 unset 1 {can't read "x(1)": no such element in array}} test trace-4.5 {trace unsets on array elements} { - catch {unset x} + unset -nocomplain x set x(1) 18 set info {} trace add variable x(1) unset traceArray @@ -326,7 +324,7 @@ test trace-4.5 {trace unsets on array elements} { set info } {x 1 unset 1 {can't read "x(1)": no such element in array}} test trace-4.6 {trace unsets on array elements} { - catch {unset x} + unset -nocomplain x set x(1) 18 set info {} trace add variable x(1) unset traceArray @@ -334,15 +332,15 @@ test trace-4.6 {trace unsets on array elements} { set info } {x 1 unset 1 {can't read "x(1)": no such variable}} test trace-4.7 {trace unsets on whole arrays} { - catch {unset x} + unset -nocomplain x set x(1) 18 set info {} trace add variable x unset traceProc - catch {unset x(0)} + unset -nocomplain x(0) set info } {} test trace-4.8 {trace unsets on whole arrays} { - catch {unset x} + unset -nocomplain x set x(1) 18 set x(2) 144 set x(3) 14 @@ -352,7 +350,7 @@ test trace-4.8 {trace unsets on whole arrays} { set info } {x 1 unset} test trace-4.9 {trace unsets on whole arrays} { - catch {unset x} + unset -nocomplain x set x(1) 18 set x(2) 144 set x(3) 14 @@ -364,7 +362,7 @@ test trace-4.9 {trace unsets on whole arrays} { # Array tracing on variables test trace-5.1 {array traces fire on accesses via [array]} { - catch {unset x} + unset -nocomplain x set x(b) 2 trace add variable x array traceArray2 set ::info {} @@ -372,7 +370,7 @@ test trace-5.1 {array traces fire on accesses via [array]} { set ::info } {x {} array} test trace-5.2 {array traces do not fire on normal accesses} { - catch {unset x} + unset -nocomplain x set x(b) 2 trace add variable x array traceArray2 set ::info {} @@ -381,7 +379,7 @@ test trace-5.2 {array traces do not fire on normal accesses} { set ::info } {} test trace-5.3 {array traces do not outlive variable} { - catch {unset x} + unset -nocomplain x trace add variable x array traceArray2 set ::info {} set x(a) 1 @@ -390,19 +388,19 @@ test trace-5.3 {array traces do not outlive variable} { set ::info } {} test trace-5.4 {array traces properly listed in trace information} { - catch {unset x} + unset -nocomplain x trace add variable x array traceArray2 set result [trace info variable x] set result } [list [list array traceArray2]] test trace-5.5 {array traces properly listed in trace information} { - catch {unset x} + unset -nocomplain x trace variable x a traceArray2 set result [trace vinfo x] set result } [list [list a traceArray2]] test trace-5.6 {array traces don't fire on scalar variables} { - catch {unset x} + unset -nocomplain x set x foo trace add variable x array traceArray2 set ::info {} @@ -410,14 +408,14 @@ test trace-5.6 {array traces don't fire on scalar variables} { set ::info } {} test trace-5.7 {array traces fire for undefined variables} { - catch {unset x} + unset -nocomplain x trace add variable x array traceArray2 set ::info {} array set x {a 1} set ::info } {x {} array} test trace-5.8 {array traces fire for undefined variables} { - catch {unset x} + unset -nocomplain x trace add variable x array {set x(foo) 1 ;#} set res "names: [array names x]" } {names: foo} @@ -425,7 +423,7 @@ test trace-5.8 {array traces fire for undefined variables} { # Trace multiple trace types at once. test trace-6.1 {multiple ops traced at once} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x {read write unset} traceProc catch {set x} @@ -436,7 +434,7 @@ test trace-6.1 {multiple ops traced at once} { set info } {x {} read x {} write x {} read x {} write x {} unset} test trace-6.2 {multiple ops traced on array element} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x(0) {read write unset} traceProc catch {set x(0)} @@ -448,7 +446,7 @@ test trace-6.2 {multiple ops traced on array element} { set info } {x 0 read x 0 write x 0 read x 0 write x 0 unset} test trace-6.3 {multiple ops traced on whole array} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x {read write unset} traceProc catch {set x(0)} @@ -463,7 +461,7 @@ test trace-6.3 {multiple ops traced on whole array} { # Check order of invocation of traces test trace-7.1 {order of invocation of traces} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x read "traceTag 1" trace add variable x read "traceTag 2" @@ -474,7 +472,7 @@ test trace-7.1 {order of invocation of traces} { set info } {3 2 1 3 2 1} test trace-7.2 {order of invocation of traces} { - catch {unset x} + unset -nocomplain x set x(0) 44 set info {} trace add variable x(0) read "traceTag 1" @@ -484,7 +482,7 @@ test trace-7.2 {order of invocation of traces} { set info } {3 2 1} test trace-7.3 {order of invocation of traces} { - catch {unset x} + unset -nocomplain x set x(0) 44 set info {} trace add variable x(0) read "traceTag 1" @@ -500,7 +498,7 @@ test trace-7.3 {order of invocation of traces} { # Check effects of errors in trace procedures test trace-8.1 {error returns from traces} { - catch {unset x} + unset -nocomplain x set x 123 set info {} trace add variable x read "traceTag 1" @@ -508,7 +506,7 @@ test trace-8.1 {error returns from traces} { list [catch {set x} msg] $msg $info } {1 {can't read "x": trace returned error} {}} test trace-8.2 {error returns from traces} { - catch {unset x} + unset -nocomplain x set x 123 set info {} trace add variable x write "traceTag 1" @@ -516,14 +514,14 @@ test trace-8.2 {error returns from traces} { list [catch {set x 44} msg] $msg $info } {1 {can't set "x": trace returned error} {}} test trace-8.3 {error returns from traces} { - catch {unset x} + unset -nocomplain x set x 123 set info {} trace add variable x write traceError list [catch {append x 44} msg] $msg $info } {1 {can't set "x": trace returned error} {}} test trace-8.4 {error returns from traces} { - catch {unset x} + unset -nocomplain x set x 123 set info {} trace add variable x unset "traceTag 1" @@ -531,7 +529,7 @@ test trace-8.4 {error returns from traces} { list [catch {unset x} msg] $msg $info } {0 {} 1} test trace-8.5 {error returns from traces} { - catch {unset x} + unset -nocomplain x set x(0) 123 set info {} trace add variable x(0) read "traceTag 1" @@ -541,7 +539,7 @@ test trace-8.5 {error returns from traces} { list [catch {set x(0)} msg] $msg $info } {1 {can't read "x(0)": trace returned error} 3} test trace-8.6 {error returns from traces} { - catch {unset x} + unset -nocomplain x set x 123 trace add variable x unset traceError list [catch {unset x} msg] $msg @@ -550,7 +548,7 @@ test trace-8.7 {error returns from traces} { # This test just makes sure that the memory for the error message # gets deallocated correctly when the trace is invoked again or # when the trace is deleted. - catch {unset x} + unset -nocomplain x set x 123 trace add variable x read traceError catch {set x} @@ -571,7 +569,7 @@ test trace-8.8 {error returns from traces} { trace add variable ::x write [list foo $::x] error "foo" } - catch {unset ::x ::y} + unset -nocomplain ::x ::y set x junk trace add variable ::x write [list foo $x] for {set y 0} {$y<100} {incr y} { @@ -585,31 +583,31 @@ test trace-8.8 {error returns from traces} { # a new copy of the variables. test trace-9.1 {be sure variable is unset before trace is called} { - catch {unset x} + unset -nocomplain x set x 33 set info {} - trace add variable x unset {traceCheck {uplevel set x}} + trace add variable x unset {traceCheck {uplevel 1 set x}} unset x set info } {1 {can't read "x": no such variable}} test trace-9.2 {be sure variable is unset before trace is called} { - catch {unset x} + unset -nocomplain x set x 33 set info {} - trace add variable x unset {traceCheck {uplevel set x 22}} + trace add variable x unset {traceCheck {uplevel 1 set x 22}} unset x concat $info [list [catch {set x} msg] $msg] } {0 22 0 22} test trace-9.3 {be sure traces are cleared before unset trace called} { - catch {unset x} + unset -nocomplain x set x 33 set info {} - trace add variable x unset {traceCheck {uplevel trace info variable x}} + trace add variable x unset {traceCheck {uplevel 1 trace info variable x}} unset x set info } {0 {}} test trace-9.4 {set new trace during unset trace} { - catch {unset x} + unset -nocomplain x set x 33 set info {} trace add variable x unset {traceCheck {global x; trace add variable x unset traceProc}} @@ -618,23 +616,23 @@ test trace-9.4 {set new trace during unset trace} { } {0 {} {unset traceProc}} test trace-10.1 {make sure array elements are unset before traces are called} { - catch {unset x} + unset -nocomplain x set x(0) 33 set info {} - trace add variable x(0) unset {traceCheck {uplevel set x(0)}} + trace add variable x(0) unset {traceCheck {uplevel 1 set x(0)}} unset x(0) set info } {1 {can't read "x(0)": no such element in array}} test trace-10.2 {make sure array elements are unset before traces are called} { - catch {unset x} + unset -nocomplain x set x(0) 33 set info {} - trace add variable x(0) unset {traceCheck {uplevel set x(0) zzz}} + trace add variable x(0) unset {traceCheck {uplevel 1 set x(0) zzz}} unset x(0) concat $info [list [catch {set x(0)} msg] $msg] } {0 zzz 0 zzz} test trace-10.3 {array elements are unset before traces are called} { - catch {unset x} + unset -nocomplain x set x(0) 33 set info {} trace add variable x(0) unset {traceCheck {global x; trace info variable x(0)}} @@ -642,49 +640,49 @@ test trace-10.3 {array elements are unset before traces are called} { set info } {0 {}} test trace-10.4 {set new array element trace during unset trace} { - catch {unset x} + unset -nocomplain x set x(0) 33 set info {} - trace add variable x(0) unset {traceCheck {uplevel {trace add variable x(0) read {}}}} - catch {unset x(0)} + trace add variable x(0) unset {traceCheck {uplevel 1 {trace add variable x(0) read {}}}} + unset -nocomplain x(0) concat $info [trace info variable x(0)] } {0 {} {read {}}} test trace-11.1 {make sure arrays are unset before traces are called} { - catch {unset x} + unset -nocomplain x set x(0) 33 set info {} - trace add variable x unset {traceCheck {uplevel set x(0)}} + trace add variable x unset {traceCheck {uplevel 1 set x(0)}} unset x set info } {1 {can't read "x(0)": no such variable}} test trace-11.2 {make sure arrays are unset before traces are called} { - catch {unset x} + unset -nocomplain x set x(y) 33 set info {} - trace add variable x unset {traceCheck {uplevel set x(y) 22}} + trace add variable x unset {traceCheck {uplevel 1 set x(y) 22}} unset x concat $info [list [catch {set x(y)} msg] $msg] } {0 22 0 22} test trace-11.3 {make sure arrays are unset before traces are called} { - catch {unset x} + unset -nocomplain x set x(y) 33 set info {} - trace add variable x unset {traceCheck {uplevel array exists x}} + trace add variable x unset {traceCheck {uplevel 1 array exists x}} unset x set info } {0 0} test trace-11.4 {make sure arrays are unset before traces are called} { - catch {unset x} + unset -nocomplain x set x(y) 33 set info {} - set cmd {traceCheck {uplevel {trace info variable x}}} + set cmd {traceCheck {uplevel 1 {trace info variable x}}} trace add variable x unset $cmd unset x set info } {0 {}} test trace-11.5 {set new array trace during unset trace} { - catch {unset x} + unset -nocomplain x set x(y) 33 set info {} trace add variable x unset {traceCheck {global x; trace add variable x read {}}} @@ -692,7 +690,7 @@ test trace-11.5 {set new array trace during unset trace} { concat $info [trace info variable x] } {0 {} {read {}}} test trace-11.6 {create scalar during array unset trace} { - catch {unset x} + unset -nocomplain x set x(y) 33 set info {} trace add variable x unset {traceCheck {global x; set x 44}} @@ -703,52 +701,52 @@ test trace-11.6 {create scalar during array unset trace} { # Check special conditions (e.g. errors) in Tcl_TraceVar2. test trace-12.1 {creating array when setting variable traces} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x(0) write traceProc list [catch {set x 22} msg] $msg } {1 {can't set "x": variable is array}} test trace-12.2 {creating array when setting variable traces} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x(0) write traceProc list [catch {set x(0)} msg] $msg } {1 {can't read "x(0)": no such element in array}} test trace-12.3 {creating array when setting variable traces} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x(0) write traceProc set x(0) 22 set info } {x 0 write} test trace-12.4 {creating variable when setting variable traces} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x write traceProc list [catch {set x} msg] $msg } {1 {can't read "x": no such variable}} test trace-12.5 {creating variable when setting variable traces} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x write traceProc set x 22 set info } {x {} write} test trace-12.6 {creating variable when setting variable traces} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x write traceProc set x(0) 22 set info } {x 0 write} test trace-12.7 {create array element during read trace} { - catch {unset x} + unset -nocomplain x set x(2) zzz trace add variable x read {traceCrtElement xyzzy} list [catch {set x(3)} msg] $msg } {0 xyzzy} test trace-12.8 {errors when setting variable traces} { - catch {unset x} + unset -nocomplain x set x 44 list [catch {trace add variable x(0) write traceProc} msg] $msg } {1 {can't trace "x(0)": variable isn't array}} @@ -762,7 +760,7 @@ test trace-13.1 {delete one trace from another} { trace remove variable x read {traceTag 3} trace remove variable x read {traceTag 4} } - catch {unset x} + unset -nocomplain x set x 44 set info {} trace add variable x read {traceTag 1} @@ -916,13 +914,13 @@ test trace-14.11 {trace command, "trace variable" errors} { test trace-14.12 {trace command ("remove variable" option)} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x write traceProc trace remove variable x write traceProc } {} test trace-14.13 {trace command ("remove variable" option)} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x write traceProc trace remove variable x write traceProc @@ -930,7 +928,7 @@ test trace-14.13 {trace command ("remove variable" option)} { set info } {} test trace-14.14 {trace command ("remove variable" option)} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x write {traceTag 1} trace add variable x write traceProc @@ -945,7 +943,7 @@ test trace-14.14 {trace command ("remove variable" option)} { set info } {2 x {} write 1 2 1 2} test trace-14.15 {trace command ("remove variable" option)} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x write {traceTag 1} trace remove variable x write non_existent @@ -953,27 +951,27 @@ test trace-14.15 {trace command ("remove variable" option)} { set info } {1} test trace-14.16 {trace command ("info variable" option)} { - catch {unset x} + unset -nocomplain x trace add variable x write {traceTag 1} trace add variable x write traceProc trace add variable x write {traceTag 2} trace info variable x } {{write {traceTag 2}} {write traceProc} {write {traceTag 1}}} test trace-14.17 {trace command ("info variable" option)} { - catch {unset x} + unset -nocomplain x trace info variable x } {} test trace-14.18 {trace command ("info variable" option)} { - catch {unset x} + unset -nocomplain x trace info variable x(0) } {} test trace-14.19 {trace command ("info variable" option)} { - catch {unset x} + unset -nocomplain x set x 44 trace info variable x(0) } {} test trace-14.20 {trace command ("info variable" option)} { - catch {unset x} + unset -nocomplain x set x 44 trace add variable x write {traceTag 1} proc check {} {global x; trace info variable x} @@ -983,7 +981,7 @@ test trace-14.20 {trace command ("info variable" option)} { # Check fancy trace commands (long ones, weird arguments, etc.) test trace-15.1 {long trace command} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x write {traceTag {This is a very very long argument. It's \ designed to test out the facilities of TraceVarProc for dealing \ @@ -1001,14 +999,14 @@ test trace-15.2 {long trace command result to ignore} { proc longResult {args} {return "quite a bit of text, designed to generate a core leak if this command file is invoked over and over again and memory isn't being recycled correctly"} - catch {unset x} + unset -nocomplain x trace add variable x write longResult set x 44 set x 5 set x abcde } abcde test trace-15.3 {special list-handling in trace commands} { - catch {unset "x y z"} + unset -nocomplain "x y z" set "x y z(a\n\{)" 44 set info {} trace add variable "x y z(a\n\{)" write traceProc @@ -1020,18 +1018,18 @@ test trace-15.3 {special list-handling in trace commands} { proc traceUnset {unsetName args} { global info - upvar $unsetName x + upvar 1 $unsetName x lappend info [catch {unset x} msg] $msg [catch {set x} msg] $msg } proc traceReset {unsetName resetName args} { global info - upvar $unsetName x $resetName y + upvar 1 $unsetName x $resetName y lappend info [catch {unset x} msg] $msg [catch {set y xyzzy} msg] $msg } proc traceReset2 {unsetName resetName args} { global info - lappend info [catch {uplevel unset $unsetName} msg] $msg \ - [catch {uplevel set $resetName xyzzy} msg] $msg + lappend info [catch {uplevel 1 unset $unsetName} msg] $msg \ + [catch {uplevel 1 set $resetName xyzzy} msg] $msg } proc traceAppend {string name1 name2 op} { global info @@ -1039,7 +1037,7 @@ proc traceAppend {string name1 name2 op} { } test trace-16.1 {unsets during read traces} { - catch {unset y} + unset -nocomplain y set y 1234 set info {} trace add variable y read {traceUnset y} @@ -1047,49 +1045,49 @@ test trace-16.1 {unsets during read traces} { lappend info [catch {set y} msg] $msg } {unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}} test trace-16.2 {unsets during read traces} { - catch {unset y} + unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) read {traceUnset y(0)} lappend info [catch {set y(0)} msg] $msg } {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such element in array}} test trace-16.3 {unsets during read traces} { - catch {unset y} + unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) read {traceUnset y} lappend info [catch {set y(0)} msg] $msg } {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such variable}} test trace-16.4 {unsets during read traces} { - catch {unset y} + unset -nocomplain y set y 1234 set info {} trace add variable y read {traceReset y y} lappend info [catch {set y} msg] $msg } {0 {} 0 xyzzy 0 xyzzy} test trace-16.5 {unsets during read traces} { - catch {unset y} + unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) read {traceReset y(0) y(0)} lappend info [catch {set y(0)} msg] $msg } {0 {} 0 xyzzy 0 xyzzy} test trace-16.6 {unsets during read traces} { - catch {unset y} + unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) read {traceReset y y(0)} lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg } {0 {} 1 {can't set "y": upvar refers to element in deleted array} 1 {can't read "y(0)": no such variable} 1 {can't read "y(0)": no such variable}} test trace-16.7 {unsets during read traces} { - catch {unset y} + unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) read {traceReset2 y y(0)} lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg } {0 {} 0 xyzzy 1 {can't read "y(0)": no such element in array} 0 xyzzy} test trace-16.8 {unsets during write traces} { - catch {unset y} + unset -nocomplain y set y 1234 set info {} trace add variable y write {traceUnset y} @@ -1097,91 +1095,91 @@ test trace-16.8 {unsets during write traces} { lappend info [catch {set y xxx} msg] $msg } {unset 0 {} 1 {can't read "x": no such variable} 0 {}} test trace-16.9 {unsets during write traces} { - catch {unset y} + unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) write {traceUnset y(0)} lappend info [catch {set y(0) xxx} msg] $msg } {0 {} 1 {can't read "x": no such variable} 0 {}} test trace-16.10 {unsets during write traces} { - catch {unset y} + unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) write {traceUnset y} lappend info [catch {set y(0) xxx} msg] $msg } {0 {} 1 {can't read "x": no such variable} 0 {}} test trace-16.11 {unsets during write traces} { - catch {unset y} + unset -nocomplain y set y 1234 set info {} trace add variable y write {traceReset y y} lappend info [catch {set y xxx} msg] $msg } {0 {} 0 xyzzy 0 xyzzy} test trace-16.12 {unsets during write traces} { - catch {unset y} + unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) write {traceReset y(0) y(0)} lappend info [catch {set y(0) xxx} msg] $msg } {0 {} 0 xyzzy 0 xyzzy} test trace-16.13 {unsets during write traces} { - catch {unset y} + unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) write {traceReset y y(0)} lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg } {0 {} 1 {can't set "y": upvar refers to element in deleted array} 0 {} 1 {can't read "y(0)": no such variable}} test trace-16.14 {unsets during write traces} { - catch {unset y} + unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) write {traceReset2 y y(0)} lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg } {0 {} 0 xyzzy 0 {} 0 xyzzy} test trace-16.15 {unsets during unset traces} { - catch {unset y} + unset -nocomplain y set y 1234 set info {} trace add variable y unset {traceUnset y} lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg } {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y": no such variable}} test trace-16.16 {unsets during unset traces} { - catch {unset y} + unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) unset {traceUnset y(0)} lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg } {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such element in array}} test trace-16.17 {unsets during unset traces} { - catch {unset y} + unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) unset {traceUnset y} lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg } {0 {} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such variable}} test trace-16.18 {unsets during unset traces} { - catch {unset y} + unset -nocomplain y set y 1234 set info {} trace add variable y unset {traceReset2 y y} lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg } {1 {can't unset "y": no such variable} 0 xyzzy 0 {} 0 xyzzy} test trace-16.19 {unsets during unset traces} { - catch {unset y} + unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) unset {traceReset2 y(0) y(0)} lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg } {1 {can't unset "y(0)": no such element in array} 0 xyzzy 0 {} 0 xyzzy} test trace-16.20 {unsets during unset traces} { - catch {unset y} + unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) unset {traceReset2 y y(0)} lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg } {0 {} 0 xyzzy 0 {} 0 xyzzy} test trace-16.21 {unsets cancelling traces} { - catch {unset y} + unset -nocomplain y set y 1234 set info {} trace add variable y read {traceAppend first} @@ -1191,7 +1189,7 @@ test trace-16.21 {unsets cancelling traces} { lappend info [catch {set y} msg] $msg } {third unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}} test trace-16.22 {unsets cancelling traces} { - catch {unset y} + unset -nocomplain y set y(0) 1234 set info {} trace add variable y(0) read {traceAppend first} @@ -1204,19 +1202,19 @@ test trace-16.22 {unsets cancelling traces} { # Check various non-interference between traces and other things. test trace-17.1 {trace doesn't prevent unset errors} { - catch {unset x} + unset -nocomplain x set info {} trace add variable x unset {traceProc} list [catch {unset x} msg] $msg $info } {1 {can't unset "x": no such variable} {x {} unset}} test trace-17.2 {traced variables must survive procedure exits} { - catch {unset x} + unset -nocomplain x proc p1 {} {global x; trace add variable x write traceProc} p1 trace info variable x } {{write traceProc}} test trace-17.3 {traced variables must survive procedure exits} { - catch {unset x} + unset -nocomplain x set info {} proc p1 {} {global x; trace add variable x write traceProc} p1 @@ -1229,7 +1227,7 @@ test trace-17.3 {traced variables must survive procedure exits} { test trace-18.1 {unset traces on procedure returns} { proc p1 {x y} {set a 44; p2 14} - proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel {info vars}]}}} + proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel 1 {info vars}]}}} set info {} p1 foo bar set info @@ -1269,8 +1267,7 @@ test trace-18.4 {namespace delete / trace vdelete combo, Bug \#1338280} { # Delete arrays when done, so they can be re-used as scalars # elsewhere. -catch {unset x} -catch {unset y} +unset -nocomplain x y test trace-19.0.1 {trace add command (command existence)} { # Just in case! @@ -1312,6 +1309,7 @@ test trace-19.3 {command rename traces don't fire on command deletion} { test trace-19.4 {trace add command rename doesn't trace recreated commands} { proc foo {} {} catch {rename bar {}} + set info {} trace add command foo rename traceCommand proc foo {} {} rename foo bar @@ -1324,25 +1322,49 @@ test trace-19.5 {trace add command deleted removes traces} { trace info command foo } {} -namespace eval tc {} -proc tc::tcfoo {} {} -test trace-19.6 {trace add command rename in namespace} { +test trace-19.6 {trace add command rename in namespace} -setup { + namespace eval tc {} + proc tc::tcfoo {} {} +} -body { trace add command tc::tcfoo rename traceCommand rename tc::tcfoo tc::tcbar set info -} {::tc::tcfoo ::tc::tcbar rename} -test trace-19.7 {trace add command rename in namespace back again} { +} -cleanup { + namespace delete tc +} -result {::tc::tcfoo ::tc::tcbar rename} +test trace-19.7 {trace add command rename in namespace back again} -setup { + namespace eval tc {} + proc tc::tcfoo {} {} +} -body { + trace add command tc::tcfoo rename traceCommand + rename tc::tcfoo tc::tcbar rename tc::tcbar tc::tcfoo set info -} {::tc::tcbar ::tc::tcfoo rename} -test trace-19.8 {trace add command rename in namespace to out of namespace} { +} -cleanup { + namespace delete tc +} -result {::tc::tcbar ::tc::tcfoo rename} +test trace-19.8 {trace add command rename in namespace to out of namespace} -setup { + namespace eval tc {} + proc tc::tcfoo {} {} +} -body { + trace add command tc::tcfoo rename traceCommand rename tc::tcfoo tcbar set info -} {::tc::tcfoo ::tcbar rename} -test trace-19.9 {trace add command rename back into namespace} { +} -cleanup { + catch {rename tcbar {}} + namespace delete tc +} -result {::tc::tcfoo ::tcbar rename} +test trace-19.9 {trace add command rename back into namespace} -setup { + namespace eval tc {} + proc tc::tcfoo {} {} +} -body { + trace add command tc::tcfoo rename traceCommand + rename tc::tcfoo tcbar rename tcbar tc::tcfoo set info -} {::tcbar ::tc::tcfoo rename} +} -cleanup { + namespace delete tc +} -result {::tcbar ::tc::tcfoo rename} test trace-19.10 {trace add command failed rename doesn't trigger trace} { set info {} proc foo {} {} @@ -1353,11 +1375,18 @@ test trace-19.10 {trace add command failed rename doesn't trigger trace} { } {} catch {rename foo {}} catch {rename bar {}} -test trace-19.11 {trace add command qualifies when renamed in namespace} { + +test trace-19.11 {trace add command qualifies when renamed in namespace} -setup { + namespace eval tc {} + proc tc::tcfoo {} {} +} -body { set info {} + trace add command tc::tcfoo {rename delete} traceCommand namespace eval tc {rename tcfoo tcbar} set info -} {::tc::tcfoo ::tc::tcbar rename} +} -cleanup { + namespace delete tc +} -result {::tc::tcfoo ::tc::tcbar rename} # Make sure it exists again proc foo {} {} @@ -1542,8 +1571,7 @@ proc foo {b} { set a $b } # Delete arrays when done, so they can be re-used as scalars # elsewhere. -catch {unset x} -catch {unset y} +unset -nocomplain x y # Delete procedures when done, so we don't clash with other tests # (e.g. foobar will clash with 'unknown' tests). @@ -1674,6 +1702,16 @@ test trace-21.11 {trace execution and alias} -setup { rename ::x {} } -result {:: ::} +proc set2 args { + set {*}$args +} + +test trace-21.12 {bug 2438181} -setup { + trace add execution set2 leave {puts one two three #;} +} -body { + set2 a hello +} -returnCodes 1 -result {wrong # args: should be "puts ?-nonewline? ?channelId? string"} + proc factorial {n} { if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] } return 1 @@ -2050,7 +2088,7 @@ test trace-28.1 {enterstep and leavestep traces with update idletasks (615043)} trace remove execution foo {enter enterstep leavestep leave} \ [list traceExecute foo] rename foo {} - catch {unset a} + unset -nocomplain a join $info "\n" } {foo foo enter foo {set a 1} enterstep @@ -2623,6 +2661,13 @@ test trace-39.1 {bug #3485022: tracing Bc'ed commands} -setup { rename dotrace {} rename foo {} } -result {3 | 0 1 1} + +test trace-40.1 {execution trace errors become command errors} { + proc foo args {} + trace add execution foo enter {rename foo {}; error bar;#} + catch foo m + return -level 0 $m[unset m] +} bar # Delete procedures when done, so we don't clash with other tests # (e.g. foobar will clash with 'unknown' tests). @@ -2634,9 +2679,8 @@ catch {rename traceproc {}} catch {rename runbase {}} # Unset the variable when done -catch {unset info} -catch {unset base} +unset -nocomplain info base # cleanup -::tcltest::cleanupTests +cleanupTests return diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test index 2453e01..e4613ed 100644 --- a/tests/unixFCmd.test +++ b/tests/unixFCmd.test @@ -365,20 +365,21 @@ test unixFCmd-17.4 {SetPermissionsAttribute} -setup { close [open foo.test w] set ::i 4 -proc permcheck {testnum permstr expected} { +proc permcheck {testnum permList expected} { test $testnum {SetPermissionsAttribute} {unix notRoot} { + set result {} + foreach permstr $permList { file attributes foo.test -permissions $permstr - file attributes foo.test -permissions + lappend result [file attributes foo.test -permissions] + } + set result } $expected } permcheck unixFCmd-17.5 rwxrwxrwx 00777 permcheck unixFCmd-17.6 r--r---w- 00442 -permcheck unixFCmd-17.7 0 00000 -permcheck unixFCmd-17.8 u+rwx,g+r 00740 -permcheck unixFCmd-17.9 u-w 00540 -permcheck unixFCmd-17.10 o+rwx 00547 +permcheck unixFCmd-17.7 {0 u+rwx,g+r u-w o+rwx} {00000 00740 00540 00547} permcheck unixFCmd-17.11 --x--x--x 00111 -permcheck unixFCmd-17.12 a+rwx 00777 +permcheck unixFCmd-17.12 {0 a+rwx} {00000 00777} file delete -force -- foo.test test unixFCmd-18.1 {Unix pwd} -constraints {unix notRoot nonPortable} -setup { diff --git a/tests/unixForkEvent.test b/tests/unixForkEvent.test new file mode 100644 index 0000000..120f362 --- /dev/null +++ b/tests/unixForkEvent.test @@ -0,0 +1,45 @@ +# This file contains a collection of tests for the procedures in the file +# tclUnixNotify.c. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. +# +# Copyright (c) 1995-1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +package require tcltest 2 +namespace import -force ::tcltest::* + +testConstraint testfork [llength [info commands testfork]] + +# Test if the notifier thread is well initialized in a forked interpreter +# by Tcl_InitNotifier +test unixforkevent-1.1 {fork and test writeable event} \ + -constraints {testfork nonPortable} \ + -body { + set myFolder [makeDirectory unixtestfork] + set pid [testfork] + if {$pid == 0} { + # we are the forked process + set result initialized + set h [open [file join $myFolder test.txt] w] + fileevent $h writable\ + "set result writable;\ + after cancel [after 1000 {set result timeout}]" + vwait result + close $h + makeFile $result result.txt $myFolder + exit + } + # we are the original process + while {![file readable [file join $myFolder result.txt]]} {} + viewFile result.txt $myFolder + } \ + -result {writable} \ + -cleanup { + catch { removeFolder $myFolder } + } + +::tcltest::cleanupTests +return diff --git a/tests/unixInit.test b/tests/unixInit.test index 9ba9c11..05338ed 100644 --- a/tests/unixInit.test +++ b/tests/unixInit.test @@ -11,7 +11,7 @@ # this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcltest 2.2 -namespace import -force ::tcltest::* +namespace import ::tcltest::* unset -nocomplain path catch {set oldlang $env(LANG)} set env(LANG) C @@ -44,11 +44,11 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio} set pipe1 [open "|[list [interpreter]]" r+] puts $pipe1 { proc accept {channel host port} { - puts $channel {puts [fconfigure stdin -peername]; exit} + puts $channel {puts [chan configure stdin -peername]; exit} close $channel exit } - puts [fconfigure [socket -server accept -myaddr 127.0.0.1 0] -sockname] + puts [chan configure [socket -server accept -myaddr 127.0.0.1 0] -sockname] vwait forever \ } # Note the backslash above; this is important to make sure that the whole @@ -64,8 +64,8 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio} set pipe2 [open "|[list [interpreter] <@$sock]" r] set result [gets $pipe2] # Clear any pending data; stops certain kinds of (non-important) errors - fconfigure $pipe1 -blocking 0; gets $pipe1 - fconfigure $pipe2 -blocking 0; gets $pipe2 + chan configure $pipe1 -blocking 0; gets $pipe1 + chan configure $pipe2 -blocking 0; gets $pipe2 # Close the pipes and the socket. close $pipe2 close $pipe1 @@ -329,7 +329,7 @@ test unixInit-3.1 {TclpSetInitialEncodings} -constraints { } -body { set env(LANG) C set f [open "|[list [interpreter]]" w+] - fconfigure $f -buffering none + chan configure $f -buffering none puts $f {puts [encoding system]; exit} set enc [gets $f] close $f @@ -344,7 +344,7 @@ test unixInit-3.2 {TclpSetInitialEncodings} -setup { set env(LANG) japanese set env(LC_ALL) japanese set f [open "|[list [interpreter]]" w+] - fconfigure $f -buffering none + chan configure $f -buffering none puts $f {puts [encoding system]; exit} set enc [gets $f] close $f @@ -390,7 +390,7 @@ test unixInit-7.1 {closed standard channel: Bug 772288} -constraints { } -returnCodes 0 # cleanup -catch {unset env(LANG)} +unset -nocomplain env(LANG) catch {set env(LANG) $oldlang} unset -nocomplain path ::tcltest::cleanupTests diff --git a/tests/unknown.test b/tests/unknown.test index 40be6602..e80d3a6 100644 --- a/tests/unknown.test +++ b/tests/unknown.test @@ -11,12 +11,10 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest - namespace import -force ::tcltest::* -} +package require tcltest 2 +namespace import ::tcltest::* -catch {unset x} +unset -nocomplain x catch {rename unknown unknown.old} test unknown-1.1 {non-existent "unknown" command} { @@ -59,7 +57,7 @@ test unknown-4.1 {errors in "unknown" procedure} { # cleanup catch {rename unknown {}} catch {rename unknown.old unknown} -::tcltest::cleanupTests +cleanupTests return # Local Variables: diff --git a/tests/upvar.test b/tests/upvar.test index e2c9ffd..e93f58a 100644 --- a/tests/upvar.test +++ b/tests/upvar.test @@ -414,6 +414,17 @@ test upvar-9.7 {Tcl_UpVar procedure} testupvar { } {1234} catch {unset a} +test upvar-10.1 {CompileWord OBOE} -setup { + proc linenumber {} {dict get [info frame -1] line} +} -body { + apply {n { + upvar 1 {*}{ + } [return [incr n -[linenumber]]] x + }} [linenumber] +} -cleanup { + rename linenumber {} +} -result 1 + # # Tests for 'namespace upvar'. As the implementation is essentially the same as # for 'upvar', we only test that the variables are linked correctly, i.e., we @@ -536,6 +547,38 @@ test upvar-NS-2.2 {TIP 323} -setup { } -cleanup { namespace delete test_ns_1 } -result {} + +test upvar-NS-3.1 {CompileWord OBOE} -setup { + proc linenumber {} {dict get [info frame -1] line} +} -body { + apply {n { + namespace upvar {*}{ + } [return [incr n -[linenumber]]] x y + }} [linenumber] +} -cleanup { + rename linenumber {} +} -result 1 +test upvar-NS-3.2 {CompileWord OBOE} -setup { + proc linenumber {} {dict get [info frame -1] line} +} -body { + apply {n { + namespace upvar :: {*}{ + } [return [incr n -[linenumber]]] x + }} [linenumber] +} -cleanup { + rename linenumber {} +} -result 1 +test upvar-NS-3.3 {CompileWord OBOE} -setup { + proc linenumber {} {dict get [info frame -1] line} +} -body { + apply {n { + variable x {*}{ + } [return [incr n -[linenumber]]] + }} [linenumber] +} -cleanup { + rename linenumber {} +} -result 1 + # cleanup ::tcltest::cleanupTests diff --git a/tests/utf.test b/tests/utf.test index c41cfe3..ebab967 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -337,8 +337,8 @@ test utf-21.11 {TclUniCharIsControl} { string is control \u00ad } {1} test utf-21.12 {unicode control char in regc_locale.c} { - # [Bug 3464428] - regexp {^[[:cntrl:]]$} \u00ad + # [Bug 3464428], [Bug a876646efe] + regexp {^[[:cntrl:]]*$} \u0000\u001f\u00ad } {1} test utf-22.1 {TclUniCharIsWordChar} { diff --git a/tests/var.test b/tests/var.test index ed7e930..208b361 100644 --- a/tests/var.test +++ b/tests/var.test @@ -748,6 +748,9 @@ test var-15.1 {segfault in [unset], [Bug 735335]} { namespace eval test A useSomeUnlikelyNameHere namespace eval test unset useSomeUnlikelyNameHere } {} +test var-15.2 {compiled unset evaluation order, Bug 3970f54c4e} { + apply {{} {unset foo [return ok]}} +} ok test var-16.1 {CallVarTraces: save/restore interp error state} { trace add variable ::errorCode write " ;#" @@ -793,6 +796,88 @@ test var-19.1 {crash when freeing locals hashtable: Bug 3037525} { foo ; # This crashes without the fix for the bug rename foo {} } {} + +test var-20.1 {array set compilation correctness: Bug 3603163} -setup { + unset -nocomplain x +} -body { + apply {{} { + global x + array set x {a 1} + }} + array size x +} -result 1 +test var-20.2 {array set compilation correctness: Bug 3603163} -setup { + unset -nocomplain x +} -body { + apply {{} { + global x + array set x {} + }} + array size x +} -result 0 +test var-20.3 {array set compilation correctness: Bug 3603163} -setup { + unset -nocomplain x +} -body { + apply {{} { + array set ::x {a 1} + }} + array size x +} -result 1 +test var-20.4 {array set compilation correctness: Bug 3603163} -setup { + unset -nocomplain x +} -body { + apply {{} { + array set ::x {} + }} + array size x +} -result 0 +test var-20.5 {array set compilation correctness: Bug 3603163} -setup { + unset -nocomplain x +} -body { + apply {{} { + global x + eval {array set x {a 1}} + }} + array size x +} -result 1 +test var-20.6 {array set compilation correctness: Bug 3603163} -setup { + unset -nocomplain x +} -body { + apply {{} { + global x + eval {array set x {}} + }} + array size x +} -result 0 +test var-20.7 {array set compilation correctness: Bug 3603163} -setup { + unset -nocomplain x +} -body { + apply {{} { + eval {array set ::x {a 1}} + }} + array size x +} -result 1 +test var-20.8 {array set compilation correctness: Bug 3603163} -setup { + unset -nocomplain x +} -body { + apply {{} { + eval {array set ::x {}} + }} + array size x +} -result 0 + +test var-21.0 {PushVarNameWord OBOE in compiled unset} -setup { + proc linenumber {} {dict get [info frame -1] line} +} -body { + apply {n { + set foo bar + unset foo {*}{ + } [return [incr n -[linenumber]]] + }} [linenumber] +} -cleanup { + rename linenumber {} +} -result 1 + catch {namespace delete ns} catch {unset arr} diff --git a/tests/zlib.test b/tests/zlib.test index 891dba0..4e51ebb 100644 --- a/tests/zlib.test +++ b/tests/zlib.test @@ -16,6 +16,13 @@ if {"::tcltest" ni [namespace children]} { } testConstraint zlib [llength [info commands zlib]] +testConstraint recentZlib 0 +catch { + # Work around a bug in some versions of zlib; known to manifest on at + # least Mac OS X Mountain Lion... + testConstraint recentZlib \ + [package vsatisfies [zlib::pkgconfig get zlibVersion] 1.2.6] +} test zlib-1.1 {zlib basics} -constraints zlib -returnCodes error -body { zlib @@ -233,7 +240,7 @@ test zlib-8.7 {transformation and fconfigure} -setup { # Dictionary is that which is proposed _in_ SPDY draft set spdyHeaders "HTTP/1.0 200 OK\r\nContent-Type: text/html; charset=utf-8\r\nX-Robots-Tag: noarchive\r\nLast-Modified: Tue, 05 Jun 2012 02:43:25 GMT\r\nETag: \"1338864205129|#public|0|en|||0\"\r\nExpires: Tue, 05 Jun 2012 16:17:11 GMT\r\nDate: Tue, 05 Jun 2012 16:17:06 GMT\r\nCache-Control: public, max-age=5\r\nX-Content-Type-Options: nosniff\r\nX-XSS-Protection: 1; mode=block\r\nServer: GSE\r\n" set spdyDict "optionsgetheadpostputdeletetraceacceptaccept-charsetaccept-encodingaccept-languageauthorizationexpectfromhostif-modified-sinceif-matchif-none-matchif-rangeif-unmodifiedsincemax-forwardsproxy-authorizationrangerefererteuser-agent100101200201202203204205206300301302303304305306307400401402403404405406407408409410411412413414415416417500501502503504505accept-rangesageetaglocationproxy-authenticatepublicretry-afterservervarywarningwww-authenticateallowcontent-basecontent-encodingcache-controlconnectiondatetrailertransfer-encodingupgradeviawarningcontent-languagecontent-lengthcontent-locationcontent-md5content-rangecontent-typeetagexpireslast-modifiedset-cookieMondayTuesdayWednesdayThursdayFridaySaturdaySundayJanFebMarAprMayJunJulAugSepOctNovDecchunkedtext/htmlimage/pngimage/jpgimage/gifapplication/xmlapplication/xhtmltext/plainpublicmax-agecharset=iso-8859-1utf-8gzipdeflateHTTP/1.1statusversionurl" -test zlib-8.8 {transformtion and fconfigure} -setup { +test zlib-8.8 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide } -constraints zlib -body { zlib push compress $outSide -dictionary $spdyDict @@ -250,7 +257,7 @@ test zlib-8.8 {transformtion and fconfigure} -setup { catch {close $outSide} catch {close $inSide} } -result {260 222 {need dictionary} {TCL ZLIB NEED_DICT 2381337010} 2381337010} -test zlib-8.9 {transformtion and fconfigure} -setup { +test zlib-8.9 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide set strm [zlib stream decompress] } -constraints zlib -body { @@ -267,16 +274,19 @@ test zlib-8.9 {transformtion and fconfigure} -setup { catch {close $inSide} catch {$strm close} } -result {3064818174 358 358} -test zlib-8.10 {transformtion and fconfigure} -setup { +test zlib-8.10 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide -} -constraints zlib -body { +} -constraints {zlib recentZlib} -body { zlib push deflate $outSide -dictionary $spdyDict fconfigure $outSide -blocking 0 -translation binary -buffering none fconfigure $inSide -blocking 0 -translation binary puts -nonewline $outSide $spdyHeaders chan pop $outSide set compressed [read $inSide] - catch {zlib inflate $compressed} err opt + catch { + zlib inflate $compressed + throw UNREACHABLE "should be unreachable" + } err opt list [string length [zlib deflate $spdyHeaders]] \ [string length $compressed] \ $err [dict get $opt -errorcode] @@ -284,7 +294,7 @@ test zlib-8.10 {transformtion and fconfigure} -setup { catch {close $outSide} catch {close $inSide} } -result {254 212 {data error} {TCL ZLIB DATA}} -test zlib-8.11 {transformtion and fconfigure} -setup { +test zlib-8.11 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide set strm [zlib stream inflate] } -constraints zlib -body { @@ -300,7 +310,7 @@ test zlib-8.11 {transformtion and fconfigure} -setup { catch {close $inSide} catch {$strm close} } -result {358 358} -test zlib-8.12 {transformtion and fconfigure} -setup { +test zlib-8.12 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide set strm [zlib stream compress] } -constraints zlib -body { @@ -317,7 +327,7 @@ test zlib-8.12 {transformtion and fconfigure} -setup { catch {close $inSide} catch {$strm close} } -result {358 358 3064818174} -test zlib-8.13 {transformtion and fconfigure} -setup { +test zlib-8.13 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide set strm [zlib stream compress] } -constraints zlib -body { @@ -334,7 +344,7 @@ test zlib-8.13 {transformtion and fconfigure} -setup { catch {close $inSide} catch {$strm close} } -result {358 358 3064818174} -test zlib-8.14 {transformtion and fconfigure} -setup { +test zlib-8.14 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide set strm [zlib stream deflate] } -constraints zlib -body { @@ -350,7 +360,7 @@ test zlib-8.14 {transformtion and fconfigure} -setup { catch {close $inSide} catch {$strm close} } -result {358 358} -test zlib-8.15 {transformtion and fconfigure} -setup { +test zlib-8.15 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide set strm [zlib stream deflate] } -constraints zlib -body { @@ -366,6 +376,25 @@ test zlib-8.15 {transformtion and fconfigure} -setup { catch {close $inSide} catch {$strm close} } -result {358 358} +test zlib-8.16 {Bug 3603553: buffer transfer with large writes} -setup { + # Actual data isn't very important; needs to be substantially larger than + # the internal buffer (32kB) and incompressible. + set largeData {} + for {set i 0;expr srand(1)} {$i < 100000} {incr i} { + append largeData [lindex "a b c d e f g h i j k l m n o p" \ + [expr {int(16*rand())}]] + } + set file [makeFile {} test.gz] +} -constraints zlib -body { + set f [open $file wb] + fconfigure $f -buffering none + zlib push gzip $f + puts -nonewline $f $largeData + close $f + file size $file +} -cleanup { + removeFile $file +} -result 57647 test zlib-9.1 "check fcopy with push" -constraints zlib -setup { set sfile [makeFile {} testsrc.gz] diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index 93e0a9a..b45e560 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -983,6 +983,8 @@ proc genStubs::emitHeader {name} { append text "#define ${CAPName}_STUBS_REVISION $revision\n" } + append text "\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n" + emitDeclarations $name text if {[info exists hooks($name)]} { @@ -1010,8 +1012,7 @@ proc genStubs::emitHeader {name} { append text "} ${capName}Stubs;\n\n" - append text "#ifdef __cplusplus\nextern \"C\" {\n#endif\n" - append text "extern const ${capName}Stubs *${name}StubsPtr;\n" + append text "extern const ${capName}Stubs *${name}StubsPtr;\n\n" append text "#ifdef __cplusplus\n}\n#endif\n" emitMacros $name text diff --git a/tools/man2help2.tcl b/tools/man2help2.tcl index fe4e7ad..9c8f503 100644 --- a/tools/man2help2.tcl +++ b/tools/man2help2.tcl @@ -717,7 +717,7 @@ proc char {name} { textSetup puts -nonewline $file "\\'d7 " } - {\(em} { + {\(em} - {\(en} { textSetup puts -nonewline $file "-" } diff --git a/tools/tcltk-man2html-utils.tcl b/tools/tcltk-man2html-utils.tcl index d02bcb6..8fd1245 100644 --- a/tools/tcltk-man2html-utils.tcl +++ b/tools/tcltk-man2html-utils.tcl @@ -142,6 +142,7 @@ proc process-text {text} { {\(+-} "±" \ {\(co} "©" \ {\(em} "—" \ + {\(en} "–" \ {\(fm} "′" \ {\(mu} "×" \ {\(mi} "−" \ @@ -900,7 +901,7 @@ proc insert-cross-references {text} { append result [string range $text 0 [expr {$off-1}]] regexp -indices -start $off {http://[\w/.]+} $text range set url [string range $text {*}$range] - append result "<A HREF=\"$url\">" $url "</A>" + append result "<A HREF=\"[string trimright $url .]\">$url</A>" set text [string range $text[set text ""] \ [expr {[lindex $range 1]+1}] end] continue diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index f392bce..89e8e5c 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -470,6 +470,7 @@ proc plus-pkgs {type args} { continue } } + set dir [string trimright $dir "0123456789-."] switch $type { n { set title "$name Package Commands" @@ -647,10 +648,12 @@ try { append appdir "$tkdir" } + apply {{} { + global packageBuildList tcltkdir tcldir build_tcl # When building docs for Tcl, try to build docs for bundled packages too set packageBuildList {} - if {$build_tcl} { + if {$build_tcl} { set pkgsDir [file join $tcltkdir $tcldir pkgs] set subdirs [glob -nocomplain -types d -tails -directory $pkgsDir *] @@ -693,7 +696,8 @@ try { foreach line [split [read $f] \n] { if {[string trim $line] eq ""} continue if {[string match #* $line]} continue - lappend packageDirNameMap {*}$line + lassign $line dir name + lappend packageDirNameMap $dir $name } } finally { close $f @@ -714,6 +718,7 @@ try { lset packageBuildList $idx+1 [dict get $packageDirNameMap $n] } } + }} # # Invoke the scraper/converter engine. diff --git a/tools/uniClass.tcl b/tools/uniClass.tcl index 32b40e9..9b4819d 100644 --- a/tools/uniClass.tcl +++ b/tools/uniClass.tcl @@ -72,7 +72,7 @@ proc genTable {type} { if {$i == ($last + 1)} { set last $i } else { - if {$first > 0} { + if {$first >= 0} { emitRange $first $last } set first $i diff --git a/unix/Makefile.in b/unix/Makefile.in index df05759..a0d0c87 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -291,24 +291,24 @@ XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.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 \ - tclCmdAH.o tclCmdIL.o tclCmdMZ.o tclCompCmds.o tclCompCmdsSZ.o \ - tclCompExpr.o tclCompile.o tclConfig.o tclDate.o tclDictObj.o \ + tclAssembly.o tclAsync.o tclBasic.o tclBinary.o tclCkalloc.o \ + tclClock.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o \ + tclCompCmds.o tclCompCmdsGR.o tclCompCmdsSZ.o tclCompExpr.o \ + tclCompile.o tclConfig.o tclDate.o tclDictObj.o \ tclEncoding.o tclEnsemble.o \ tclEnv.o tclEvent.o tclExecute.o tclFCmd.o tclFileName.o tclGet.o \ tclHash.o tclHistory.o tclIndexObj.o tclInterp.o tclIO.o tclIOCmd.o \ tclIORChan.o tclIORTrans.o tclIOGT.o tclIOSock.o tclIOUtil.o \ tclLink.o tclListObj.o \ tclLiteral.o tclLoad.o tclMain.o tclNamesp.o tclNotify.o \ - tclObj.o tclPanic.o tclParse.o tclPathObj.o tclPipe.o \ + tclObj.o tclOptimize.o tclPanic.o tclParse.o tclPathObj.o tclPipe.o \ tclPkg.o tclPkgConfig.o tclPosixStr.o \ tclPreserve.o tclProc.o tclRegexp.o \ tclResolve.o tclResult.o tclScan.o tclStringObj.o \ tclStrToD.o tclThread.o \ tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \ tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \ - tclTomMathInterface.o \ - tclAssembly.o + tclTomMathInterface.o OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \ tclOOMethod.o tclOOStubInit.o @@ -335,7 +335,10 @@ TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \ bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \ bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o -STUB_LIB_OBJS = tclStubLib.o tclTomMathStubLib.o tclOOStubLib.o ${COMPAT_OBJS} +STUB_LIB_OBJS = tclStubLib.o \ + tclTomMathStubLib.o \ + tclOOStubLib.o \ + ${COMPAT_OBJS} UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \ tclUnixFile.o tclUnixPipe.o tclUnixSock.o \ @@ -346,6 +349,8 @@ NOTIFY_OBJS = tclUnixNotfy.o MAC_OSX_OBJS = tclMacOSXBundle.o tclMacOSXFCmd.o tclMacOSXNotify.o +CYGWIN_OBJS = tclWinError.o + DTRACE_OBJ = tclDTrace.o ZLIB_OBJS = Zadler32.o Zcompress.o Zcrc32.o Zdeflate.o Zinfback.o \ @@ -395,6 +400,7 @@ GENERIC_SRCS = \ $(GENERIC_DIR)/tclCmdIL.c \ $(GENERIC_DIR)/tclCmdMZ.c \ $(GENERIC_DIR)/tclCompCmds.c \ + $(GENERIC_DIR)/tclCompCmdsGR.c \ $(GENERIC_DIR)/tclCompCmdsSZ.c \ $(GENERIC_DIR)/tclCompExpr.c \ $(GENERIC_DIR)/tclCompile.c \ @@ -428,6 +434,7 @@ GENERIC_SRCS = \ $(GENERIC_DIR)/tclNamesp.c \ $(GENERIC_DIR)/tclNotify.c \ $(GENERIC_DIR)/tclObj.c \ + $(GENERIC_DIR)/tclOptimize.c \ $(GENERIC_DIR)/tclParse.c \ $(GENERIC_DIR)/tclPathObj.c \ $(GENERIC_DIR)/tclPipe.c \ @@ -573,6 +580,9 @@ MAC_OSX_SRCS = \ $(MAC_OSX_DIR)/tclMacOSXFCmd.c \ $(MAC_OSX_DIR)/tclMacOSXNotify.c +CYGWIN_SRCS = \ + $(TOP_DIR)/win/tclWinError.c + DTRACE_HDR = tclDTrace.h DTRACE_SRC = $(GENERIC_DIR)/tclDTrace.d @@ -603,7 +613,7 @@ SRCS = $(GENERIC_SRCS) $(TOMMATH_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \ all: binaries libraries doc packages -binaries: ${LIB_FILE} $(STUB_LIB_FILE) ${TCL_EXE} +binaries: ${LIB_FILE} ${TCL_EXE} libraries: @@ -611,15 +621,14 @@ doc: # The following target is configured by autoconf to generate either a shared # library or non-shared library for Tcl. -${LIB_FILE}: ${OBJS} ${STUB_LIB_FILE} +${LIB_FILE}: ${STUB_LIB_FILE} ${OBJS} rm -f $@ @MAKE_LIB@ - @if test "x$(DLL_INSTALL_DIR)" = "x$(BIN_INSTALL_DIR)"; then\ - cp ${ZLIB_DIR}/win32/zlib1.dll .;\ - fi - ${STUB_LIB_FILE}: ${STUB_LIB_OBJS} + @if test "x${LIB_FILE}" = "xlibtcl${MAJOR_VERSION}.${MINOR_VERSION}.dll"; then \ + (cd ${TOP_DIR}/win; ${MAKE} tcldde14.dll tclreg13.dll); \ + fi rm -f $@ @MAKE_STUB_LIB@ @@ -633,9 +642,9 @@ tclLibObjs: # This targets actually build the objects needed for the lib in the above case objs: ${OBJS} -${TCL_EXE}: ${TCLSH_OBJS} ${TCL_LIB_FILE} +${TCL_EXE}: ${TCLSH_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} ${CC} ${CFLAGS} ${LDFLAGS} ${TCLSH_OBJS} \ - @TCL_BUILD_LIB_SPEC@ ${LIBS} @EXTRA_TCLSH_LIBS@ \ + @TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \ ${CC_SEARCH_FLAGS} -o ${TCL_EXE} # Must be empty so it doesn't conflict with rule for ${TCL_EXE} above @@ -787,11 +796,6 @@ install-binaries: binaries else true; \ fi; \ done; - @if test "x$(DLL_INSTALL_DIR)" = "x$(BIN_INSTALL_DIR)"; then\ - echo "Installing zlib1.dll to $(BIN_INSTALL_DIR)/";\ - $(INSTALL_LIBRARY) zlib1.dll "$(BIN_INSTALL_DIR)";\ - chmod 555 "$(BIN_INSTALL_DIR)/zlib1.dll";\ - fi @echo "Installing $(LIB_FILE) to $(DLL_INSTALL_DIR)/" @@INSTALL_LIB@ @chmod 555 "$(DLL_INSTALL_DIR)/$(LIB_FILE)" @@ -839,20 +843,20 @@ install-libraries: libraries do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \ done; - @echo "Installing package http 2.8.5 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.5.tm; + @echo "Installing package http 2.8.8 as a Tcl Module"; + @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.8.tm; @echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/"; @for i in $(TOP_DIR)/library/opt/*.tcl ; \ do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \ done; - @echo "Installing package msgcat 1.5.0 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.5.0.tm; - @echo "Installing package tcltest 2.3.5 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.5.tm; + @echo "Installing package msgcat 1.5.2 as a Tcl Module"; + @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.5.2.tm; + @echo "Installing package tcltest 2.3.7 as a Tcl Module"; + @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.7.tm; - @echo "Installing package platform 1.0.10 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.10.tm; + @echo "Installing package platform 1.0.12 as a Tcl Module"; + @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.12.tm; @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform/shell-1.1.4.tm; @@ -866,10 +870,39 @@ install-libraries: libraries "$(SCRIPT_INSTALL_DIR)"/tm.tcl; \ fi -install-tzdata: ${NATIVE_TCLSH} +install-tzdata: + @for i in tzdata; \ + do \ + if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \ + echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ + $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/$$i; \ + else true; \ + fi; \ + done; @echo "Installing time zone files to $(SCRIPT_INSTALL_DIR)/tzdata/" - @${NATIVE_TCLSH} $(TOOL_DIR)/installData.tcl \ - $(TOP_DIR)/library/tzdata "$(SCRIPT_INSTALL_DIR)"/tzdata + @for i in $(TOP_DIR)/library/tzdata/* ; do \ + if [ -d $$i ] ; then \ + ii=`basename $$i`; \ + if [ ! -d "$(SCRIPT_INSTALL_DIR)"/tzdata/$$ii ] ; then \ + $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/tzdata/$$ii; \ + fi; \ + for j in $$i/* ; do \ + if [ -d $$j ] ; then \ + jj=`basename $$j`; \ + if [ ! -d "$(SCRIPT_INSTALL_DIR)"/tzdata/$$ii/$$jj ] ; then \ + $(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/tzdata/$$ii/$$jj; \ + fi; \ + for k in $$j/* ; do \ + $(INSTALL_DATA) $$k "$(SCRIPT_INSTALL_DIR)"/tzdata/$$ii/$$jj; \ + done; \ + else \ + $(INSTALL_DATA) $$j "$(SCRIPT_INSTALL_DIR)"/tzdata/$$ii; \ + fi; \ + done; \ + else \ + $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/tzdata; \ + fi; \ + done; install-msgs: @for i in msgs; \ @@ -1056,6 +1089,9 @@ tclDate.o: $(GENERIC_DIR)/tclDate.c tclCompCmds.o: $(GENERIC_DIR)/tclCompCmds.c $(COMPILEHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompCmds.c +tclCompCmdsGR.o: $(GENERIC_DIR)/tclCompCmdsGR.c $(COMPILEHDR) + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompCmdsGR.c + tclCompCmdsSZ.o: $(GENERIC_DIR)/tclCompCmdsSZ.c $(COMPILEHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompCmdsSZ.c @@ -1140,6 +1176,9 @@ tclLiteral.o: $(GENERIC_DIR)/tclLiteral.c $(COMPILEHDR) tclObj.o: $(GENERIC_DIR)/tclObj.c $(COMPILEHDR) $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclObj.c +tclOptimize.o: $(GENERIC_DIR)/tclOptimize.c $(COMPILEHDR) + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOptimize.c + tclLoad.o: $(GENERIC_DIR)/tclLoad.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLoad.c @@ -1571,7 +1610,7 @@ $(DTRACE_OBJ): $(DTRACE_SRC) $(TCL_OBJS) # notifier can modify them to suit their own installation. #-------------------------------------------------------------------------- -xttest: ${XTTEST_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} ${BUILD_DLTEST} +xttest: ${XTTEST_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} ${BUILD_DLTEST} ${CC} ${CFLAGS} ${LDFLAGS} ${XTTEST_OBJS} \ @TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \ ${CC_SEARCH_FLAGS} -L/usr/openwin/lib -lXt -o xttest @@ -1654,7 +1693,7 @@ Zzutil.o: $(ZLIB_DIR)/zutil.c #-------------------------------------------------------------------------- tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c - $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclStubLib.c + $(CC) -c $(STUB_CC_SWITCHES) -DSTATIC_BUILD $(GENERIC_DIR)/tclStubLib.c tclTomMathStubLib.o: $(GENERIC_DIR)/tclTomMathStubLib.c $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclTomMathStubLib.c @@ -1718,7 +1757,7 @@ install-packages: packages fi; \ done -test-packages: tcltest packages +test-packages: ${TCLTEST_EXE} packages @for i in $(PKGS_DIR)/*; do \ if [ -d $$i ]; then \ pkg=`basename $$i`; \ @@ -1913,6 +1952,7 @@ $(MAC_OSX_DIR)/configure: $(MAC_OSX_DIR)/configure.ac $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in: $(MAC_OSX_DIR)/configure cd $(MAC_OSX_DIR); autoheader; touch $@ +EOLFIX=$(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(MAC_OSX_DIR)/configure genstubs dist-packages ${NATIVE_TCLSH} rm -rf $(DISTDIR) mkdir -p $(DISTDIR)/unix @@ -1928,7 +1968,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M $(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix chmod 775 $(DISTDIR)/unix/configure $(DISTDIR)/unix/configure.in chmod 775 $(DISTDIR)/unix/ldAix - mkdir $(DISTDIR)/generic + @mkdir $(DISTDIR)/generic cp -p $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic cp -p $(GENERIC_DIR)/*.decls $(DISTDIR)/generic cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic @@ -1936,7 +1976,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README* \ $(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \ $(DISTDIR) - mkdir $(DISTDIR)/library + @mkdir $(DISTDIR)/library cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \ $(TOP_DIR)/library/tclIndex $(DISTDIR)/library for i in http1.0 http opt msgcat reg dde tcltest platform; \ @@ -1944,31 +1984,32 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M mkdir $(DISTDIR)/library/$$i ;\ cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \ done; - mkdir $(DISTDIR)/library/encoding + @mkdir $(DISTDIR)/library/encoding cp -p $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding - mkdir $(DISTDIR)/library/msgs + @mkdir $(DISTDIR)/library/msgs cp -p $(TOP_DIR)/library/msgs/*.msg $(DISTDIR)/library/msgs - ( cd $(TOP_DIR); \ + @echo cp -r $(TOP_DIR)/library/tzdata $(DISTDIR)/library/tzdata + @( cd $(TOP_DIR); \ find library/tzdata -name CVS -prune -o -type f -print ) \ | ( cd $(TOP_DIR) ; xargs tar cf - ) \ | ( cd $(DISTDIR) ; tar xfp - ) - mkdir $(DISTDIR)/doc + @mkdir $(DISTDIR)/doc cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \ $(TOP_DIR)/doc/man.macros $(DISTDIR)/doc - mkdir $(DISTDIR)/compat + @mkdir $(DISTDIR)/compat cp -p $(TOP_DIR)/license.terms $(COMPAT_DIR)/*.[ch] \ $(COMPAT_DIR)/README $(DISTDIR)/compat - mkdir $(DISTDIR)/compat/zlib + @mkdir $(DISTDIR)/compat/zlib ( cd $(COMPAT_DIR)/zlib; \ find . -name CVS -prune -o -type f -print ) \ | ( cd $(COMPAT_DIR)/zlib ; xargs tar cf - ) \ | ( cd $(DISTDIR)/compat/zlib ; tar xfp - ) - mkdir $(DISTDIR)/tests + @mkdir $(DISTDIR)/tests cp -p $(TOP_DIR)/license.terms $(DISTDIR)/tests cp -p $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \ $(TOP_DIR)/tests/httpd $(TOP_DIR)/tests/*.tcl \ $(DISTDIR)/tests - mkdir $(DISTDIR)/win + @mkdir $(DISTDIR)/win cp $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win cp $(TOP_DIR)/win/configure.in $(TOP_DIR)/win/configure \ $(TOP_DIR)/win/tclConfig.sh.in $(TOP_DIR)/win/tclooConfig.sh \ @@ -1977,49 +2018,48 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M cp -p $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \ $(DISTDIR)/win cp -p $(TOP_DIR)/win/*.bat $(DISTDIR)/win - $(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/*.bat + @$(EOLFIX) -crlf $(DISTDIR)/win/*.bat cp -p $(TOP_DIR)/win/makefile.* $(DISTDIR)/win - $(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/makefile.* + @$(EOLFIX) -crlf $(DISTDIR)/win/makefile.bc $(DISTDIR)/win/makefile.vc cp -p $(TOP_DIR)/win/rules.vc $(DISTDIR)/win - $(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/rules.vc + @$(EOLFIX) -crlf $(DISTDIR)/win/rules.vc cp -p $(TOP_DIR)/win/coffbase.txt $(DISTDIR)/win - $(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/coffbase.txt + @$(EOLFIX) -crlf $(DISTDIR)/win/coffbase.txt cp -p $(TOP_DIR)/win/tcl.hpj.in $(DISTDIR)/win - $(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/tcl.hpj.in + @$(EOLFIX) -crlf $(DISTDIR)/win/tcl.hpj.in cp -p $(TOP_DIR)/win/tcl.ds* $(DISTDIR)/win - $(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/tcl.ds* + @$(EOLFIX) -crlf $(DISTDIR)/win/tcl.ds* cp -p $(TOP_DIR)/win/README $(DISTDIR)/win cp -p $(TOP_DIR)/license.terms $(DISTDIR)/win - mkdir $(DISTDIR)/macosx + @mkdir $(DISTDIR)/macosx cp -p $(MAC_OSX_DIR)/GNUmakefile $(MAC_OSX_DIR)/README \ $(MAC_OSX_DIR)/*.c $(MAC_OSX_DIR)/*.in \ $(MAC_OSX_DIR)/*.ac $(MAC_OSX_DIR)/*.xcconfig \ $(MAC_OSX_DIR)/configure $(DISTDIR)/macosx cp -p $(TOP_DIR)/license.terms $(DISTDIR)/macosx - mkdir $(DISTDIR)/macosx/Tcl.xcode + @mkdir $(DISTDIR)/macosx/Tcl.xcode cp -p $(MAC_OSX_DIR)/Tcl.xcode/project.pbxproj \ $(MAC_OSX_DIR)/Tcl.xcode/default.pbxuser \ $(DISTDIR)/macosx/Tcl.xcode - mkdir $(DISTDIR)/macosx/Tcl.xcodeproj + @mkdir $(DISTDIR)/macosx/Tcl.xcodeproj cp -p $(MAC_OSX_DIR)/Tcl.xcodeproj/project.pbxproj \ $(MAC_OSX_DIR)/Tcl.xcodeproj/default.pbxuser \ $(DISTDIR)/macosx/Tcl.xcodeproj - mkdir $(DISTDIR)/unix/dltest + @mkdir $(DISTDIR)/unix/dltest cp -p $(UNIX_DIR)/dltest/*.c $(UNIX_DIR)/dltest/Makefile.in \ - $(UNIX_DIR)/dltest/README \ - $(DISTDIR)/unix/dltest - mkdir $(DISTDIR)/tools + $(UNIX_DIR)/dltest/README $(DISTDIR)/unix/dltest + @mkdir $(DISTDIR)/tools cp -p $(TOOL_DIR)/Makefile.in $(TOOL_DIR)/README \ $(TOOL_DIR)/configure $(TOOL_DIR)/configure.in \ $(TOOL_DIR)/*.tcl $(TOOL_DIR)/man2tcl.c \ $(TOOL_DIR)/*.bmp $(TOOL_DIR)/tcl.hpj.in \ $(DISTDIR)/tools - $(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/tools/tcl.hpj.in - mkdir $(DISTDIR)/libtommath - cp -p $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h \ - $(DISTDIR)/libtommath - mkdir $(DISTDIR)/pkgs + @$(EOLFIX) -crlf $(DISTDIR)/tools/tcl.hpj.in + @mkdir $(DISTDIR)/libtommath + cp -p $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h $(DISTDIR)/libtommath + @mkdir $(DISTDIR)/pkgs cp $(TOP_DIR)/pkgs/README $(DISTDIR)/pkgs + cp $(TOP_DIR)/pkgs/package.list.txt $(DISTDIR)/pkgs for i in `ls $(DISTROOT)/pkgs/*.tar.gz 2> /dev/null`; do \ tar -C $(DISTDIR)/pkgs -xzf "$$i"; \ done @@ -2039,6 +2079,9 @@ alldist: dist # build of this HTML documentation that has already been placed online. As # such, this rule is not guaranteed to work well on all systems; it only needs # to function on those of the Tcl/Tk maintainers. +# +# Also note that the 8.6 tool build requires an installed 8.6 native Tcl +# interpreter in order to be able to run. #-------------------------------------------------------------------------- html: ${NATIVE_TCLSH} @@ -2051,9 +2094,12 @@ html-tk: ${NATIVE_TCLSH} $(BUILD_HTML) --tk @EXTRA_BUILD_HTML@ +# You'd better have these programs or you will have problems creating Makefile +# from Makefile.in in the first place... +HTML_VERSION = `basename $(TOP_DIR) | sed s/tcl//` BUILD_HTML = \ @${NATIVE_TCLSH} $(TOOL_DIR)/tcltk-man2html.tcl \ - --htmldir="$(HTML_INSTALL_DIR)" \ + --useversion=$(HTML_VERSION) --htmldir="$(HTML_INSTALL_DIR)" \ --srcdir=$(TOP_DIR)/.. $(BUILD_HTML_FLAGS) #-------------------------------------------------------------------------- diff --git a/unix/README b/unix/README index 87b151a..d8f1090 100644 --- a/unix/README +++ b/unix/README @@ -163,6 +163,7 @@ you'll see a much more substantial printout for each error. See the README file in the "tests" directory for more information on the test suite. Note: don't run the tests as superuser: this will cause several of them to fail. If a test is failing consistently, please send us a bug report with as much -detail as you can manage. Please use the online database at - http://tcl.sourceforge.net/ +detail as you can manage to our tracker: + + http://core.tcl.tk/tcl/reportlist diff --git a/unix/configure b/unix/configure index f778a7b..0e231ab 100755 --- a/unix/configure +++ b/unix/configure @@ -1335,7 +1335,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL=".0" +TCL_PATCH_LEVEL=".1" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ @@ -4821,7 +4821,11 @@ echo "$as_me: WARNING: Don't know how to find pthread lib on your system - you m # Does the pthread-implementation provide # 'pthread_attr_setstacksize' ? -for ac_func in pthread_attr_setstacksize + ac_saved_libs=$LIBS + LIBS="$LIBS $THREADS_LIBS" + + +for ac_func in pthread_attr_setstacksize pthread_atfork do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 @@ -4922,6 +4926,7 @@ _ACEOF fi done + LIBS=$ac_saved_libs else TCL_THREADS=0 fi @@ -6485,80 +6490,6 @@ if test "${tcl_cv_cc_visibility_hidden+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else - if test "$SHARED_BUILD" = 1; then - - hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -fvisibility=hidden -Werror" - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ - -int -main () -{ -#if !defined(__GNUC__) || __GNUC__ < 4 -#error visibility hidden is not supported for this compiler -#endif - - ; - return 0; -} -_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 - tcl_cv_cc_visibility_hidden=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_cc_visibility_hidden=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext - CFLAGS=$hold_cflags - -else - - tcl_cv_cc_visibility_hidden=no - -fi - - -fi -echo "$as_me:$LINENO: result: $tcl_cv_cc_visibility_hidden" >&5 -echo "${ECHO_T}$tcl_cv_cc_visibility_hidden" >&6 - if test $tcl_cv_cc_visibility_hidden = yes; then - - CFLAGS="$CFLAGS -fvisibility=hidden" - -cat >>confdefs.h <<\_ACEOF -#define MODULE_SCOPE extern -_ACEOF - - -else - hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -6609,7 +6540,10 @@ fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags - if test $tcl_cv_cc_visibility_hidden = yes; then +fi +echo "$as_me:$LINENO: result: $tcl_cv_cc_visibility_hidden" >&5 +echo "${ECHO_T}$tcl_cv_cc_visibility_hidden" >&6 + if test $tcl_cv_cc_visibility_hidden = yes; then cat >>confdefs.h <<\_ACEOF @@ -6617,7 +6551,9 @@ cat >>confdefs.h <<\_ACEOF _ACEOF -fi +cat >>confdefs.h <<\_ACEOF +#define HAVE_HIDDEN 1 +_ACEOF fi @@ -7063,7 +6999,9 @@ fi SHLIB_CFLAGS="" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".dll" - DL_OBJS="tclLoadDl.o tclWinError.o" + DL_OBJS="tclLoadDl.o" + PLAT_OBJS='${CYGWIN_OBJS}' + PLAT_SRCS='${CYGWIN_SRCS}' DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" @@ -7138,10 +7076,15 @@ echo "$as_me: error: ${CC} is not a cygwin compiler." >&2;} echo "$as_me: error: CYGWIN compile is only supported with --enable-threads" >&2;} { (exit 1); exit 1; }; } fi - if test "x${SHARED_BUILD}" = "x1" -a ! -f "../win/tcldde14.dll" -a ! -f "../win/tk86.dll"; then - { { echo "$as_me:$LINENO: error: Please configure and make the ../win directory first." >&5 -echo "$as_me: error: Please configure and make the ../win directory first." >&2;} - { (exit 1); exit 1; }; } + do64bit_ok=yes + if test "x${SHARED_BUILD}" = "x1"; then + echo "running cd ../win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args" + # The eval makes quoting arguments work. + if cd ../win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args; cd ../unix + then : + else + { echo "configure: error: configure failed for ../win" 1>&2; exit 1; } + fi fi ;; dgux*) @@ -7577,7 +7520,7 @@ fi fi ;; - Linux*) + Linux*|GNU*|NetBSD-Debian) SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" @@ -7683,21 +7626,6 @@ fi fi ;; - GNU*) - SHLIB_CFLAGS="-fPIC" - SHLIB_SUFFIX=".so" - - SHLIB_LD='${CC} -shared' - DL_OBJS="" - DL_LIBS="-ldl" - LDFLAGS="$LDFLAGS -Wl,--export-dynamic" - CC_SEARCH_FLAGS="" - LD_SEARCH_FLAGS="" - if test "`uname -m`" = "alpha"; then - CFLAGS="$CFLAGS -mieee" -fi - - ;; Lynx*) SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" @@ -7734,71 +7662,15 @@ fi CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; - NetBSD-1.*|FreeBSD-[1-2].*) - SHLIB_CFLAGS="-fPIC" - SHLIB_LD="ld -Bshareable -x" - SHLIB_SUFFIX=".so" - DL_OBJS="tclLoadDl.o" - DL_LIBS="" - if test $doRpath = yes; then - - CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' - LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' -fi - - echo "$as_me:$LINENO: checking for ELF" >&5 -echo $ECHO_N "checking for ELF... $ECHO_C" >&6 -if test "${tcl_cv_ld_elf+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ - -#ifdef __ELF__ - yes -#endif - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "yes" >/dev/null 2>&1; then - tcl_cv_ld_elf=yes -else - tcl_cv_ld_elf=no -fi -rm -f conftest* - -fi -echo "$as_me:$LINENO: result: $tcl_cv_ld_elf" >&5 -echo "${ECHO_T}$tcl_cv_ld_elf" >&6 - if test $tcl_cv_ld_elf = yes; then - - SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so' - -else - - SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}' - -fi - - - # Ancient FreeBSD doesn't handle version numbers with dots. - - UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' - TCL_LIB_VERSIONS_OK=nodots - ;; OpenBSD-*) arch=`arch -s` case "$arch" in - m88k|vax) + vax) # Equivalent using configure option --disable-load # Step 4 will set the necessary variables DL_OBJS="" SHLIB_LD_LIBS="" + LDFLAGS="" ;; *) SHLIB_CFLAGS="-fPIC" @@ -7813,10 +7685,11 @@ fi LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}' + LDFLAGS="-Wl,-export-dynamic" ;; esac case "$arch" in - m88k|vax) + vax) CFLAGS_OPTIMIZE="-O1" ;; sh) @@ -7826,43 +7699,6 @@ fi CFLAGS_OPTIMIZE="-O2" ;; esac - echo "$as_me:$LINENO: checking for ELF" >&5 -echo $ECHO_N "checking for ELF... $ECHO_C" >&6 -if test "${tcl_cv_ld_elf+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ - -#ifdef __ELF__ - yes -#endif - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "yes" >/dev/null 2>&1; then - tcl_cv_ld_elf=yes -else - tcl_cv_ld_elf=no -fi -rm -f conftest* - -fi -echo "$as_me:$LINENO: result: $tcl_cv_ld_elf" >&5 -echo "${ECHO_T}$tcl_cv_ld_elf" >&6 - if test $tcl_cv_ld_elf = yes; then - - LDFLAGS=-Wl,-export-dynamic - -else - LDFLAGS="" -fi - if test "${TCL_THREADS}" = "1"; then # On OpenBSD: Compile with -pthread @@ -7876,9 +7712,8 @@ fi UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' TCL_LIB_VERSIONS_OK=nodots ;; - NetBSD-*|FreeBSD-[3-4].*) - # FreeBSD 3.* and greater have ELF. - # NetBSD 2.* has ELF and can use 'cc -shared' to build shared libs + NetBSD-*) + # NetBSD has ELF and can use 'cc -shared' to build shared libs SHLIB_CFLAGS="-fPIC" SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}' SHLIB_SUFFIX=".so" @@ -7900,20 +7735,12 @@ fi fi - case $system in - FreeBSD-3.*) - # FreeBSD-3 doesn't handle version numbers with dots. - UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' - SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so' - TCL_LIB_VERSIONS_OK=nodots - ;; - esac ;; FreeBSD-*) # This configuration from FreeBSD Ports. SHLIB_CFLAGS="-fPIC" SHLIB_LD="${CC} -shared" - TCL_SHLIB_LD_EXTRAS="-soname \$@" + TCL_SHLIB_LD_EXTRAS="-Wl,-soname=\$@" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" @@ -7921,7 +7748,7 @@ fi if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' - LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' fi if test "${TCL_THREADS}" = "1"; then @@ -8249,7 +8076,6 @@ cat >>confdefs.h <<\_ACEOF #define MODULE_SCOPE __private_extern__ _ACEOF - tcl_cv_cc_visibility_hidden=yes fi @@ -9130,11 +8956,6 @@ cat >>confdefs.h <<\_ACEOF _ACEOF -cat >>confdefs.h <<\_ACEOF -#define NO_VIZ -_ACEOF - - fi @@ -9869,7 +9690,7 @@ cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include <sys/types.h> -#include <sys/dirent.h> +#include <dirent.h> int main () { @@ -13239,14 +13060,16 @@ fi fi #--------------------------------------------------------------------------- -# Determine which interface to use to talk to the serial port. -# Note that #include lines must begin in leftmost column for -# some compilers to recognize them as preprocessor directives. +# Check for serial port interface. +# +# termios.h is present on all POSIX systems. +# sys/ioctl.h is almost always present, though what it contains +# is system-specific. +# sys/modem.h is needed on HP-UX. #--------------------------------------------------------------------------- - -for ac_header in sys/modem.h +for ac_header in termios.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then @@ -13395,310 +13218,305 @@ fi done - echo "$as_me:$LINENO: checking termios vs. termio vs. sgtty" >&5 -echo $ECHO_N "checking termios vs. termio vs. sgtty... $ECHO_C" >&6 -if test "${tcl_cv_api_serial+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - if test "$cross_compiling" = yes; then - tcl_cv_api_serial=no +for ac_header in sys/ioctl.h +do +as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else - cat >conftest.$ac_ext <<_ACEOF + # Is the header compilable? +echo "$as_me:$LINENO: checking $ac_header usability" >&5 +echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ - -#include <termios.h> - -int main() { - struct termios t; - if (tcgetattr(0, &t) == 0) { - cfsetospeed(&t, 0); - t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB; - return 0; - } - return 1; -} +$ac_includes_default +#include <$ac_header> _ACEOF -rm -f conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>&5 +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='./conftest$ac_exeext' + (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); }; }; then - tcl_cv_api_serial=termios -else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -( exit $ac_status ) -tcl_cv_api_serial=no -fi -rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext -fi - if test $tcl_cv_api_serial = no ; then - if test "$cross_compiling" = yes; then - tcl_cv_api_serial=no -else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ - -#include <termio.h> - -int main() { - struct termio t; - if (ioctl(0, TCGETA, &t) == 0) { - t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB; - return 0; - } - return 1; -} -_ACEOF -rm -f conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + (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 - tcl_cv_api_serial=termio + ac_header_compiler=yes else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 + echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -( exit $ac_status ) -tcl_cv_api_serial=no -fi -rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext +ac_header_compiler=no fi - fi - if test $tcl_cv_api_serial = no ; then - if test "$cross_compiling" = yes; then - tcl_cv_api_serial=no -else - cat >conftest.$ac_ext <<_ACEOF +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 + +# Is the header present? +echo "$as_me:$LINENO: checking $ac_header presence" >&5 +echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ - -#include <sgtty.h> - -int main() { - struct sgttyb t; - if (ioctl(0, TIOCGETP, &t) == 0) { - t.sg_ospeed = 0; - t.sg_flags |= ODDP | EVENP | RAW; - return 0; - } - return 1; -} +#include <$ac_header> _ACEOF -rm -f conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && { ac_try='./conftest$ac_exeext' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 - (eval $ac_try) 2>&5 +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); }; }; then - tcl_cv_api_serial=sgtty + (exit $ac_status); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -( exit $ac_status ) -tcl_cv_api_serial=no -fi -rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext + ac_header_preproc=no fi - fi - if test $tcl_cv_api_serial = no ; then - if test "$cross_compiling" = yes; then - tcl_cv_api_serial=no -else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 -#include <termios.h> -#include <errno.h> +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 +echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + eval "$as_ac_Header=\$ac_header_preproc" +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 -int main() { - struct termios t; - if (tcgetattr(0, &t) == 0 - || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { - cfsetospeed(&t, 0); - t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB; - return 0; - } - return 1; -} +fi +if test `eval echo '${'$as_ac_Header'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF -rm -f conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && { ac_try='./conftest$ac_exeext' - { (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 - tcl_cv_api_serial=termios -else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 -( exit $ac_status ) -tcl_cv_api_serial=no fi -rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext + +done + + +for ac_header in sys/modem.h +do +as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 fi - fi - if test $tcl_cv_api_serial = no; then - if test "$cross_compiling" = yes; then - tcl_cv_api_serial=no +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 else - cat >conftest.$ac_ext <<_ACEOF + # Is the header compilable? +echo "$as_me:$LINENO: checking $ac_header usability" >&5 +echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ - -#include <termio.h> -#include <errno.h> - -int main() { - struct termio t; - if (ioctl(0, TCGETA, &t) == 0 - || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { - t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB; - return 0; - } - return 1; - } +$ac_includes_default +#include <$ac_header> _ACEOF -rm -f conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>&5 +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='./conftest$ac_exeext' + (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 - tcl_cv_api_serial=termio + ac_header_compiler=yes else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 + echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -( exit $ac_status ) -tcl_cv_api_serial=no -fi -rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext +ac_header_compiler=no fi - fi - if test $tcl_cv_api_serial = no; then - if test "$cross_compiling" = yes; then - tcl_cv_api_serial=none -else - cat >conftest.$ac_ext <<_ACEOF +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 + +# Is the header present? +echo "$as_me:$LINENO: checking $ac_header presence" >&5 +echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ - -#include <sgtty.h> -#include <errno.h> - -int main() { - struct sgttyb t; - if (ioctl(0, TIOCGETP, &t) == 0 - || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { - t.sg_ospeed = 0; - t.sg_flags |= ODDP | EVENP | RAW; - return 0; - } - return 1; -} +#include <$ac_header> _ACEOF -rm -f conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && { ac_try='./conftest$ac_exeext' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 - (eval $ac_try) 2>&5 +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 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); }; }; then - tcl_cv_api_serial=sgtty + (exit $ac_status); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -( exit $ac_status ) -tcl_cv_api_serial=none + ac_header_preproc=no fi -rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 +echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6 +if eval "test \"\${$as_ac_Header+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + eval "$as_ac_Header=\$ac_header_preproc" fi - fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6 + fi -echo "$as_me:$LINENO: result: $tcl_cv_api_serial" >&5 -echo "${ECHO_T}$tcl_cv_api_serial" >&6 - case $tcl_cv_api_serial in - termios) -cat >>confdefs.h <<\_ACEOF -#define USE_TERMIOS 1 -_ACEOF -;; - termio) -cat >>confdefs.h <<\_ACEOF -#define USE_TERMIO 1 -_ACEOF -;; - sgtty) -cat >>confdefs.h <<\_ACEOF -#define USE_SGTTY 1 +if test `eval echo '${'$as_ac_Header'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF -;; - esac + +fi + +done #-------------------------------------------------------------------- @@ -14402,11 +14220,7 @@ _ACEOF # lack blkcnt_t. #-------------------------------------------------------------------- -if test "$ac_cv_cygwin" = "yes"; then - if test "x${SHARED_BUILD}" = "x1"; then - TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS} \${COMPAT_DIR}/zlib/win32/zdll.lib" - fi -else +if test "$ac_cv_cygwin" != "yes"; then echo "$as_me:$LINENO: checking for struct stat.st_blocks" >&5 echo $ECHO_N "checking for struct stat.st_blocks... $ECHO_C" >&6 if test "${ac_cv_member_struct_stat_st_blocks+set}" = set; then @@ -18071,108 +17885,6 @@ _ACEOF fi done - -for ac_func in pthread_atfork -do -as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` -echo "$as_me:$LINENO: checking for $ac_func" >&5 -echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 -if eval "test \"\${$as_ac_var+set}\" = set"; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func. - For example, HP-UX 11i <limits.h> declares gettimeofday. */ -#define $ac_func innocuous_$ac_func - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func (); below. - Prefer <limits.h> to <assert.h> if __STDC__ is defined, since - <limits.h> exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include <limits.h> -#else -# include <assert.h> -#endif - -#undef $ac_func - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -char (*f) () = $ac_func; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != $ac_func; - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 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_exeext' - { (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 - eval "$as_ac_var=yes" -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -eval "$as_ac_var=no" -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 -if test `eval echo '${'$as_ac_var'}'` = yes; then - cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 -_ACEOF - -fi -done - fi cat >>confdefs.h <<\_ACEOF diff --git a/unix/configure.in b/unix/configure.in index 087bb05..61ad30f 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -25,7 +25,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL=".0" +TCL_PATCH_LEVEL=".1" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ @@ -259,12 +259,17 @@ if test "${TCL_THREADS}" = 1; then fi #--------------------------------------------------------------------------- -# Determine which interface to use to talk to the serial port. -# Note that #include lines must begin in leftmost column for -# some compilers to recognize them as preprocessor directives. +# Check for serial port interface. +# +# termios.h is present on all POSIX systems. +# sys/ioctl.h is almost always present, though what it contains +# is system-specific. +# sys/modem.h is needed on HP-UX. #--------------------------------------------------------------------------- -SC_SERIAL_PORT +AC_CHECK_HEADERS(termios.h) +AC_CHECK_HEADERS(sys/ioctl.h) +AC_CHECK_HEADERS(sys/modem.h) #-------------------------------------------------------------------- # Include sys/select.h if it exists and if it supplies things @@ -305,11 +310,7 @@ SC_TIME_HANDLER # lack blkcnt_t. #-------------------------------------------------------------------- -if test "$ac_cv_cygwin" = "yes"; then - if test "x${SHARED_BUILD}" = "x1"; then - TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS} \${COMPAT_DIR}/zlib/win32/zdll.lib" - fi -else +if test "$ac_cv_cygwin" != "yes"; then AC_CHECK_MEMBERS([struct stat.st_blocks, struct stat.st_blksize]) fi AC_CHECK_TYPES([blkcnt_t]) @@ -575,7 +576,6 @@ if test "`uname -s`" = "Darwin" ; then if test $tcl_corefoundation = yes; then AC_CHECK_HEADERS(libkern/OSAtomic.h) AC_CHECK_FUNCS(OSSpinLockLock) - AC_CHECK_FUNCS(pthread_atfork) fi AC_DEFINE(USE_VFORK, 1, [Should we use vfork() instead of fork()?]) AC_DEFINE(TCL_DEFAULT_ENCODING, "utf-8", diff --git a/unix/dltest/Makefile.in b/unix/dltest/Makefile.in index 01589d9..25b9376 100644 --- a/unix/dltest/Makefile.in +++ b/unix/dltest/Makefile.in @@ -22,14 +22,14 @@ LDFLAGS_DEBUG = @LDFLAGS_DEBUG@ LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@ LDFLAGS = @LDFLAGS_DEFAULT@ @LDFLAGS@ -CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -I${BUILD_DIR}/.. -DTCL_MEM_DEBUG \ +CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -DTCL_MEM_DEBUG \ ${SHLIB_CFLAGS} -DUSE_TCL_STUBS ${AC_FLAGS} -all: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgd${SHLIB_SUFFIX} pkge${SHLIB_SUFFIX} pkgua${SHLIB_SUFFIX} +all: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgd${SHLIB_SUFFIX} pkge${SHLIB_SUFFIX} pkgua${SHLIB_SUFFIX} pkgooa${SHLIB_SUFFIX} @if test -n "$(DLTEST_SUFFIX)"; then $(MAKE) dltest_suffix; fi @touch ../dltest.marker -dltest_suffix: pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} pkgd${DLTEST_SUFFIX} pkge${DLTEST_SUFFIX} pkgua${DLTEST_SUFFIX} +dltest_suffix: pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} pkgd${DLTEST_SUFFIX} pkge${DLTEST_SUFFIX} pkgua${DLTEST_SUFFIX} pkgooa${DLTEST_SUFFIX} @touch ../dltest.marker pkga.o: $(SRC_DIR)/pkga.c @@ -50,6 +50,9 @@ pkge.o: $(SRC_DIR)/pkge.c pkgua.o: $(SRC_DIR)/pkgua.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgua.c +pkgooa.o: $(SRC_DIR)/pkgooa.c + $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgooa.c + pkga${SHLIB_SUFFIX}: pkga.o ${SHLIB_LD} -o pkga${SHLIB_SUFFIX} pkga.o ${SHLIB_LD_LIBS} @@ -68,6 +71,9 @@ pkge${SHLIB_SUFFIX}: pkge.o pkgua${SHLIB_SUFFIX}: pkgua.o ${SHLIB_LD} -o pkgua${SHLIB_SUFFIX} pkgua.o ${SHLIB_LD_LIBS} +pkgooa${SHLIB_SUFFIX}: pkgooa.o + ${SHLIB_LD} -o pkgooa${SHLIB_SUFFIX} pkgooa.o ${SHLIB_LD_LIBS} + pkga${DLTEST_SUFFIX}: pkga.o ${DLTEST_LD} -o pkga${DLTEST_SUFFIX} pkga.o ${SHLIB_LD_LIBS} @@ -86,6 +92,9 @@ pkge${DLTEST_SUFFIX}: pkge.o pkgua${DLTEST_SUFFIX}: pkgua.o ${DLTEST_LD} -o pkgua${DLTEST_SUFFIX} pkgua.o ${SHLIB_LD_LIBS} +pkgooa${DLTEST_SUFFIX}: pkgooa.o + ${DLTEST_LD} -o pkgooa${DLTEST_SUFFIX} pkgooa.o ${SHLIB_LD_LIBS} + clean: rm -f *.o lib.exp ../dltest.marker @if test "$(SHLIB_SUFFIX)" != ""; then \ diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c index ad61d77..f102496 100644 --- a/unix/dltest/pkgb.c +++ b/unix/dltest/pkgb.c @@ -144,7 +144,7 @@ Pkgb_Init( if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL); + code = Tcl_PkgProvide(interp, "Pkgb", "2.3"); if (code != TCL_OK) { return code; } @@ -181,7 +181,7 @@ Pkgb_SafeInit( if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL); + code = Tcl_PkgProvide(interp, "Pkgb", "2.3"); if (code != TCL_OK) { return code; } diff --git a/unix/dltest/pkgooa.c b/unix/dltest/pkgooa.c new file mode 100644 index 0000000..78af376 --- /dev/null +++ b/unix/dltest/pkgooa.c @@ -0,0 +1,141 @@ +/* + * pkgooa.c -- + * + * This file contains a simple Tcl package "pkgooa" that is intended for + * testing the Tcl dynamic loading facilities. + * + * 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. + */ + +#undef STATIC_BUILD +#include "tclOO.h" +#include <string.h> + +/* + *---------------------------------------------------------------------- + * + * Pkgooa_StubsOKObjCmd -- + * + * This procedure is invoked to process the "pkgooa_stubsok" Tcl command. + * It gives 1 if stubs are used correctly, 0 if stubs are not OK. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +Pkgooa_StubsOKObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, ""); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, Tcl_NewIntObj( + Tcl_CopyObjectInstance == tclOOStubsPtr->tcl_CopyObjectInstance)); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Pkgooa_Init -- + * + * This is a package initialization procedure, which is called by Tcl + * when this package is to be added to an interpreter. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +extern void *tclOOIntStubsPtr; + +static TclOOStubs stubsCopy = { + TCL_STUB_MAGIC, + NULL, + /* It doesn't really matter what implementation of + * Tcl_CopyObjectInstance is put in the "pseudo" + * stub table, since the test-case never actually + * calls this function. All that matters is that it's + * a function with a different memory address than + * the real Tcl_CopyObjectInstance function in Tcl. */ + (Tcl_Object (*) (Tcl_Interp *, Tcl_Object, const char *, + const char *t)) Pkgooa_StubsOKObjCmd + /* More entries could be here, but those are not used + * for this test-case. So, being NULL is OK. */ +}; + +extern DLLEXPORT int +Pkgooa_Init( + Tcl_Interp *interp) /* Interpreter in which the package is to be + * made available. */ +{ + int code; + + /* Any TclOO extension which uses stubs, calls + * both Tcl_InitStubs and Tcl_OOInitStubs() and + * does not use any Tcl 8.6 features should be + * loadable in Tcl 8.5 as well, provided the + * TclOO extension (for Tcl 8.5) is installed. + * This worked in Tcl 8.6.0, and is expected + * to keep working in all future Tcl 8.x releases. + */ + if (Tcl_InitStubs(interp, "8.5", 0) == NULL) { + return TCL_ERROR; + } + if (tclStubsPtr == NULL) { + Tcl_AppendResult(interp, "Tcl stubs are not inialized, " + "did you compile using -DUSE_TCL_STUBS? "); + return TCL_ERROR; + } + if (Tcl_OOInitStubs(interp) == NULL) { + return TCL_ERROR; + } + if (tclOOStubsPtr == NULL) { + Tcl_AppendResult(interp, "TclOO stubs are not inialized"); + return TCL_ERROR; + } + if (tclOOIntStubsPtr == NULL) { + Tcl_AppendResult(interp, "TclOO internal stubs are not inialized"); + return TCL_ERROR; + } + + /* Test case for Bug [f51efe99a7]. + * + * Let tclOOStubsPtr point to an alternate stub table + * (with only a single function, that's enough for + * this test). This way, the function "pkgooa_stubsok" + * can check whether the TclOO function calls really + * use the stub table, or only pretend to. + * + * On platforms without backlinking (Windows, Cygwin, + * AIX), this code doesn't even compile without using + * stubs, but on UNIX ELF systems, the problem is + * less visible. + */ + + tclOOStubsPtr = &stubsCopy; + + code = Tcl_PkgProvide(interp, "Pkgooa", "1.0"); + if (code != TCL_OK) { + return code; + } + Tcl_CreateObjCommand(interp, "pkgooa_stubsok", Pkgooa_StubsOKObjCmd, NULL, NULL); + return TCL_OK; +} diff --git a/unix/tcl.m4 b/unix/tcl.m4 index b13fddd..8c29334 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -111,9 +111,9 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [ `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do if test -f "$i/unix/tclConfig.sh" ; then - ac_cv_c_tclconfig="`(cd $i/unix; pwd)`" - break - fi + ac_cv_c_tclconfig="`(cd $i/unix; pwd)`" + break + fi done fi ]) @@ -271,11 +271,10 @@ AC_DEFUN([SC_PATH_TKCONFIG], [ # # Results: # -# Subst the following vars: +# Substitutes the following vars: # TCL_BIN_DIR # TCL_SRC_DIR # TCL_LIB_FILE -# #------------------------------------------------------------------------ AC_DEFUN([SC_LOAD_TCLCONFIG], [ @@ -439,11 +438,11 @@ AC_DEFUN([SC_LOAD_TKCONFIG], [ # extension can't assume that an executable Tcl shell exists at # build time. # -# Arguments +# Arguments: # none # -# Results -# Subst's the following values: +# Results: +# Substitutes the following vars: # TCLSH_PROG #------------------------------------------------------------------------ @@ -484,11 +483,11 @@ AC_DEFUN([SC_PROG_TCLSH], [ # when running tests from an extension build directory. It is not # correct to use the TCLSH_PROG in cases like this. # -# Arguments +# Arguments: # none # -# Results -# Subst's the following values: +# Results: +# Substitutes the following values: # BUILD_TCLSH #------------------------------------------------------------------------ @@ -676,7 +675,11 @@ AC_DEFUN([SC_ENABLE_THREADS], [ # Does the pthread-implementation provide # 'pthread_attr_setstacksize' ? - AC_CHECK_FUNCS(pthread_attr_setstacksize) + + ac_saved_libs=$LIBS + LIBS="$LIBS $THREADS_LIBS" + AC_CHECK_FUNCS(pthread_attr_setstacksize pthread_atfork) + LIBS=$ac_saved_libs else TCL_THREADS=0 fi @@ -786,7 +789,6 @@ AC_DEFUN([SC_ENABLE_SYMBOLS], [ # # Defines the following vars: # HAVE_LANGINFO Triggers use of nl_langinfo if defined. -# #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_LANGINFO], [ @@ -1041,33 +1043,17 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ AC_CACHE_CHECK([if compiler supports visibility "hidden"], tcl_cv_cc_visibility_hidden, [ - AS_IF([test "$SHARED_BUILD" = 1], [ - hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -fvisibility=hidden -Werror" - AC_TRY_COMPILE(,[#if !defined(__GNUC__) || __GNUC__ < 4 -#error visibility hidden is not supported for this compiler -#endif - ], tcl_cv_cc_visibility_hidden=yes, - tcl_cv_cc_visibility_hidden=no) - CFLAGS=$hold_cflags - ], [ - tcl_cv_cc_visibility_hidden=no - ]) - ]) - AS_IF([test $tcl_cv_cc_visibility_hidden = yes], [ - CFLAGS="$CFLAGS -fvisibility=hidden" - AC_DEFINE(MODULE_SCOPE, [extern], [No need to mark inidividual symbols as hidden]) - ], [ hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" AC_TRY_LINK([ extern __attribute__((__visibility__("hidden"))) void f(void); void f(void) {}], [f();], tcl_cv_cc_visibility_hidden=yes, tcl_cv_cc_visibility_hidden=no) - CFLAGS=$hold_cflags - AS_IF([test $tcl_cv_cc_visibility_hidden = yes], [ - AC_DEFINE(MODULE_SCOPE, - [extern __attribute__((__visibility__("hidden")))], - [Compiler support for module scope symbols]) - ]) + CFLAGS=$hold_cflags]) + AS_IF([test $tcl_cv_cc_visibility_hidden = yes], [ + AC_DEFINE(MODULE_SCOPE, + [extern __attribute__((__visibility__("hidden")))], + [Compiler support for module scope symbols]) + AC_DEFINE(HAVE_HIDDEN, [1], [Compiler support for module scope symbols]) ]) # Step 0.d: Disable -rpath support? @@ -1223,7 +1209,9 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ SHLIB_CFLAGS="" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".dll" - DL_OBJS="tclLoadDl.o tclWinError.o" + DL_OBJS="tclLoadDl.o" + PLAT_OBJS='${CYGWIN_OBJS}' + PLAT_SRCS='${CYGWIN_SRCS}' DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" @@ -1246,8 +1234,15 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ if test "x${TCL_THREADS}" = "x0"; then AC_MSG_ERROR([CYGWIN compile is only supported with --enable-threads]) fi - if test "x${SHARED_BUILD}" = "x1" -a ! -f "../win/tcldde14.dll" -a ! -f "../win/tk86.dll"; then - AC_MSG_ERROR([Please configure and make the ../win directory first.]) + do64bit_ok=yes + if test "x${SHARED_BUILD}" = "x1"; then + echo "running cd ../win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args" + # The eval makes quoting arguments work. + if cd ../win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args; cd ../unix + then : + else + { echo "configure: error: configure failed for ../win" 1>&2; exit 1; } + fi fi ;; dgux*) @@ -1398,7 +1393,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ ]) ]) ;; - Linux*) + Linux*|GNU*|NetBSD-Debian) SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" @@ -1436,18 +1431,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ AS_IF([test x"${USE_COMPAT}" != x],[CFLAGS="$CFLAGS -fno-inline"]) ;; - GNU*) - SHLIB_CFLAGS="-fPIC" - SHLIB_SUFFIX=".so" - - SHLIB_LD='${CC} -shared' - DL_OBJS="" - DL_LIBS="-ldl" - LDFLAGS="$LDFLAGS -Wl,--export-dynamic" - CC_SEARCH_FLAGS="" - LD_SEARCH_FLAGS="" - AS_IF([test "`uname -m`" = "alpha"], [CFLAGS="$CFLAGS -mieee"]) - ;; Lynx*) SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" @@ -1481,40 +1464,15 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; - NetBSD-1.*|FreeBSD-[[1-2]].*) - SHLIB_CFLAGS="-fPIC" - SHLIB_LD="ld -Bshareable -x" - SHLIB_SUFFIX=".so" - DL_OBJS="tclLoadDl.o" - DL_LIBS="" - AS_IF([test $doRpath = yes], [ - CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' - LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}']) - AC_CACHE_CHECK([for ELF], tcl_cv_ld_elf, [ - AC_EGREP_CPP(yes, [ -#ifdef __ELF__ - yes -#endif - ], tcl_cv_ld_elf=yes, tcl_cv_ld_elf=no)]) - AS_IF([test $tcl_cv_ld_elf = yes], [ - SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so' - ], [ - SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}' - ]) - - # Ancient FreeBSD doesn't handle version numbers with dots. - - UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' - TCL_LIB_VERSIONS_OK=nodots - ;; OpenBSD-*) arch=`arch -s` case "$arch" in - m88k|vax) + vax) # Equivalent using configure option --disable-load # Step 4 will set the necessary variables DL_OBJS="" SHLIB_LD_LIBS="" + LDFLAGS="" ;; *) SHLIB_CFLAGS="-fPIC" @@ -1526,10 +1484,11 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}' + LDFLAGS="-Wl,-export-dynamic" ;; esac case "$arch" in - m88k|vax) + vax) CFLAGS_OPTIMIZE="-O1" ;; sh) @@ -1539,15 +1498,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ CFLAGS_OPTIMIZE="-O2" ;; esac - AC_CACHE_CHECK([for ELF], tcl_cv_ld_elf, [ - AC_EGREP_CPP(yes, [ -#ifdef __ELF__ - yes -#endif - ], tcl_cv_ld_elf=yes, tcl_cv_ld_elf=no)]) - AS_IF([test $tcl_cv_ld_elf = yes], [ - LDFLAGS=-Wl,-export-dynamic - ], [LDFLAGS=""]) AS_IF([test "${TCL_THREADS}" = "1"], [ # On OpenBSD: Compile with -pthread # Don't link with -lpthread @@ -1558,9 +1508,8 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' TCL_LIB_VERSIONS_OK=nodots ;; - NetBSD-*|FreeBSD-[[3-4]].*) - # FreeBSD 3.* and greater have ELF. - # NetBSD 2.* has ELF and can use 'cc -shared' to build shared libs + NetBSD-*) + # NetBSD has ELF and can use 'cc -shared' to build shared libs SHLIB_CFLAGS="-fPIC" SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}' SHLIB_SUFFIX=".so" @@ -1576,27 +1525,19 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ CFLAGS="$CFLAGS -pthread" LDFLAGS="$LDFLAGS -pthread" ]) - case $system in - FreeBSD-3.*) - # FreeBSD-3 doesn't handle version numbers with dots. - UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' - SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so' - TCL_LIB_VERSIONS_OK=nodots - ;; - esac ;; FreeBSD-*) # This configuration from FreeBSD Ports. SHLIB_CFLAGS="-fPIC" SHLIB_LD="${CC} -shared" - TCL_SHLIB_LD_EXTRAS="-soname \$[@]" + TCL_SHLIB_LD_EXTRAS="-Wl,-soname=\$[@]" SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" LDFLAGS="" AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' - LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}']) + LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) AS_IF([test "${TCL_THREADS}" = "1"], [ # The -pthread needs to go in the LDFLAGS, not LIBS LIBS=`echo $LIBS | sed s/-pthread//` @@ -1685,7 +1626,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [ AC_DEFINE(MODULE_SCOPE, [__private_extern__], [Compiler support for module scope symbols]) - tcl_cv_cc_visibility_hidden=yes ]) CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" @@ -2087,7 +2027,6 @@ dnl # preprocessing tests use only CPPFLAGS. AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [ AC_DEFINE(MODULE_SCOPE, [extern], [No Compiler support for module scope symbols]) - AC_DEFINE(NO_VIZ, [], [No visibility attribute]) ]) AS_IF([test "$SHARED_LIB_SUFFIX" = ""], [ @@ -2191,124 +2130,6 @@ dnl # preprocessing tests use only CPPFLAGS. ]) #-------------------------------------------------------------------- -# SC_SERIAL_PORT -# -# Determine which interface to use to talk to the serial port. -# Note that #include lines must begin in leftmost column for -# some compilers to recognize them as preprocessor directives, -# and some build environments have stdin not pointing at a -# pseudo-terminal (usually /dev/null instead.) -# -# Arguments: -# none -# -# Results: -# -# Defines only one of the following vars: -# HAVE_SYS_MODEM_H -# USE_TERMIOS -# USE_TERMIO -# USE_SGTTY -# -#-------------------------------------------------------------------- - -AC_DEFUN([SC_SERIAL_PORT], [ - AC_CHECK_HEADERS(sys/modem.h) - AC_CACHE_CHECK([termios vs. termio vs. sgtty], tcl_cv_api_serial, [ - AC_TRY_RUN([ -#include <termios.h> - -int main() { - struct termios t; - if (tcgetattr(0, &t) == 0) { - cfsetospeed(&t, 0); - t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB; - return 0; - } - return 1; -}], tcl_cv_api_serial=termios, tcl_cv_api_serial=no, tcl_cv_api_serial=no) - if test $tcl_cv_api_serial = no ; then - AC_TRY_RUN([ -#include <termio.h> - -int main() { - struct termio t; - if (ioctl(0, TCGETA, &t) == 0) { - t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB; - return 0; - } - return 1; -}], tcl_cv_api_serial=termio, tcl_cv_api_serial=no, tcl_cv_api_serial=no) - fi - if test $tcl_cv_api_serial = no ; then - AC_TRY_RUN([ -#include <sgtty.h> - -int main() { - struct sgttyb t; - if (ioctl(0, TIOCGETP, &t) == 0) { - t.sg_ospeed = 0; - t.sg_flags |= ODDP | EVENP | RAW; - return 0; - } - return 1; -}], tcl_cv_api_serial=sgtty, tcl_cv_api_serial=no, tcl_cv_api_serial=no) - fi - if test $tcl_cv_api_serial = no ; then - AC_TRY_RUN([ -#include <termios.h> -#include <errno.h> - -int main() { - struct termios t; - if (tcgetattr(0, &t) == 0 - || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { - cfsetospeed(&t, 0); - t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB; - return 0; - } - return 1; -}], tcl_cv_api_serial=termios, tcl_cv_api_serial=no, tcl_cv_api_serial=no) - fi - if test $tcl_cv_api_serial = no; then - AC_TRY_RUN([ -#include <termio.h> -#include <errno.h> - -int main() { - struct termio t; - if (ioctl(0, TCGETA, &t) == 0 - || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { - t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB; - return 0; - } - return 1; - }], tcl_cv_api_serial=termio, tcl_cv_api_serial=no, tcl_cv_api_serial=no) - fi - if test $tcl_cv_api_serial = no; then - AC_TRY_RUN([ -#include <sgtty.h> -#include <errno.h> - -int main() { - struct sgttyb t; - if (ioctl(0, TIOCGETP, &t) == 0 - || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { - t.sg_ospeed = 0; - t.sg_flags |= ODDP | EVENP | RAW; - return 0; - } - return 1; -}], tcl_cv_api_serial=sgtty, tcl_cv_api_serial=none, tcl_cv_api_serial=none) - fi]) - case $tcl_cv_api_serial in - termios) AC_DEFINE(USE_TERMIOS, 1, [Use the termios API for serial lines]);; - termio) AC_DEFINE(USE_TERMIO, 1, [Use the termio API for serial lines]);; - sgtty) AC_DEFINE(USE_SGTTY, 1, [Use the sgtty API for serial lines]);; - esac -]) - -#-------------------------------------------------------------------- # SC_MISSING_POSIX_HEADERS # # Supply substitutes for missing POSIX header files. Special @@ -2420,9 +2241,9 @@ AC_DEFUN([SC_PATH_X], [ not_really_there="" if test "$no_x" = ""; then if test "$x_includes" = ""; then - AC_TRY_CPP([#include <X11/XIntrinsic.h>], , not_really_there="yes") + AC_TRY_CPP([#include <X11/Xlib.h>], , not_really_there="yes") else - if test ! -r $x_includes/X11/Intrinsic.h; then + if test ! -r $x_includes/X11/Xlib.h; then not_really_there="yes" fi fi @@ -2430,11 +2251,11 @@ AC_DEFUN([SC_PATH_X], [ if test "$no_x" = "yes" -o "$not_really_there" = "yes"; then AC_MSG_CHECKING([for X11 header files]) found_xincludes="no" - AC_TRY_CPP([#include <X11/Intrinsic.h>], found_xincludes="yes", found_xincludes="no") + AC_TRY_CPP([#include <X11/Xlib.h>], found_xincludes="yes", found_xincludes="no") if test "$found_xincludes" = "no"; then dirs="/usr/unsupported/include /usr/local/include /usr/X386/include /usr/X11R6/include /usr/X11R5/include /usr/include/X11R5 /usr/include/X11R4 /usr/openwin/include /usr/X11/include /usr/sww/include" for i in $dirs ; do - if test -r $i/X11/Intrinsic.h; then + if test -r $i/X11/Xlib.h; then AC_MSG_RESULT([$i]) XINCLUDES=" -I$i" found_xincludes="yes" @@ -2805,7 +2626,7 @@ AC_DEFUN([SC_TCL_64BIT_FLAGS], [ # Now check for auxiliary declarations AC_CACHE_CHECK([for struct dirent64], tcl_cv_struct_dirent64,[ AC_TRY_COMPILE([#include <sys/types.h> -#include <sys/dirent.h>],[struct dirent64 p;], +#include <dirent.h>],[struct dirent64 p;], tcl_cv_struct_dirent64=yes,tcl_cv_struct_dirent64=no)]) if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then AC_DEFINE(HAVE_STRUCT_DIRENT64, 1, [Is 'struct dirent64' in <sys/types.h>?]) diff --git a/unix/tcl.spec b/unix/tcl.spec index 27f7189..678222c 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -4,7 +4,7 @@ Name: tcl Summary: Tcl scripting language development environment -Version: 8.6.0 +Version: 8.6.1 Release: 2 License: BSD Group: Development/Languages diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index 159bbd8..9bbc88b 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -22,14 +22,14 @@ extern Tcl_PackageInitProc Tcltest_SafeInit; #endif /* TCL_TEST */ #ifdef TCL_XT_TEST -extern void XtToolkitInitialize(void); -extern int Tclxttest_Init(Tcl_Interp *interp); -#endif +extern void XtToolkitInitialize(void); +extern Tcl_PackageInitProc Tclxttest_Init; +#endif /* TCL_XT_TEST */ /* * The following #if block allows you to change the AppInit function by using * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The - * #if checks for that #define and uses Tcl_AppInit if it doesn't exist. + * #if checks for that #define and uses Tcl_AppInit if it does not exist. */ #ifndef TCL_LOCAL_APPINIT @@ -48,7 +48,7 @@ MODULE_SCOPE int main(int, char **); */ #ifdef TCL_LOCAL_MAIN_HOOK -extern int TCL_LOCAL_MAIN_HOOK(int *argc, char ***argv); +MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, char ***argv); #endif /* @@ -71,7 +71,7 @@ extern int TCL_LOCAL_MAIN_HOOK(int *argc, char ***argv); int main( int argc, /* Number of command-line arguments. */ - char **argv) /* Values of command-line arguments. */ + char *argv[]) /* Values of command-line arguments. */ { #ifdef TCL_XT_TEST XtToolkitInitialize(); @@ -145,14 +145,16 @@ Tcl_AppInit( /* * Specify a user-specific startup file to invoke if the application is * run interactively. Typically the startup file is "~/.apprc" where "app" - * is the name of the application. If this line is deleted then no user- - * specific startup file will be run under any conditions. + * is the name of the application. If this line is deleted then no + * user-specific startup file will be run under any conditions. */ #ifdef DJGPP - (Tcl_SetVar)(interp, "tcl_rcFileName", "~/tclsh.rc", TCL_GLOBAL_ONLY); + (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL, + Tcl_NewStringObj("~/tclsh.rc", -1), TCL_GLOBAL_ONLY); #else - (Tcl_SetVar)(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY); + (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL, + Tcl_NewStringObj("~/.tclshrc", -1), TCL_GLOBAL_ONLY); #endif return TCL_OK; diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in index f171cce..e55dcd0 100644 --- a/unix/tclConfig.h.in +++ b/unix/tclConfig.h.in @@ -115,6 +115,9 @@ /* Define to 1 if you have the `gmtime_r' function. */ #undef HAVE_GMTIME_R +/* Compiler support for module scope symbols */ +#undef HAVE_HIDDEN + /* Do we have the intptr_t type? */ #undef HAVE_INTPTR_T @@ -241,6 +244,9 @@ /* Define to 1 if you have the <sys/types.h> header file. */ #undef HAVE_SYS_TYPES_H +/* Define to 1 if you have the <termios.h> header file. */ +#undef HAVE_TERMIOS_H + /* Should we use the global timezone variable? */ #undef HAVE_TIMEZONE_VAR @@ -340,9 +346,6 @@ /* Do we have <values.h>? */ #undef NO_VALUES_H -/* No visibility attribute */ -#undef NO_VIZ - /* Do we have wait3() */ #undef NO_WAIT3 @@ -433,15 +436,6 @@ /* Should we use FIONBIO? */ #undef USE_FIONBIO -/* Use the sgtty API for serial lines */ -#undef USE_SGTTY - -/* Use the termio API for serial lines */ -#undef USE_TERMIO - -/* Use the termios API for serial lines */ -#undef USE_TERMIOS - /* Do we want to use the threaded memory allocator? */ #undef USE_THREAD_ALLOC diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index 9ee37f1..fdc9d1d 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -14,16 +14,9 @@ #include "tclInt.h" /* Internal definitions for Tcl. */ #include "tclIO.h" /* To get Channel type declaration. */ -#define SUPPORTS_TTY - -#undef DIRECT_BAUD -#ifdef B4800 -# if (B4800 == 4800) -# define DIRECT_BAUD -# endif /* B4800 == 4800 */ -#endif /* B4800 */ - -#ifdef USE_TERMIOS +#undef SUPPORTS_TTY +#if defined(HAVE_TERMIOS_H) +# define SUPPORTS_TTY 1 # include <termios.h> # ifdef HAVE_SYS_IOCTL_H # include <sys/ioctl.h> @@ -31,60 +24,29 @@ # ifdef HAVE_SYS_MODEM_H # include <sys/modem.h> # endif /* HAVE_SYS_MODEM_H */ -# define IOSTATE struct termios -# define GETIOSTATE(fd, statePtr) tcgetattr((fd), (statePtr)) -# define SETIOSTATE(fd, statePtr) tcsetattr((fd), TCSADRAIN, (statePtr)) -# define GETCONTROL(fd, intPtr) ioctl((fd), TIOCMGET, (intPtr)) -# define SETCONTROL(fd, intPtr) ioctl((fd), TIOCMSET, (intPtr)) # ifdef FIONREAD # define GETREADQUEUE(fd, int) ioctl((fd), FIONREAD, &(int)) # elif defined(FIORDCHK) # define GETREADQUEUE(fd, int) int = ioctl((fd), FIORDCHK, NULL) -# endif /* FIONREAD */ +# else +# define GETREADQUEUE(fd, int) int = 0 +# endif + # ifdef TIOCOUTQ # define GETWRITEQUEUE(fd, int) ioctl((fd), TIOCOUTQ, &(int)) -# endif /* TIOCOUTQ */ -# if defined(TIOCSBRK) && defined(TIOCCBRK) - -/* - * Can't use ?: operator below because that messes up types on either Linux or - * Solaris (the two are mutually exclusive!) - */ +# else +# define GETWRITEQUEUE(fd, int) int = 0 +# endif -# define SETBREAK(fd, flag) \ - if (flag) { \ - ioctl((fd), TIOCSBRK, NULL); \ - } else { \ - ioctl((fd), TIOCCBRK, NULL); \ - } -# endif /* TIOCSBRK&TIOCCBRK */ # if !defined(CRTSCTS) && defined(CNEW_RTSCTS) # define CRTSCTS CNEW_RTSCTS # endif /* !CRTSCTS&CNEW_RTSCTS */ # if !defined(PAREXT) && defined(CMSPAR) # define PAREXT CMSPAR # endif /* !PAREXT&&CMSPAR */ -#else /* !USE_TERMIOS */ - -#ifdef USE_TERMIO -# include <termio.h> -# define IOSTATE struct termio -# define GETIOSTATE(fd, statePtr) ioctl((fd), TCGETA, (statePtr)) -# define SETIOSTATE(fd, statePtr) ioctl((fd), TCSETAW, (statePtr)) -#else /* !USE_TERMIO */ - -#ifdef USE_SGTTY -# include <sgtty.h> -# define IOSTATE struct sgttyb -# define GETIOSTATE(fd, statePtr) ioctl((fd), TIOCGETP, (statePtr)) -# define SETIOSTATE(fd, statePtr) ioctl((fd), TIOCSETP, (statePtr)) -#else /* !USE_SGTTY */ -# undef SUPPORTS_TTY -#endif /* !USE_SGTTY */ - -#endif /* !USE_TERMIO */ -#endif /* !USE_TERMIOS */ + +#endif /* HAVE_TERMIOS_H */ /* * Helper macros to make parts of this file clearer. The macros do exactly @@ -110,18 +72,6 @@ typedef struct FileState { #ifdef SUPPORTS_TTY /* - * The following structure describes per-instance state of a tty-based - * channel. - */ - -typedef struct TtyState { - FileState fs; /* Per-instance state of the file descriptor. - * Must be the first field. */ - IOSTATE savedState; /* Initial state of device. Used to reset - * state when device closed. */ -} TtyState; - -/* * The following structure is used to set or get the serial port attributes in * a platform-independant manner. */ @@ -167,15 +117,12 @@ static void TtyGetAttributes(int fd, TtyAttrs *ttyPtr); static int TtyGetOptionProc(ClientData instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); -#ifndef DIRECT_BAUD -static int TtyGetBaud(unsigned long speed); -static unsigned long TtyGetSpeed(int baud); -#endif /* DIRECT_BAUD */ -static FileState * TtyInit(int fd, int initialize); +static int TtyGetBaud(speed_t speed); +static speed_t TtyGetSpeed(int baud); +static void TtyInit(int fd); static void TtyModemStatusStr(int status, Tcl_DString *dsPtr); static int TtyParseMode(Tcl_Interp *interp, const char *mode, - int *speedPtr, int *parityPtr, int *dataPtr, - int *stopPtr); + TtyAttrs *ttyPtr); static void TtySetAttributes(int fd, TtyAttrs *ttyPtr); static int TtySetOptionProc(ClientData instanceData, Tcl_Interp *interp, const char *optionName, @@ -573,7 +520,6 @@ FileGetHandleProc( } #ifdef SUPPORTS_TTY -#ifdef USE_TERMIOS /* *---------------------------------------------------------------------- * @@ -606,7 +552,6 @@ TtyModemStatusStr( Tcl_DStringAppendElement(dsPtr, (status & TIOCM_CD) ? "1" : "0"); #endif /* TIOCM_CD */ } -#endif /* USE_TERMIOS */ /* *---------------------------------------------------------------------- @@ -636,11 +581,9 @@ TtySetOptionProc( FileState *fsPtr = instanceData; unsigned int len, vlen; TtyAttrs tty; -#ifdef USE_TERMIOS - int flag, control, argc; + int argc; const char **argv; - IOSTATE iostate; -#endif /* USE_TERMIOS */ + struct termios iostate; len = strlen(optionName); vlen = strlen(value); @@ -650,8 +593,7 @@ TtySetOptionProc( */ if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) { - if (TtyParseMode(interp, value, &tty.baud, &tty.parity, &tty.data, - &tty.stop) != TCL_OK) { + if (TtyParseMode(interp, value, &tty) != TCL_OK) { return TCL_ERROR; } @@ -663,7 +605,6 @@ TtySetOptionProc( return TCL_OK; } -#ifdef USE_TERMIOS /* * Option -handshake none|xonxoff|rtscts|dtrdsr @@ -674,25 +615,25 @@ TtySetOptionProc( * Reset all handshake options. DTR and RTS are ON by default. */ - GETIOSTATE(fsPtr->fd, &iostate); + tcgetattr(fsPtr->fd, &iostate); CLEAR_BITS(iostate.c_iflag, IXON | IXOFF | IXANY); #ifdef CRTSCTS CLEAR_BITS(iostate.c_cflag, CRTSCTS); #endif /* CRTSCTS */ - if (strncasecmp(value, "NONE", vlen) == 0) { + if (Tcl_UtfNcasecmp(value, "NONE", vlen) == 0) { /* * Leave all handshake options disabled. */ - } else if (strncasecmp(value, "XONXOFF", vlen) == 0) { + } else if (Tcl_UtfNcasecmp(value, "XONXOFF", vlen) == 0) { SET_BITS(iostate.c_iflag, IXON | IXOFF | IXANY); - } else if (strncasecmp(value, "RTSCTS", vlen) == 0) { + } else if (Tcl_UtfNcasecmp(value, "RTSCTS", vlen) == 0) { #ifdef CRTSCTS SET_BITS(iostate.c_cflag, CRTSCTS); #else /* !CRTSTS */ UNSUPPORTED_OPTION("-handshake RTSCTS"); return TCL_ERROR; #endif /* CRTSCTS */ - } else if (strncasecmp(value, "DTRDSR", vlen) == 0) { + } else if (Tcl_UtfNcasecmp(value, "DTRDSR", vlen) == 0) { UNSUPPORTED_OPTION("-handshake DTRDSR"); return TCL_ERROR; } else { @@ -705,7 +646,7 @@ TtySetOptionProc( } return TCL_ERROR; } - SETIOSTATE(fsPtr->fd, &iostate); + tcsetattr(fsPtr->fd, TCSADRAIN, &iostate); return TCL_OK; } @@ -730,7 +671,7 @@ TtySetOptionProc( return TCL_ERROR; } - GETIOSTATE(fsPtr->fd, &iostate); + tcgetattr(fsPtr->fd, &iostate); Tcl_UtfToExternalDString(NULL, argv[0], -1, &ds); iostate.c_cc[VSTART] = *(const cc_t *) Tcl_DStringValue(&ds); @@ -741,7 +682,7 @@ TtySetOptionProc( Tcl_DStringFree(&ds); ckfree(argv); - SETIOSTATE(fsPtr->fd, &iostate); + tcsetattr(fsPtr->fd, TCSADRAIN, &iostate); return TCL_OK; } @@ -752,22 +693,22 @@ TtySetOptionProc( if ((len > 2) && (strncmp(optionName, "-timeout", len) == 0)) { int msec; - GETIOSTATE(fsPtr->fd, &iostate); + tcgetattr(fsPtr->fd, &iostate); 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; - SETIOSTATE(fsPtr->fd, &iostate); + tcsetattr(fsPtr->fd, TCSADRAIN, &iostate); return TCL_OK; } /* * Option -ttycontrol {DTR 1 RTS 0 BREAK 0} */ - if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) { - int i; +#if defined(TIOCMGET) && defined(TIOCMSET) + int i, control, flag; if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; @@ -784,44 +725,36 @@ TtySetOptionProc( return TCL_ERROR; } - GETCONTROL(fsPtr->fd, &control); + ioctl(fsPtr->fd, TIOCMGET, &control); for (i = 0; i < argc-1; i += 2) { if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) { ckfree(argv); return TCL_ERROR; } - if (strncasecmp(argv[i], "DTR", strlen(argv[i])) == 0) { -#ifdef TIOCM_DTR + if (Tcl_UtfNcasecmp(argv[i], "DTR", strlen(argv[i])) == 0) { if (flag) { SET_BITS(control, TIOCM_DTR); } else { CLEAR_BITS(control, TIOCM_DTR); } -#else /* !TIOCM_DTR */ - UNSUPPORTED_OPTION("-ttycontrol DTR"); - ckfree(argv); - return TCL_ERROR; -#endif /* TIOCM_DTR */ - } else if (strncasecmp(argv[i], "RTS", strlen(argv[i])) == 0) { -#ifdef TIOCM_RTS + } else if (Tcl_UtfNcasecmp(argv[i], "RTS", strlen(argv[i])) == 0) { if (flag) { SET_BITS(control, TIOCM_RTS); } else { CLEAR_BITS(control, TIOCM_RTS); } -#else /* !TIOCM_RTS*/ - UNSUPPORTED_OPTION("-ttycontrol RTS"); - ckfree(argv); - return TCL_ERROR; -#endif /* TIOCM_RTS*/ - } else if (strncasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) { -#ifdef SETBREAK - SETBREAK(fsPtr->fd, flag); -#else /* !SETBREAK */ + } else if (Tcl_UtfNcasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) { +#if defined(TIOCSBRK) && defined(TIOCCBRK) + if (flag) { + ioctl(fsPtr->fd, TIOCSBRK, NULL); + } else { + ioctl(fsPtr->fd, TIOCCBRK, NULL); + } +#else /* TIOCSBRK & TIOCCBRK */ UNSUPPORTED_OPTION("-ttycontrol BREAK"); ckfree(argv); return TCL_ERROR; -#endif /* SETBREAK */ +#endif /* TIOCSBRK & TIOCCBRK */ } else { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -835,17 +768,16 @@ TtySetOptionProc( } } /* -ttycontrol options loop */ - SETCONTROL(fsPtr->fd, &control); + ioctl(fsPtr->fd, TIOCMSET, &control); ckfree(argv); return TCL_OK; +#else /* TIOCMGET&TIOCMSET */ + UNSUPPORTED_OPTION("-ttycontrol"); +#endif /* TIOCMGET&TIOCMSET */ } return Tcl_BadChannelOption(interp, optionName, "mode handshake timeout ttycontrol xchar"); - -#else /* !USE_TERMIOS */ - return Tcl_BadChannelOption(interp, optionName, "mode"); -#endif /* USE_TERMIOS */ } /* @@ -860,12 +792,8 @@ TtySetOptionProc( * * Results: * A standard Tcl result. Also sets the supplied DString to the string - * value of the option(s) returned. - * - * 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 - * needed (by calling Tcl_BadChannelOption). + * value of the option(s) returned. Sets error message if needed + * (by calling Tcl_BadChannelOption). * *---------------------------------------------------------------------- */ @@ -899,7 +827,6 @@ TtyGetOptionProc( Tcl_DStringAppendElement(dsPtr, buf); } -#ifdef USE_TERMIOS /* * Get option -xchar */ @@ -909,11 +836,11 @@ TtyGetOptionProc( Tcl_DStringStartSublist(dsPtr); } if (len==0 || (len>1 && strncmp(optionName, "-xchar", len)==0)) { - IOSTATE iostate; + struct termios iostate; Tcl_DString ds; valid = 1; - GETIOSTATE(fsPtr->fd, &iostate); + tcgetattr(fsPtr->fd, &iostate); Tcl_DStringInit(&ds); Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTART], 1, &ds); @@ -938,12 +865,8 @@ TtyGetOptionProc( int inQueue=0, outQueue=0, inBuffered, outBuffered; valid = 1; -#ifdef GETREADQUEUE GETREADQUEUE(fsPtr->fd, inQueue); -#endif /* GETREADQUEUE */ -#ifdef GETWRITEQUEUE GETWRITEQUEUE(fsPtr->fd, outQueue); -#endif /* GETWRITEQUEUE */ inBuffered = Tcl_InputBuffered(fsPtr->channel); outBuffered = Tcl_OutputBuffered(fsPtr->channel); @@ -953,37 +876,31 @@ TtyGetOptionProc( Tcl_DStringAppendElement(dsPtr, buf); } +#if defined(TIOCMGET) /* * 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); + ioctl(fsPtr->fd, TIOCMGET, &status); TtyModemStatusStr(status, dsPtr); } -#endif /* USE_TERMIOS */ +#endif /* TIOCMGET */ if (valid) { return TCL_OK; } return Tcl_BadChannelOption(interp, optionName, "mode" -#ifdef USE_TERMIOS " queue ttystatus xchar" -#endif /* USE_TERMIOS */ ); } -#ifdef DIRECT_BAUD -# define TtyGetSpeed(baud) ((unsigned) (baud)) -# define TtyGetBaud(speed) ((int) (speed)) -#else /* !DIRECT_BAUD */ -static const struct {int baud; unsigned long speed;} speeds[] = { +static const struct {int baud; speed_t speed;} speeds[] = { #ifdef B0 {0, B0}, #endif @@ -1079,20 +996,16 @@ static const struct {int baud; unsigned long speed;} speeds[] = { * * TtyGetSpeed -- * - * Given a baud rate, get the mask value that should be stored in the - * termios, termio, or sgttyb structure in order to select that baud - * rate. + * Given an integer baud rate, get the speed_t value that should be + * used to select that baud rate. * * Results: * As above. * - * Side effects: - * None. - * *--------------------------------------------------------------------------- */ -static unsigned long +static speed_t TtyGetSpeed( int baud) /* The baud rate to look up. */ { @@ -1125,21 +1038,17 @@ TtyGetSpeed( * * TtyGetBaud -- * - * Given a speed mask value from a termios, termio, or sgttyb structure, - * get the baus rate that corresponds to that mask value. + * Return the integer baud rate corresponding to a given speed_t value. * * Results: * As above. If the mask value was not recognized, 0 is returned. * - * Side effects: - * None. - * *--------------------------------------------------------------------------- */ static int TtyGetBaud( - unsigned long speed) /* Speed mask value to look up. */ + speed_t speed) /* Speed mask value to look up. */ { int i; @@ -1150,7 +1059,6 @@ TtyGetBaud( } return 0; } -#endif /* !DIRECT_BAUD */ /* *--------------------------------------------------------------------------- @@ -1175,12 +1083,11 @@ TtyGetAttributes( TtyAttrs *ttyPtr) /* Buffer filled with serial port * attributes. */ { - IOSTATE iostate; + struct termios iostate; int baud, parity, data, stop; - GETIOSTATE(fd, &iostate); + tcgetattr(fd, &iostate); -#ifdef USE_TERMIOS baud = TtyGetBaud(cfgetospeed(&iostate)); parity = 'n'; @@ -1202,39 +1109,6 @@ TtyGetAttributes( data = (data == CS5) ? 5 : (data == CS6) ? 6 : (data == CS7) ? 7 : 8; stop = (iostate.c_cflag & CSTOPB) ? 2 : 1; -#endif /* USE_TERMIOS */ - -#ifdef USE_TERMIO - baud = TtyGetBaud(iostate.c_cflag & CBAUD); - - parity = 'n'; - switch (iostate.c_cflag & (PARENB | PARODD | PAREXT)) { - case PARENB : parity = 'e'; break; - case PARENB | PARODD : parity = 'o'; break; - case PARENB | PAREXT : parity = 's'; break; - case PARENB | PARODD | PAREXT : parity = 'm'; break; - } - - data = iostate.c_cflag & CSIZE; - data = (data == CS5) ? 5 : (data == CS6) ? 6 : (data == CS7) ? 7 : 8; - - stop = (iostate.c_cflag & CSTOPB) ? 2 : 1; -#endif /* USE_TERMIO */ - -#ifdef USE_SGTTY - baud = TtyGetBaud(iostate.sg_ospeed); - - parity = 'n'; - if (iostate.sg_flags & EVENP) { - parity = 'e'; - } else if (iostate.sg_flags & ODDP) { - parity = 'o'; - } - - data = (iostate.sg_flags & (EVENP | ODDP)) ? 7 : 8; - - stop = 1; -#endif /* USE_SGTTY */ ttyPtr->baud = baud; ttyPtr->parity = parity; @@ -1265,12 +1139,10 @@ TtySetAttributes( TtyAttrs *ttyPtr) /* Buffer containing new attributes for serial * port. */ { - IOSTATE iostate; - -#ifdef USE_TERMIOS + struct termios iostate; int parity, data, flag; - GETIOSTATE(fd, &iostate); + tcgetattr(fd, &iostate); cfsetospeed(&iostate, TtyGetSpeed(ttyPtr->baud)); cfsetispeed(&iostate, TtyGetSpeed(ttyPtr->baud)); @@ -1300,58 +1172,7 @@ TtySetAttributes( CLEAR_BITS(iostate.c_cflag, PARENB | PARODD | CSIZE | CSTOPB); SET_BITS(iostate.c_cflag, flag); -#endif /* USE_TERMIOS */ - -#ifdef USE_TERMIO - int parity, data, flag; - - GETIOSTATE(fd, &iostate); - CLEAR_BITS(iostate.c_cflag, CBAUD); - SET_BITS(iostate.c_cflag, TtyGetSpeed(ttyPtr->baud)); - - flag = 0; - parity = ttyPtr->parity; - if (parity != 'n') { - SET_BITS(flag, PARENB); - if ((parity == 'm') || (parity == 's')) { - SET_BITS(flag, PAREXT); - } - if ((parity == 'm') || (parity == 'o')) { - SET_BITS(flag, PARODD); - } - } - data = ttyPtr->data; - SET_BITS(flag, - (data == 5) ? CS5 : - (data == 6) ? CS6 : - (data == 7) ? CS7 : CS8); - if (ttyPtr->stop == 2) { - SET_BITS(flag, CSTOPB); - } - - CLEAR_BITS(iostate.c_cflag, PARENB | PARODD | PAREXT | CSIZE | CSTOPB); - SET_BITS(iostate.c_cflag, flag); - -#endif /* USE_TERMIO */ - -#ifdef USE_SGTTY - int parity; - - GETIOSTATE(fd, &iostate); - iostate.sg_ospeed = TtyGetSpeed(ttyPtr->baud); - iostate.sg_ispeed = TtyGetSpeed(ttyPtr->baud); - - parity = ttyPtr->parity; - if (parity == 'e') { - CLEAR_BITS(iostate.sg_flags, ODDP); - SET_BITS(iostate.sg_flags, EVENP); - } else if (parity == 'o') { - CLEAR_BITS(iostate.sg_flags, EVENP); - SET_BITS(iostate.sg_flags, ODDP); - } -#endif /* USE_SGTTY */ - - SETIOSTATE(fd, &iostate); + tcsetattr(fd, TCSADRAIN, &iostate); } /* @@ -1367,9 +1188,6 @@ TtySetAttributes( * TCL_ERROR otherwise. If TCL_ERROR is returned, an error message is * left in the interp's result (if interp is non-NULL). * - * Side effects: - * None. - * *--------------------------------------------------------------------------- */ @@ -1377,17 +1195,17 @@ static int TtyParseMode( Tcl_Interp *interp, /* If non-NULL, interp for error return. */ const char *mode, /* Mode string to be parsed. */ - int *speedPtr, /* Filled with baud rate from mode string. */ - int *parityPtr, /* Filled with parity from mode string. */ - int *dataPtr, /* Filled with data bits from mode string. */ - int *stopPtr) /* Filled with stop bits from mode string. */ + TtyAttrs *ttyPtr) /* Filled with data from mode string */ { int i, end; char parity; - static const char *bad = "bad value for -mode"; + const char *bad = "bad value for -mode"; - i = sscanf(mode, "%d,%c,%d,%d%n", speedPtr, &parity, dataPtr, - stopPtr, &end); + i = sscanf(mode, "%d,%c,%d,%d%n", + &ttyPtr->baud, + &parity, + &ttyPtr->data, + &ttyPtr->stop, &end); if ((i != 4) || (mode[end] != '\0')) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -1407,27 +1225,27 @@ TtyParseMode( */ if ( -#if defined(PAREXT) || defined(USE_TERMIO) +#if defined(PAREXT) strchr("noems", parity) #else strchr("noe", parity) -#endif /* PAREXT|USE_TERMIO */ +#endif /* PAREXT */ == NULL) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s parity: should be %s", bad, -#if defined(PAREXT) || defined(USE_TERMIO) +#if defined(PAREXT) "n, o, e, m, or s" #else "n, o, or e" -#endif /* PAREXT|USE_TERMIO */ +#endif /* PAREXT */ )); Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL); } return TCL_ERROR; } - *parityPtr = parity; - if ((*dataPtr < 5) || (*dataPtr > 8)) { + ttyPtr->parity = parity; + if ((ttyPtr->data < 5) || (ttyPtr->data > 8)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s data: should be 5, 6, 7, or 8", bad)); @@ -1435,7 +1253,7 @@ TtyParseMode( } return TCL_ERROR; } - if ((*stopPtr < 0) || (*stopPtr > 2)) { + if ((ttyPtr->stop < 0) || (ttyPtr->stop > 2)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s stop: should be 1 or 2", bad)); @@ -1453,71 +1271,38 @@ 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. - * - * Results: - * A pointer to a FileState suitable for use with Tcl_CreateChannel and - * the ttyChannelType structure. + * located on the serial port. * * 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 - * top of this in Tcl. + * All other modes can be simulated on top of this in Tcl. * *--------------------------------------------------------------------------- */ -static FileState * +static void TtyInit( - int fd, /* Open file descriptor for serial port to be - * initialized. */ - int initialize) + int fd) /* Open file descriptor for serial port to be initialized. */ { - TtyState *ttyPtr = ckalloc(sizeof(TtyState)); - int stateUpdated = 0; - - GETIOSTATE(fd, &ttyPtr->savedState); - if (initialize) { - IOSTATE iostate = ttyPtr->savedState; - -#if defined(USE_TERMIOS) || defined(USE_TERMIO) - if (iostate.c_iflag != IGNBRK - || iostate.c_oflag != 0 - || iostate.c_lflag != 0 - || iostate.c_cflag & CREAD - || iostate.c_cc[VMIN] != 1 - || iostate.c_cc[VTIME] != 0) { - stateUpdated = 1; - } + struct termios iostate; + tcgetattr(fd, &iostate); + + if (iostate.c_iflag != IGNBRK + || iostate.c_oflag != 0 + || iostate.c_lflag != 0 + || iostate.c_cflag & CREAD + || iostate.c_cc[VMIN] != 1 + || iostate.c_cc[VTIME] != 0) + { iostate.c_iflag = IGNBRK; iostate.c_oflag = 0; iostate.c_lflag = 0; - SET_BITS(iostate.c_cflag, CREAD); + iostate.c_cflag |= CREAD; iostate.c_cc[VMIN] = 1; iostate.c_cc[VTIME] = 0; -#endif /* USE_TERMIOS|USE_TERMIO */ - -#ifdef USE_SGTTY - if ((iostate.sg_flags & (EVENP | ODDP)) - || !(iostate.sg_flags & RAW)) { - ttyPtr->stateUpdated = 1; - } - iostate.sg_flags &= EVENP | ODDP; - SET_BITS(iostate.sg_flags, RAW); -#endif /* USE_SGTTY */ - - /* - * Only update if we're changing anything to avoid possible blocking. - */ - if (stateUpdated) { - SETIOSTATE(fd, &iostate); - } + tcsetattr(fd, TCSADRAIN, &iostate); } - - return &ttyPtr->fs; } #endif /* SUPPORTS_TTY */ @@ -1621,15 +1406,15 @@ TclpOpenFileChannel( translation = "auto crlf"; channelTypePtr = &ttyChannelType; - fsPtr = TtyInit(fd, 1); + TtyInit(fd); } else #endif /* SUPPORTS_TTY */ { translation = NULL; channelTypePtr = &fileChannelType; - fsPtr = ckalloc(sizeof(FileState)); } + fsPtr = ckalloc(sizeof(FileState)); fsPtr->validMask = channelPermissions | TCL_EXCEPTION; fsPtr->fd = fd; @@ -1692,7 +1477,6 @@ Tcl_MakeFileChannel( #ifdef SUPPORTS_TTY if (isatty(fd)) { - fsPtr = TtyInit(fd, 0); channelTypePtr = &ttyChannelType; sprintf(channelName, "serial%d", fd); } else @@ -1703,10 +1487,10 @@ Tcl_MakeFileChannel( return TclpMakeTcpClientChannelMode(INT2PTR(fd), mode); } else { channelTypePtr = &fileChannelType; - fsPtr = ckalloc(sizeof(FileState)); sprintf(channelName, "file%d", fd); } + fsPtr = ckalloc(sizeof(FileState)); fsPtr->fd = fd; fsPtr->validMask = mode | TCL_EXCEPTION; fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName, diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c index e201018..2a68f7f 100644 --- a/unix/tclUnixCompat.c +++ b/unix/tclUnixCompat.c @@ -995,12 +995,19 @@ TclWinCPUID( /* See: <http://en.wikipedia.org/wiki/CPUID> */ #if defined(HAVE_CPUID) - __asm__ __volatile__("mov %%ebx, %%edi \n\t" /* save %ebx */ +#if defined(__x86_64__) || defined(_M_AMD64) || defined (_M_X64) + __asm__ __volatile__("movq %%rbx, %%rsi \n\t" /* save %rbx */ "cpuid \n\t" - "mov %%ebx, %%esi \n\t" /* save what cpuid just put in %ebx */ - "mov %%edi, %%ebx \n\t" /* restore the old %ebx */ + "xchgq %%rsi, %%rbx \n\t" /* restore the old %rbx */ : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) - : "a"(index) : "edi"); + : "a"(index)); +#else + __asm__ __volatile__("mov %%ebx, %%esi \n\t" /* save %ebx */ + "cpuid \n\t" + "xchg %%esi, %%ebx \n\t" /* restore the old %ebx */ + : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) + : "a"(index)); +#endif status = TCL_OK; #endif return status; diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index 559992f..e270b6a 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -244,7 +244,7 @@ MODULE_SCOPE long tclMacOSXDarwinRelease; #endif /* NO_REALPATH */ #ifdef HAVE_FTS -#ifdef HAVE_STRUCT_STAT64 +#if defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__) /* fts doesn't do stat64 */ # define noFtsStat 1 #elif defined(__APPLE__) && defined(__LP64__) && \ @@ -462,10 +462,10 @@ DoCopyFile( switch ((int) (statBufPtr->st_mode & S_IFMT)) { #ifndef DJGPP case S_IFLNK: { - char linkBuf[MAXPATHLEN]; + char linkBuf[MAXPATHLEN+1]; int length; - length = readlink(src, linkBuf, sizeof(linkBuf)); + length = readlink(src, linkBuf, MAXPATHLEN); /* INTL: Native. */ if (length == -1) { return TCL_ERROR; @@ -2226,13 +2226,13 @@ DefaultTempDir(void) dir = getenv("TMPDIR"); if (dir && dir[0] && stat(dir, &buf) == 0 && S_ISDIR(buf.st_mode) - && access(dir, W_OK)) { + && access(dir, W_OK) == 0) { return dir; } #ifdef P_tmpdir dir = P_tmpdir; - if (stat(dir, &buf) == 0 && S_ISDIR(buf.st_mode) && access(dir, W_OK)) { + if (stat(dir, &buf)==0 && S_ISDIR(buf.st_mode) && access(dir, W_OK)==0) { return dir; } #endif diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 38504d9..5bfe5d9 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -1181,9 +1181,10 @@ TclpUtime( int TclOSstat( const char *name, - Tcl_StatBuf *statBuf) + void *cygstat) { struct stat buf; + Tcl_StatBuf *statBuf = cygstat; int result = stat(name, &buf); statBuf->st_mode = buf.st_mode; @@ -1203,9 +1204,10 @@ TclOSstat( int TclOSlstat( const char *name, - Tcl_StatBuf *statBuf) + void *cygstat) { struct stat buf; + Tcl_StatBuf *statBuf = cygstat; int result = lstat(name, &buf); statBuf->st_mode = buf.st_mode; diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c index b87af1b..b234667 100644 --- a/unix/tclUnixNotfy.c +++ b/unix/tclUnixNotfy.c @@ -96,7 +96,7 @@ typedef struct ThreadSpecificData { * that an event is ready to be processed * by sending this event. */ void *hwnd; /* Messaging window. */ -#else +#else /* !__CYGWIN__ */ Tcl_Condition waitCV; /* Any other thread alerts a notifier that an * event is ready to be processed by signaling * this condition variable. */ @@ -120,6 +120,15 @@ static Tcl_ThreadDataKey dataKey; static int notifierCount = 0; /* + * The following static stores the process ID of the initialized notifier + * thread. If it changes, we have passed a fork and we should start a new + * notifier thread. + * + * You must hold the notifierMutex lock before accessing this variable. + */ +static pid_t processIDInitialized = 0; + +/* * The following variable points to the head of a doubly-linked list of * ThreadSpecificData structures for all threads that are currently waiting on * an event. @@ -184,9 +193,15 @@ static Tcl_ThreadId notifierThread; */ #ifdef TCL_THREADS -static void NotifierThreadProc(ClientData clientData); -#endif -static int FileHandlerEventProc(Tcl_Event *evPtr, int flags); +static void NotifierThreadProc(ClientData clientData); +#if defined(HAVE_PTHREAD_ATFORK) && !defined(__APPLE__) && !defined(__hpux) +static int atForkInit = 0; +static void AtForkPrepare(void); +static void AtForkParent(void); +static void AtForkChild(void); +#endif /* HAVE_PTHREAD_ATFORK */ +#endif /* TCL_THREADS */ +static int FileHandlerEventProc(Tcl_Event *evPtr, int flags); /* * Import of Windows API when building threaded with Cygwin. @@ -213,14 +228,14 @@ typedef struct { void *hCursor; void *hbrBackground; void *lpszMenuName; - void *lpszClassName; + const void *lpszClassName; } WNDCLASS; extern void __stdcall CloseHandle(void *); extern void *__stdcall CreateEventW(void *, unsigned char, unsigned char, void *); -extern void * __stdcall CreateWindowExW(void *, void *, void *, DWORD, int, - int, int, int, void *, void *, void *, void *); +extern void * __stdcall CreateWindowExW(void *, const void *, const void *, + DWORD, int, int, int, int, void *, void *, void *, void *); extern DWORD __stdcall DefWindowProcW(void *, int, void *, void *); extern unsigned char __stdcall DestroyWindow(void *); extern int __stdcall DispatchMessageW(const MSG *); @@ -275,11 +290,38 @@ Tcl_InitNotifier(void) */ Tcl_MutexLock(¬ifierMutex); +#if defined(HAVE_PTHREAD_ATFORK) && !defined(__APPLE__) && !defined(__hpux) + /* + * Install pthread_atfork handlers to reinitialize the notifier in the + * child of a fork. + */ + + if (!atForkInit) { + int result = pthread_atfork(AtForkPrepare, AtForkParent, AtForkChild); + + if (result) { + Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed"); + } + atForkInit = 1; + } +#endif /* HAVE_PTHREAD_ATFORK */ + /* + * Check if my process id changed, e.g. I was forked + * In this case, restart the notifier thread and close the + * pipe to the original notifier thread + */ + if (notifierCount > 0 && processIDInitialized != getpid()) { + notifierCount = 0; + processIDInitialized = 0; + close(triggerPipe); + triggerPipe = -1; + } if (notifierCount == 0) { if (TclpThreadCreate(¬ifierThread, NotifierThreadProc, NULL, TCL_THREAD_STACK_DEFAULT, TCL_THREAD_JOINABLE) != TCL_OK) { Tcl_Panic("Tcl_InitNotifier: unable to start notifier thread"); } + processIDInitialized = getpid(); } notifierCount++; @@ -1270,6 +1312,75 @@ NotifierThreadProc( TclpThreadExit(0); } + +#if defined(HAVE_PTHREAD_ATFORK) && !defined(__APPLE__) && !defined(__hpux) +/* + *---------------------------------------------------------------------- + * + * AtForkPrepare -- + * + * Lock the notifier in preparation for a fork. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +AtForkPrepare(void) +{ +} + +/* + *---------------------------------------------------------------------- + * + * AtForkParent -- + * + * Unlock the notifier in the parent after a fork. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +AtForkParent(void) +{ +} + +/* + *---------------------------------------------------------------------- + * + * AtForkChild -- + * + * Unlock and reinstall the notifier in the child after a fork. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +AtForkChild(void) +{ + notifierMutex = NULL; + notifierCV = NULL; + Tcl_InitNotifier(); +} +#endif /* HAVE_PTHREAD_ATFORK */ + #endif /* TCL_THREADS */ #endif /* !HAVE_COREFOUNDATION */ diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h index 63c500d..2ade1c0 100644 --- a/unix/tclUnixPort.h +++ b/unix/tclUnixPort.h @@ -21,10 +21,6 @@ #ifndef _TCLUNIXPORT #define _TCLUNIXPORT - -#ifndef MODULE_SCOPE -#define MODULE_SCOPE extern -#endif /* *--------------------------------------------------------------------------- @@ -89,26 +85,28 @@ typedef off_t Tcl_SeekOffset; # define SOCKET unsigned int # define WSAEWOULDBLOCK 10035 typedef unsigned short WCHAR; - DLLIMPORT extern __stdcall int GetModuleHandleExW(unsigned int, const char *, void *); - DLLIMPORT extern __stdcall int GetModuleFileNameW(void *, const char *, int); - DLLIMPORT extern __stdcall int WideCharToMultiByte(int, int, const char *, int, + __declspec(dllimport) extern __stdcall int GetModuleHandleExW(unsigned int, const char *, void *); + __declspec(dllimport) extern __stdcall int GetModuleFileNameW(void *, const char *, int); + __declspec(dllimport) extern __stdcall int WideCharToMultiByte(int, int, const char *, int, const char *, int, const char *, const char *); - DLLIMPORT extern __stdcall int MultiByteToWideChar(int, int, const char *, int, + __declspec(dllimport) extern __stdcall int MultiByteToWideChar(int, int, const char *, int, WCHAR *, int); - DLLIMPORT extern __stdcall void OutputDebugStringW(const WCHAR *); - DLLIMPORT extern __stdcall int IsDebuggerPresent(); + __declspec(dllimport) extern __stdcall void OutputDebugStringW(const WCHAR *); + __declspec(dllimport) extern __stdcall int IsDebuggerPresent(); - DLLIMPORT extern int cygwin_conv_path(int, const void *, void *, int); - DLLIMPORT extern int cygwin_conv_path_list(int, const void *, void *, int); + __declspec(dllimport) extern int cygwin_conv_path(int, const void *, void *, int); + __declspec(dllimport) extern int cygwin_conv_path_list(int, const void *, void *, int); # define USE_PUTENV 1 # define USE_PUTENV_FOR_UNSET 1 /* On Cygwin, the environment is imported from the Cygwin DLL. */ +#ifndef __x86_64__ # define environ __cygwin_environ + extern char **__cygwin_environ; +#endif # define timezone _timezone - DLLIMPORT extern char **__cygwin_environ; - MODULE_SCOPE int TclOSstat(const char *name, Tcl_StatBuf *statBuf); - MODULE_SCOPE int TclOSlstat(const char *name, Tcl_StatBuf *statBuf); -#elif defined(HAVE_STRUCT_STAT64) + extern int TclOSstat(const char *name, void *statBuf); + extern int TclOSlstat(const char *name, void *statBuf); +#elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__) # define TclOSstat stat64 # define TclOSlstat lstat64 #else @@ -126,9 +124,7 @@ typedef off_t Tcl_SeekOffset; #ifdef HAVE_SYS_SELECT_H # include <sys/select.h> #endif -#ifdef HAVE_SYS_STAT_H -# include <sys/stat.h> -#endif +#include <sys/stat.h> #if TIME_WITH_SYS_TIME # include <sys/time.h> # include <time.h> @@ -159,7 +155,7 @@ typedef off_t Tcl_SeekOffset; # include "../compat/unistd.h" #endif -MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode); +extern int TclUnixSetBlockingMode(int fd, int mode); #include <utime.h> @@ -319,7 +315,7 @@ MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode); #endif #ifdef GETTOD_NOT_DECLARED -MODULE_SCOPE int gettimeofday(struct timeval *tp, +extern int gettimeofday(struct timeval *tp, struct timezone *tzp); #endif @@ -584,19 +580,6 @@ extern char ** environ; /* *--------------------------------------------------------------------------- - * The termios configure test program relies on the configure script being run - * from a terminal, which is not the case e.g., when configuring from Xcode. - * Since termios is known to be present on all Mac OS X releases since 10.0, - * override the configure defines for serial API here. [Bug 497147] - *--------------------------------------------------------------------------- - */ - -# define USE_TERMIOS 1 -# undef USE_TERMIO -# undef USE_SGTTY - -/* - *--------------------------------------------------------------------------- * Include AvailabilityMacros.h here (when available) to ensure any symbolic * MAC_OS_X_VERSION_* constants passed on the command line are translated. *--------------------------------------------------------------------------- @@ -717,8 +700,6 @@ typedef int socklen_t; #ifdef TCL_THREADS # include <pthread.h> -# undef inet_ntoa -# define inet_ntoa(x) TclpInetNtoa(x) #endif /* TCL_THREADS */ /* FIXME - Hyper-enormous platform assumption! */ @@ -737,15 +718,15 @@ typedef int socklen_t; #include <pwd.h> #include <grp.h> -MODULE_SCOPE struct passwd * TclpGetPwNam(const char *name); -MODULE_SCOPE struct group * TclpGetGrNam(const char *name); -MODULE_SCOPE struct passwd * TclpGetPwUid(uid_t uid); -MODULE_SCOPE struct group * TclpGetGrGid(gid_t gid); -MODULE_SCOPE struct hostent * TclpGetHostByName(const char *name); -MODULE_SCOPE struct hostent * TclpGetHostByAddr(const char *addr, +extern struct passwd * TclpGetPwNam(const char *name); +extern struct group * TclpGetGrNam(const char *name); +extern struct passwd * TclpGetPwUid(uid_t uid); +extern struct group * TclpGetGrGid(gid_t gid); +extern struct hostent * TclpGetHostByName(const char *name); +extern struct hostent * TclpGetHostByAddr(const char *addr, int length, int type); -MODULE_SCOPE Tcl_Channel TclpMakeTcpClientChannelMode( - ClientData tcpSocket, int mode); +extern void *TclpMakeTcpClientChannelMode( + void *tcpSocket, int mode); #endif /* _TCLUNIXPORT */ diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index 31daa62..49a6460 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -737,7 +737,10 @@ TcpGetOptionProc( if (statePtr->status == 0) { ret = getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR, - (char *) &err, &optlen); + (char *) &err, &optlen); + if (statePtr->flags & TCP_ASYNC_CONNECT) { + statePtr->status = err; + } if (ret < 0) { err = errno; } @@ -1054,12 +1057,17 @@ CreateClientSocket( */ optlen = sizeof(int); - getsockopt(state->fds.fd, SOL_SOCKET, SO_ERROR, - (char *) &status, &optlen); - state->status = status; + + if (state->status == 0) { + getsockopt(state->fds.fd, SOL_SOCKET, SO_ERROR, + (char *) &status, &optlen); + state->status = status; + } else { + status = state->status; + state->status = 0; + } } if (status == 0) { - CLEAR_BITS(state->flags, TCP_ASYNC_CONNECT); goto out; } } @@ -1067,6 +1075,7 @@ CreateClientSocket( out: + CLEAR_BITS(state->flags, TCP_ASYNC_CONNECT); if (async_callback) { /* * An asynchonous connection has finally succeeded or failed. @@ -1202,7 +1211,7 @@ Tcl_Channel Tcl_MakeTcpClientChannel( ClientData sock) /* The socket to wrap up into a channel. */ { - return TclpMakeTcpClientChannelMode(sock, (TCL_READABLE | TCL_WRITABLE)); + return (Tcl_Channel) TclpMakeTcpClientChannelMode(sock, (TCL_READABLE | TCL_WRITABLE)); } /* @@ -1222,9 +1231,9 @@ Tcl_MakeTcpClientChannel( *---------------------------------------------------------------------- */ -Tcl_Channel +void * TclpMakeTcpClientChannelMode( - ClientData sock, /* The socket to wrap up into a channel. */ + void *sock, /* The socket to wrap up into a channel. */ int mode) /* ORed combination of TCL_READABLE and * TCL_WRITABLE to indicate file mode. */ { @@ -1357,6 +1366,7 @@ Tcl_OpenTcpServer( my_errno = errno; } close(sock); + sock = -1; continue; } if (port == 0 && chosenport == 0) { @@ -1379,6 +1389,7 @@ Tcl_OpenTcpServer( my_errno = errno; } close(sock); + sock = -1; continue; } if (statePtr == NULL) { diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index 46fc972..4b0f369 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -67,6 +67,7 @@ static Tcl_CmdProc TestchmodCmd; static Tcl_CmdProc TestfilehandlerCmd; static Tcl_CmdProc TestfilewaitCmd; static Tcl_CmdProc TestfindexecutableCmd; +static Tcl_ObjCmdProc TestforkObjCmd; static Tcl_CmdProc TestgetdefencdirCmd; static Tcl_CmdProc TestgetopenfileCmd; static Tcl_CmdProc TestgotsigCmd; @@ -103,6 +104,8 @@ TclplatformtestInit( NULL, NULL); Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testfork", TestforkObjCmd, + NULL, NULL); Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd, NULL, NULL); Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd, @@ -200,7 +203,7 @@ TestfilehandlerCmd( return TCL_ERROR; } sprintf(buf, "%d %d", pipePtr->readCount, pipePtr->writeCount); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_AppendResult(interp, buf, NULL); } else if (strcmp(argv[1], "create") == 0) { if (argc != 5) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", @@ -217,8 +220,8 @@ TestfilehandlerCmd( fcntl(GetFd(pipePtr->readFile), F_SETFL, O_NONBLOCK); fcntl(GetFd(pipePtr->writeFile), F_SETFL, O_NONBLOCK); #else - Tcl_SetResult(interp, "can't make pipes non-blocking", - TCL_STATIC); + Tcl_AppendResult(interp, "can't make pipes non-blocking", + NULL); return TCL_ERROR; #endif } @@ -281,7 +284,7 @@ TestfilehandlerCmd( memset(buffer, 'b', 10); TclFormatInt(buf, write(GetFd(pipePtr->writeFile), buffer, 10)); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_AppendResult(interp, buf, NULL); } else if (strcmp(argv[1], "oneevent") == 0) { Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT); } else if (strcmp(argv[1], "wait") == 0) { @@ -390,7 +393,7 @@ TestfilewaitCmd( if (Tcl_GetChannelHandle(channel, (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE, (ClientData*) &data) != TCL_OK) { - Tcl_SetResult(interp, "couldn't get channel file", TCL_STATIC); + Tcl_AppendResult(interp, "couldn't get channel file", NULL); return TCL_ERROR; } fd = PTR2INT(data); @@ -526,6 +529,51 @@ TestsetdefencdirCmd( Tcl_SetDefaultEncodingDir(argv[1]); return TCL_OK; } + +/* + *---------------------------------------------------------------------- + * + * TestforkObjCmd -- + * + * This function implements the "testfork" command. It is used to + * fork the Tcl process for specific test cases. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestforkObjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const *objv) /* Argument strings. */ +{ + pid_t pid; + + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, ""); + return TCL_ERROR; + } + pid = fork(); + if (pid == -1) { + Tcl_AppendResult(interp, + "Cannot fork", NULL); + return TCL_ERROR; + } + /* Only needed when pthread_atfork is not present, + * should not hurt otherwise. */ + if (pid==0) { + Tcl_InitNotifier(); + } + Tcl_SetObjResult(interp, Tcl_NewIntObj(pid)); + return TCL_OK; +} /* *---------------------------------------------------------------------- diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index 789dbb6..f469341 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -659,6 +659,7 @@ TclpReaddir( return TclOSreaddir(dir); } +#undef TclpInetNtoa char * TclpInetNtoa( struct in_addr addr) diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index c7921fe..926e8f4 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.c @@ -503,7 +503,7 @@ SetTZIfNecessary(void) if (lastTZ == NULL) { Tcl_CreateExitHandler(CleanupMemory, NULL); } else { - Tcl_Free(lastTZ); + ckfree(lastTZ); } lastTZ = ckalloc(strlen(newTZ) + 1); strcpy(lastTZ, newTZ); diff --git a/unix/tclXtNotify.c b/unix/tclXtNotify.c index e289e8c..a5d92d6 100644 --- a/unix/tclXtNotify.c +++ b/unix/tclXtNotify.c @@ -77,10 +77,10 @@ static int initialized = 0; */ static int FileHandlerEventProc(Tcl_Event *evPtr, int flags); -static void FileProc(ClientData clientData, int *source, +static void FileProc(XtPointer clientData, int *source, XtInputId *id); static void NotifierExitHandler(ClientData clientData); -static void TimerProc(ClientData clientData, XtIntervalId *id); +static void TimerProc(XtPointer clientData, XtIntervalId *id); static void CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, ClientData clientData); static void DeleteFileHandler(int fd); @@ -181,7 +181,7 @@ TclSetAppContext( void InitNotifier(void) { - Tcl_NotifierProcs notifier; + Tcl_NotifierProcs np; /* * Only reinitialize if we are not in exit handling. The notifier can get @@ -193,11 +193,15 @@ InitNotifier(void) return; } - notifier.createFileHandlerProc = CreateFileHandler; - notifier.deleteFileHandlerProc = DeleteFileHandler; - notifier.setTimerProc = SetTimer; - notifier.waitForEventProc = WaitForEvent; - Tcl_SetNotifier(¬ifier); + np.createFileHandlerProc = CreateFileHandler; + np.deleteFileHandlerProc = DeleteFileHandler; + np.setTimerProc = SetTimer; + np.waitForEventProc = WaitForEvent; + np.initNotifierProc = Tcl_InitNotifier; + np.finalizeNotifierProc = Tcl_FinalizeNotifier; + np.alertNotifierProc = Tcl_AlertNotifier; + np.serviceModeHookProc = Tcl_ServiceModeHook; + Tcl_SetNotifier(&np); /* * DO NOT create the application context yet; doing so would prevent @@ -205,7 +209,7 @@ InitNotifier(void) */ initialized = 1; - memset(¬ifier, 0, sizeof(notifier)); + memset(&np, 0, sizeof(np)); Tcl_CreateExitHandler(NotifierExitHandler, NULL); } @@ -301,7 +305,7 @@ SetTimer( static void TimerProc( - ClientData clientData, /* Not used. */ + XtPointer clientData, /* Not used. */ XtIntervalId *id) { if (*id != notifier.currentTimeout) { @@ -488,7 +492,7 @@ DeleteFileHandler( static void FileProc( - ClientData clientData, + XtPointer clientData, int *fd, XtInputId *id) { diff --git a/unix/tclooConfig.sh b/unix/tclooConfig.sh index 721825b..08cc4c5 100644 --- a/unix/tclooConfig.sh +++ b/unix/tclooConfig.sh @@ -16,4 +16,4 @@ TCLOO_STUB_LIB_SPEC="" TCLOO_INCLUDE_SPEC="" TCLOO_PRIVATE_INCLUDE_SPEC="" TCLOO_CFLAGS="" -TCLOO_VERSION=1.0 +TCLOO_VERSION=1.0.1 diff --git a/win/Makefile.in b/win/Makefile.in index 8cfb68c..fd80010 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -82,6 +82,11 @@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ #CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE) CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -DUNICODE -D_UNICODE +# To compile without backward compatibility and deprecated code uncomment the +# following +NO_DEPRECATED_FLAGS = +#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED + # To enable compilation debugging reverse the comment characters on one of the # following lines. COMPILE_DEBUG_FLAGS = @@ -187,7 +192,7 @@ COPY = cp CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} -I"${ZLIB_DIR}" \ -I"${GENERIC_DIR_NATIVE}" -DTCL_TOMMATH -DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" \ -I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \ -${COMPILE_DEBUG_FLAGS} +${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS} CC_OBJNAME = @CC_OBJNAME@ CC_EXENAME = @CC_EXENAME@ @@ -220,6 +225,7 @@ GENERIC_OBJS = \ tclCmdIL.$(OBJEXT) \ tclCmdMZ.$(OBJEXT) \ tclCompCmds.$(OBJEXT) \ + tclCompCmdsGR.$(OBJEXT) \ tclCompCmdsSZ.$(OBJEXT) \ tclCompExpr.$(OBJEXT) \ tclCompile.$(OBJEXT) \ @@ -261,6 +267,7 @@ GENERIC_OBJS = \ tclOOMethod.$(OBJEXT) \ tclOOStubInit.$(OBJEXT) \ tclObj.$(OBJEXT) \ + tclOptimize.$(OBJEXT) \ tclPanic.$(OBJEXT) \ tclParse.$(OBJEXT) \ tclPathObj.$(OBJEXT) \ @@ -426,7 +433,7 @@ $(CAT32): cat32.$(OBJEXT) ${TCL_STUB_LIB_FILE}: ${STUB_OBJS} @$(RM) ${TCL_STUB_LIB_FILE} - @MAKE_LIB@ ${STUB_OBJS} + @MAKE_STUB_LIB@ ${STUB_OBJS} @POST_MAKE_LIB@ ${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@ @@ -439,19 +446,19 @@ ${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} @MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} @POST_MAKE_LIB@ -${DDE_DLL_FILE}: ${DDE_OBJS} ${TCL_STUB_LIB_FILE} +${DDE_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${DDE_OBJS} @MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) -${REG_DLL_FILE}: ${REG_OBJS} ${TCL_STUB_LIB_FILE} +${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS} @MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) -${TEST_DLL_FILE}: ${TCLTEST_OBJS} ${TCL_STUB_LIB_FILE} +${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} @$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE} @MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) # use pre-built zlib1.dll ${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE} - @if test "@ZLIB_LIBS@set" == "${ZLIB_DIR}/win64/zdll.libset" ; then \ + @if test "@ZLIB_LIBS@set" != "${ZLIB_DIR}/win32/zdll.libset" ; then \ $(COPY) $(ZLIB_DIR)/win64/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \ else \ $(COPY) $(ZLIB_DIR)/win32/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \ @@ -577,23 +584,23 @@ install-binaries: binaries fi; \ done @if [ -f $(DDE_DLL_FILE) ]; then \ - echo installing $(DDE_DLL_FILE); \ + echo Installing $(DDE_DLL_FILE); \ $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \ $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \ $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \ fi @if [ -f $(DDE_LIB_FILE) ]; then \ - echo installing $(DDE_LIB_FILE); \ + echo Installing $(DDE_LIB_FILE); \ $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \ fi @if [ -f $(REG_DLL_FILE) ]; then \ - echo installing $(REG_DLL_FILE); \ + echo Installing $(REG_DLL_FILE); \ $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ $(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \ $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ fi @if [ -f $(REG_LIB_FILE) ]; then \ - echo installing $(REG_LIB_FILE); \ + echo Installing $(REG_LIB_FILE); \ $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ fi @@ -634,19 +641,19 @@ install-libraries: libraries install-tzdata install-msgs do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; - @echo "Installing package http 2.8.5 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.5.tm; + @echo "Installing package http 2.8.8 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.8.tm; @echo "Installing library opt0.4 directory"; @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; - @echo "Installing package msgcat 1.5.0 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.5.0.tm; - @echo "Installing package tcltest 2.3.5 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.5.tm; - @echo "Installing package platform 1.0.10 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.10.tm; + @echo "Installing package msgcat 1.5.2 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.5.2.tm; + @echo "Installing package tcltest 2.3.7 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.7.tm; + @echo "Installing package platform 1.0.12 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.12.tm; @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.4.tm; @echo "Installing encodings"; @@ -751,7 +758,7 @@ packages: if [ ! -f $(PKG_DIR)/$$pkg/Makefile ]; then \ ( cd $(PKG_DIR)/$$pkg; \ echo "Configuring package '$$i' wd = `pwd -P`"; \ - $$i/configure --with-tcl=$(PWD) --with-tclinclude=$(GENERIC_DIR) $(PKG_CFG_ARGS) --enable-shared --enable-threads; ) \ + $$i/configure --with-tcl=$$builddir --with-tclinclude=$(GENERIC_DIR) $(PKG_CFG_ARGS) --enable-shared --enable-threads; ) \ fi ; \ echo "Building package '$$pkg'"; \ ( cd $(PKG_DIR)/$$pkg; $(MAKE); ) \ @@ -91,9 +91,9 @@ Note: Tcl no longer provides support for Win32s. This distribution contains an extensive test suite for Tcl. Some of the tests are timing dependent and will fail from time to time. If a test is failing consistently, please send us a bug report with as much detail as -you can manage. Please use the online database at +you can manage to our tracker: - http://tcl.sourceforge.net/ + http://core.tcl.tk/tcl/reportlist In order to run the test suite, you build the "test" target using the appropriate makefile for your compiler. diff --git a/win/configure b/win/configure index 03a20b4..569172e 100755 --- a/win/configure +++ b/win/configure @@ -309,7 +309,7 @@ ac_includes_default="\ # include <unistd.h> #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 CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING ZLIB_DLL_FILE ZLIB_LIBS ZLIB_OBJS CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL PKG_CFG_ARGS TCL_EXE TCL_LIB_FILE TCL_LIB_FLAG TCL_STATIC_LIB_FILE TCL_STATIC_LIB_FLAG TCL_IMPORT_LIB_FILE TCL_IMPORT_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_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS' +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 CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING ZLIB_DLL_FILE ZLIB_LIBS ZLIB_OBJS CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_WIN_VERSION MACHINE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL PKG_CFG_ARGS TCL_EXE TCL_LIB_FILE TCL_LIB_FLAG TCL_STATIC_LIB_FILE TCL_STATIC_LIB_FLAG TCL_IMPORT_LIB_FILE TCL_IMPORT_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_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB MAKE_STUB_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS' ac_subst_files='' # Initialize some variables set by options. @@ -1311,7 +1311,7 @@ SHELL=/bin/sh TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL=".0" +TCL_PATCH_LEVEL=".1" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 @@ -3146,7 +3146,8 @@ echo "${ECHO_T}shared" >&6 echo "$as_me:$LINENO: result: static" >&5 echo "${ECHO_T}static" >&6 SHARED_BUILD=0 - cat >>confdefs.h <<\_ACEOF + +cat >>confdefs.h <<\_ACEOF #define STATIC_BUILD 1 _ACEOF @@ -3448,6 +3449,8 @@ echo "${ECHO_T}yes" >&6 # set various compiler flags depending on whether we are using gcc or cl if test "${GCC}" = "yes" ; then + extra_cflags="-pipe" + extra_ldflags="-pipe -static-libgcc" echo "$as_me:$LINENO: checking for mingw32 version of gcc" >&5 echo $ECHO_N "checking for mingw32 version of gcc... $ECHO_C" >&6 if test "${ac_cv_win32+set}" = set; then @@ -3594,13 +3597,11 @@ echo $ECHO_N "checking compiler flags... $ECHO_C" >&6 RC_DEFINE=--define RES=res.o MAKE_LIB="\${STLIB_LD} \$@" + MAKE_STUB_LIB="\${STLIB_LD} \$@" POST_MAKE_LIB="\${RANLIB} \$@" MAKE_EXE="\${CC} -o \$@" LIBPREFIX="lib" - extra_cflags="$extra_cflags -pipe" - extra_ldflags="$extra_ldflags -pipe" - if test "${SHARED_BUILD}" = "0" ; then # static echo "$as_me:$LINENO: result: using static flags" >&5 @@ -3629,9 +3630,8 @@ echo "$as_me: error: ${CC} does not support the -shared option. LIBRARIES="\${SHARED_LIBRARIES}" fi # Link with gcc since ld does not link to default libs like - # -luser32 and -lmsvcrt by default. Make sure CFLAGS is - # included so -mno-cygwin passed the correct libs to the linker. - SHLIB_LD='${CC} -shared ${CFLAGS}' + # -luser32 and -lmsvcrt by default. + SHLIB_LD='${CC} -shared' SHLIB_LD_LIBS='${LIBS}' MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags} \ -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\$@)" @@ -4003,6 +4003,7 @@ _ACEOF RC_DEFINE=-d RES=res MAKE_LIB="\${STLIB_LD} -out:\$@" + MAKE_STUB_LIB="\${STLIB_LD} -nodefaultlib -out:\$@" POST_MAKE_LIB= MAKE_EXE="\${CC} -Fe\$@" LIBPREFIX="" @@ -4361,7 +4362,17 @@ if test "$tcl_ok" = "yes"; then if test "$do64bit" = "yes"; then - ZLIB_LIBS=\${ZLIB_DIR}/win64/zdll.lib + if test "$GCC" == "yes"; then + + ZLIB_LIBS=\${ZLIB_DIR}/win64/libz.dll.a + + +else + + ZLIB_LIBS=\${ZLIB_DIR}/win64/zdll.lib + + +fi else @@ -4376,10 +4387,6 @@ else ZLIB_OBJS=\${ZLIB_OBJS} - cat >>confdefs.h <<_ACEOF -#define NO_VIZ 1 -_ACEOF - fi @@ -5161,6 +5168,19 @@ else TCL_PACKAGE_PATH="${prefix}/lib" fi +# The tclsh.exe.manifest requires these +# TCL_WIN_VERSION is the 4 dotted pair Windows version format which needs +# the release level, and must account for interim release versioning +case "$TCL_PATCH_LEVEL" in + *a*) TCL_RELEASE_LEVEL=0 ;; + *b*) TCL_RELEASE_LEVEL=1 ;; + *) TCL_RELEASE_LEVEL=2 ;; +esac +TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d ab.`" + +# X86|AMD64|IA64 for manifest + + @@ -5228,6 +5248,7 @@ fi + # empty on win, but needs sub'ing @@ -5254,7 +5275,7 @@ fi - ac_config_files="$ac_config_files Makefile tclConfig.sh tcl.hpj" + ac_config_files="$ac_config_files Makefile tclConfig.sh tcl.hpj tclsh.exe.manifest" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure @@ -5808,6 +5829,7 @@ do "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;; "tclConfig.sh" ) CONFIG_FILES="$CONFIG_FILES tclConfig.sh" ;; "tcl.hpj" ) CONFIG_FILES="$CONFIG_FILES tcl.hpj" ;; + "tclsh.exe.manifest" ) CONFIG_FILES="$CONFIG_FILES tclsh.exe.manifest" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; @@ -5921,6 +5943,8 @@ s,@CFLAGS_DEFAULT@,$CFLAGS_DEFAULT,;t t s,@LDFLAGS_DEFAULT@,$LDFLAGS_DEFAULT,;t t s,@VC_MANIFEST_EMBED_DLL@,$VC_MANIFEST_EMBED_DLL,;t t s,@VC_MANIFEST_EMBED_EXE@,$VC_MANIFEST_EMBED_EXE,;t t +s,@TCL_WIN_VERSION@,$TCL_WIN_VERSION,;t t +s,@MACHINE@,$MACHINE,;t t s,@TCL_VERSION@,$TCL_VERSION,;t t s,@TCL_MAJOR_VERSION@,$TCL_MAJOR_VERSION,;t t s,@TCL_MINOR_VERSION@,$TCL_MINOR_VERSION,;t t @@ -5969,6 +5993,7 @@ s,@LIBSUFFIX@,$LIBSUFFIX,;t t s,@EXESUFFIX@,$EXESUFFIX,;t t s,@LIBRARIES@,$LIBRARIES,;t t s,@MAKE_LIB@,$MAKE_LIB,;t t +s,@MAKE_STUB_LIB@,$MAKE_STUB_LIB,;t t s,@POST_MAKE_LIB@,$POST_MAKE_LIB,;t t s,@MAKE_DLL@,$MAKE_DLL,;t t s,@MAKE_EXE@,$MAKE_EXE,;t t diff --git a/win/configure.in b/win/configure.in index b0c007a..77e0327 100644 --- a/win/configure.in +++ b/win/configure.in @@ -14,7 +14,7 @@ SHELL=/bin/sh TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL=".0" +TCL_PATCH_LEVEL=".1" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 @@ -129,13 +129,16 @@ AS_IF([test "${enable_shared+set}" = "set"], [ AS_IF([test "$tcl_ok" = "yes"], [ AC_SUBST(ZLIB_DLL_FILE,[\${ZLIB_DLL_FILE}]) AS_IF([test "$do64bit" = "yes"], [ - AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR}/win64/zdll.lib]) + AS_IF([test "$GCC" == "yes"],[ + AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR}/win64/libz.dll.a]) + ], [ + AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR}/win64/zdll.lib]) + ]) ], [ AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR}/win32/zdll.lib]) ]) ], [ AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}]) - AC_DEFINE_UNQUOTED(NO_VIZ, 1) ]) AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?]) @@ -347,6 +350,19 @@ else TCL_PACKAGE_PATH="${prefix}/lib" fi +# The tclsh.exe.manifest requires these +# TCL_WIN_VERSION is the 4 dotted pair Windows version format which needs +# the release level, and must account for interim release versioning +case "$TCL_PATCH_LEVEL" in + *a*) TCL_RELEASE_LEVEL=0 ;; + *b*) TCL_RELEASE_LEVEL=1 ;; + *) TCL_RELEASE_LEVEL=2 ;; +esac +TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d ab.`" +AC_SUBST(TCL_WIN_VERSION) +# X86|AMD64|IA64 for manifest +AC_SUBST(MACHINE) + AC_SUBST(TCL_VERSION) AC_SUBST(TCL_MAJOR_VERSION) AC_SUBST(TCL_MINOR_VERSION) @@ -410,6 +426,7 @@ AC_SUBST(LIBSUFFIX) AC_SUBST(EXESUFFIX) AC_SUBST(LIBRARIES) AC_SUBST(MAKE_LIB) +AC_SUBST(MAKE_STUB_LIB) AC_SUBST(POST_MAKE_LIB) AC_SUBST(MAKE_DLL) AC_SUBST(MAKE_EXE) @@ -440,7 +457,7 @@ AC_SUBST(RC_DEFINE) AC_SUBST(RC_DEFINES) AC_SUBST(RES) -AC_OUTPUT(Makefile tclConfig.sh tcl.hpj) +AC_OUTPUT(Makefile tclConfig.sh tcl.hpj tclsh.exe.manifest) dnl Local Variables: dnl mode: autoconf; diff --git a/win/makefile.bc b/win/makefile.bc index 18bfa28..a962bc6 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -200,6 +200,7 @@ TCLOBJS = \ $(TMPDIR)\tclCmdIL.obj \ $(TMPDIR)\tclCmdMZ.obj \ $(TMPDIR)\tclCompCmds.obj \ + $(TMPDIR)\tclCompCmdsGR.obj \ $(TMPDIR)\tclCompCmdsSZ.obj \ $(TMPDIR)\tclCompExpr.obj \ $(TMPDIR)\tclCompile.obj \ @@ -238,6 +239,7 @@ TCLOBJS = \ $(TMPDIR)\tclOOMethod.obj \ $(TMPDIR)\tclOOStubInit.obj \ $(TMPDIR)\tclObj.obj \ + $(TMPDIR)\tclOptimize.obj \ $(TMPDIR)\tclPanic.obj \ $(TMPDIR)\tclParse.obj \ $(TMPDIR)\tclPipe.obj \ @@ -407,57 +409,57 @@ $(CAT32): $(WINDIR)\cat.c install-binaries: $(TCLSH) $(MKDIR) "$(BIN_INSTALL_DIR)" $(MKDIR) "$(LIB_INSTALL_DIR)" - @echo installing $(TCLDLLNAME) + @echo Installing $(TCLDLLNAME) @copy "$(TCLDLL)" "$(BIN_INSTALL_DIR)" @copy "$(TCLLIB)" "$(LIB_INSTALL_DIR)" - @echo installing "$(TCLSH)" + @echo Installing "$(TCLSH)" @copy "$(TCLSH)" "$(BIN_INSTALL_DIR)" - @echo installing $(TCLSTUBLIBNAME) + @echo Installing $(TCLSTUBLIBNAME) @copy "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)" - @echo installing $(WINDIR)\tclooConfig.sh + @echo Installing $(WINDIR)\tclooConfig.sh @copy "$(WINDIR)\tclooConfig.sh" "$(LIB_INSTALL_DIR)" install-libraries: -@$(MKDIR) "$(LIB_INSTALL_DIR)" -@$(MKDIR) "$(INCLUDE_INSTALL_DIR)" -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)" - @echo installing http1.0 + @echo Installing http1.0 -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http1.0" -@copy "$(ROOT)\library\http1.0\http.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0" -@copy "$(ROOT)\library\http1.0\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0" - @echo installing http2.8 + @echo Installing http2.8 -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.8" -@copy "$(ROOT)\library\http\http.tcl" "$(SCRIPT_INSTALL_DIR)\http2.8" -@copy "$(ROOT)\library\http\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.8" - @echo installing opt0.4 + @echo Installing opt0.4 -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4" -@copy "$(ROOT)\library\opt\optparse.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4" -@copy "$(ROOT)\library\opt\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4" - @echo installing msgcat1.5 + @echo Installing msgcat1.5 -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\msgcat1.5" -@copy "$(ROOT)\library\msgcat\msgcat.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.5" -@copy "$(ROOT)\library\msgcat\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.5" - @echo installing tcltest2.3 + @echo Installing tcltest2.3 -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\tcltest2.3" -@copy "$(ROOT)\library\tcltest\tcltest.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.3" -@copy "$(ROOT)\library\tcltest\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.3" - @echo installing platform1.0 + @echo Installing platform1.0 -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\platform1.0" -@copy "$(ROOT)\library\platform\platform.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0" -@copy "$(ROOT)\library\platform\shell.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0" -@copy "$(ROOT)\library\platform\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0" - @echo installing $(TCLDDEDLLNAME) + @echo Installing $(TCLDDEDLLNAME) -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\dde1.3" -@copy "$(TCLDDEDLL)" "$(SCRIPT_INSTALL_DIR)\dde1.3" -@copy "$(ROOT)\library\dde\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\dde1.3" - @echo installing $(TCLREGDLLNAME) + @echo Installing $(TCLREGDLLNAME) -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\reg1.2" -@copy "$(TCLREGDLL)" "$(SCRIPT_INSTALL_DIR)\reg1.3" -@copy "$(ROOT)\library\reg\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\reg1.2" - @echo installing encoding files + @echo Installing encoding files -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\encoding" -@copy "$(ROOT)\library\encoding\*.enc" "$(SCRIPT_INSTALL_DIR)\encoding" - @echo installing library files + @echo Installing library files -@copy "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)" -@copy "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)" -@copy "$(GENERICDIR)\tclOO.h" "$(INCLUDE_INSTALL_DIR)" diff --git a/win/makefile.vc b/win/makefile.vc index 2784140..56bc4b7 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -274,6 +274,7 @@ COREOBJS = \ $(TMP_DIR)\tclCmdIL.obj \ $(TMP_DIR)\tclCmdMZ.obj \ $(TMP_DIR)\tclCompCmds.obj \ + $(TMP_DIR)\tclCompCmdsGR.obj \ $(TMP_DIR)\tclCompCmdsSZ.obj \ $(TMP_DIR)\tclCompExpr.obj \ $(TMP_DIR)\tclCompile.obj \ @@ -315,6 +316,7 @@ COREOBJS = \ $(TMP_DIR)\tclOOMethod.obj \ $(TMP_DIR)\tclOOStubInit.obj \ $(TMP_DIR)\tclObj.obj \ + $(TMP_DIR)\tclOptimize.obj \ $(TMP_DIR)\tclPanic.obj \ $(TMP_DIR)\tclParse.obj \ $(TMP_DIR)\tclPathObj.obj \ @@ -620,7 +622,7 @@ $** !endif $(TCLSTUBLIB): $(TCLSTUBOBJS) - $(lib32) -nologo $(LINKERFLAGS) -out:$@ $(TCLSTUBOBJS) + $(lib32) -nologo $(LINKERFLAGS) -nodefaultlib -out:$@ $(TCLSTUBOBJS) $(TCLSH): $(TCLSHOBJS) $(TCLSTUBLIB) $(TCLIMPLIB) $(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $** @@ -983,6 +985,12 @@ $(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c $(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? +$(TMP_DIR)\tclsh.exe.manifest: $(WINDIR)\tclsh.exe.manifest.in + @nmakehlp -s << $** >$@ +@MACHINE@ $(MACHINE:IX86=X86) +@TCL_WIN_VERSION@ $(TCL_DOTVERSION).0.0 +<< + #--------------------------------------------------------------------- # Generate the source dependencies. Having dependency rules will # improve incremental build accuracy without having to resort to a @@ -1049,12 +1057,14 @@ $< << {$(WINDIR)}.rc{$(TMP_DIR)}.res: - $(rc32) -fo $@ -r -i "$(GENERICDIR)" \ + $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \ -d DEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \ -d TCL_THREADS=$(TCL_THREADS) \ -d STATIC_BUILD=$(STATIC_BUILD) \ $< +$(TMP_DIR)\tclsh.res: $(TMP_DIR)\tclsh.exe.manifest + .SUFFIXES: .SUFFIXES:.c .rc @@ -3,50 +3,124 @@ # # Locate the tclConfig.sh file and perform a sanity check on # the Tcl compile flags -# Currently a no-op for Windows # # Arguments: -# PATCH_LEVEL The patch level for Tcl if any. +# none # # Results: # # Adds the following arguments to configure: # --with-tcl=... # -# Sets the following vars: -# TCL_BIN_DIR Full path to the tclConfig.sh file +# Defines the following vars: +# TCL_BIN_DIR Full path to the directory containing +# the tclConfig.sh file #------------------------------------------------------------------------ AC_DEFUN([SC_PATH_TCLCONFIG], [ - AC_MSG_CHECKING([the location of tclConfig.sh]) + # + # Ok, lets find the tcl configuration + # First, look for one uninstalled. + # the alternative search directory is invoked by --with-tcl + # - if test -d ../../tcl8.6$1/win; then - TCL_BIN_DIR_DEFAULT=../../tcl8.6$1/win - elif test -d ../../tcl8.6/win; then - TCL_BIN_DIR_DEFAULT=../../tcl8.6/win - else - TCL_BIN_DIR_DEFAULT=../../tcl/win - fi + if test x"${no_tcl}" = x ; then + # we reset no_tcl in case something fails here + no_tcl=true + AC_ARG_WITH(tcl, + AC_HELP_STRING([--with-tcl], + [directory containing tcl configuration (tclConfig.sh)]), + with_tclconfig="${withval}") + AC_MSG_CHECKING([for Tcl configuration]) + AC_CACHE_VAL(ac_cv_c_tclconfig,[ + + # First check to see if --with-tcl was specified. + if test x"${with_tclconfig}" != x ; then + case "${with_tclconfig}" in + */tclConfig.sh ) + if test -f "${with_tclconfig}"; then + AC_MSG_WARN([--with-tcl argument should refer to directory containing tclConfig.sh, not to tclConfig.sh itself]) + with_tclconfig="`echo "${with_tclconfig}" | sed 's!/tclConfig\.sh$!!'`" + fi ;; + esac + if test -f "${with_tclconfig}/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd "${with_tclconfig}"; pwd)`" + else + AC_MSG_ERROR([${with_tclconfig} directory doesn't contain tclConfig.sh]) + fi + fi - AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.6 binaries from DIR], - TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DIR_DEFAULT; pwd`) - if test ! -d $TCL_BIN_DIR; then - AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist) - fi - if test ! -f $TCL_BIN_DIR/tclConfig.sh; then - if test ! -f $TCL_BIN_DIR/../unix/tclConfig.sh; then - AC_MSG_ERROR(There is no tclConfig.sh in $TCL_BIN_DIR: perhaps you did not specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?) + # then check for a private Tcl installation + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in \ + ../tcl \ + `ls -dr ../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../tcl[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../tcl[[8-9]].[[0-9]]* 2>/dev/null` \ + ../../tcl \ + `ls -dr ../../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../../tcl[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../tcl[[8-9]].[[0-9]]* 2>/dev/null` \ + ../../../tcl \ + `ls -dr ../../../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../../../tcl[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do + if test -f "$i/win/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/win; pwd)`" + break + fi + done + fi + + # check in a few common install locations + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in `ls -d ${libdir} 2>/dev/null` \ + `ls -d ${exec_prefix}/lib 2>/dev/null` \ + `ls -d ${prefix}/lib 2>/dev/null` \ + `ls -d /cygdrive/c/Tcl/lib 2>/dev/null` \ + `ls -d /cygdrive/c/Progra~1/Tcl/lib 2>/dev/null` \ + `ls -d /c/Tcl/lib 2>/dev/null` \ + `ls -d /c/Progra~1/Tcl/lib 2>/dev/null` \ + `ls -d C:/Tcl/lib 2>/dev/null` \ + `ls -d C:/Progra~1/Tcl/lib 2>/dev/null` \ + ; do + if test -f "$i/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i; pwd)`" + break + fi + done + fi + + # check in a few other private locations + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in \ + ${srcdir}/../tcl \ + `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do + if test -f "$i/win/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/win; pwd)`" + break + fi + done + fi + ]) + + if test x"${ac_cv_c_tclconfig}" = x ; then + TCL_BIN_DIR="# no Tcl configs found" + AC_MSG_ERROR([Can't find Tcl configuration definitions. Use --with-tcl to specify a directory containing tclConfig.sh]) + else + no_tcl= + TCL_BIN_DIR="${ac_cv_c_tclconfig}" + AC_MSG_RESULT([found ${TCL_BIN_DIR}/tclConfig.sh]) fi - TCL_BIN_DIR=`cd ${TCL_BIN_DIR}/../unix; pwd` fi - AC_MSG_RESULT($TCL_BIN_DIR/tclConfig.sh) ]) #------------------------------------------------------------------------ # SC_PATH_TKCONFIG -- # # Locate the tkConfig.sh file -# Currently a no-op for Windows # # Arguments: # none @@ -56,31 +130,109 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [ # Adds the following arguments to configure: # --with-tk=... # -# Sets the following vars: -# TK_BIN_DIR Full path to the tkConfig.sh file +# Defines the following vars: +# TK_BIN_DIR Full path to the directory containing +# the tkConfig.sh file #------------------------------------------------------------------------ AC_DEFUN([SC_PATH_TKCONFIG], [ - AC_MSG_CHECKING([the location of tkConfig.sh]) + # + # Ok, lets find the tk configuration + # First, look for one uninstalled. + # the alternative search directory is invoked by --with-tk + # - if test -d ../../tk8.6$1/win; then - TK_BIN_DIR_DEFAULT=../../tk8.6$1/win - elif test -d ../../tk8.6/win; then - TK_BIN_DIR_DEFAULT=../../tk8.6/win - else - TK_BIN_DIR_DEFAULT=../../tk/win - fi + if test x"${no_tk}" = x ; then + # we reset no_tk in case something fails here + no_tk=true + AC_ARG_WITH(tk, + AC_HELP_STRING([--with-tk], + [directory containing tk configuration (tkConfig.sh)]), + with_tkconfig="${withval}") + AC_MSG_CHECKING([for Tk configuration]) + AC_CACHE_VAL(ac_cv_c_tkconfig,[ + + # First check to see if --with-tkconfig was specified. + if test x"${with_tkconfig}" != x ; then + case "${with_tkconfig}" in + */tkConfig.sh ) + if test -f "${with_tkconfig}"; then + AC_MSG_WARN([--with-tk argument should refer to directory containing tkConfig.sh, not to tkConfig.sh itself]) + with_tkconfig="`echo "${with_tkconfig}" | sed 's!/tkConfig\.sh$!!'`" + fi ;; + esac + if test -f "${with_tkconfig}/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd "${with_tkconfig}"; pwd)`" + else + AC_MSG_ERROR([${with_tkconfig} directory doesn't contain tkConfig.sh]) + fi + fi - AC_ARG_WITH(tk, [ --with-tk=DIR use Tk 8.6 binaries from DIR], - TK_BIN_DIR=$withval, TK_BIN_DIR=`cd $TK_BIN_DIR_DEFAULT; pwd`) - if test ! -d $TK_BIN_DIR; then - AC_MSG_ERROR(Tk directory $TK_BIN_DIR does not exist) - fi - if test ! -f $TK_BIN_DIR/tkConfig.sh; then - AC_MSG_ERROR(There is no tkConfig.sh in $TK_BIN_DIR: perhaps you did not specify the Tk *build* directory (not the toplevel Tk directory) or you forgot to configure Tk?) - fi + # then check for a private Tk library + if test x"${ac_cv_c_tkconfig}" = x ; then + for i in \ + ../tk \ + `ls -dr ../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../tk[[8-9]].[[0-9]]* 2>/dev/null` \ + ../../tk \ + `ls -dr ../../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../tk[[8-9]].[[0-9]]* 2>/dev/null` \ + ../../../tk \ + `ls -dr ../../../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../../../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do + if test -f "$i/win/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i/win; pwd)`" + break + fi + done + fi - AC_MSG_RESULT([$TK_BIN_DIR/tkConfig.sh]) + # check in a few common install locations + if test x"${ac_cv_c_tkconfig}" = x ; then + for i in `ls -d ${libdir} 2>/dev/null` \ + `ls -d ${exec_prefix}/lib 2>/dev/null` \ + `ls -d ${prefix}/lib 2>/dev/null` \ + `ls -d /cygdrive/c/Tcl/lib 2>/dev/null` \ + `ls -d /cygdrive/c/Progra~1/Tcl/lib 2>/dev/null` \ + `ls -d /c/Tcl/lib 2>/dev/null` \ + `ls -d /c/Progra~1/Tcl/lib 2>/dev/null` \ + `ls -d C:/Tcl/lib 2>/dev/null` \ + `ls -d C:/Progra~1/Tcl/lib 2>/dev/null` \ + ; do + if test -f "$i/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i; pwd)`" + break + fi + done + fi + + # check in a few other private locations + if test x"${ac_cv_c_tkconfig}" = x ; then + for i in \ + ${srcdir}/../tk \ + `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do + if test -f "$i/win/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i/win; pwd)`" + break + fi + done + fi + ]) + + if test x"${ac_cv_c_tkconfig}" = x ; then + TK_BIN_DIR="# no Tk configs found" + AC_MSG_ERROR([Can't find Tk configuration definitions. Use --with-tk to specify a directory containing tkConfig.sh]) + else + no_tk= + TK_BIN_DIR="${ac_cv_c_tkconfig}" + AC_MSG_RESULT([found ${TK_BIN_DIR}/tkConfig.sh]) + fi + fi ]) #------------------------------------------------------------------------ @@ -95,7 +247,7 @@ AC_DEFUN([SC_PATH_TKCONFIG], [ # # Results: # -# Subst the following vars: +# Substitutes the following vars: # TCL_BIN_DIR # TCL_SRC_DIR # TCL_LIB_FILE @@ -103,13 +255,13 @@ AC_DEFUN([SC_PATH_TKCONFIG], [ #------------------------------------------------------------------------ AC_DEFUN([SC_LOAD_TCLCONFIG], [ - AC_MSG_CHECKING([for existence of $TCL_BIN_DIR/tclConfig.sh]) + AC_MSG_CHECKING([for existence of ${TCL_BIN_DIR}/tclConfig.sh]) - if test -f "$TCL_BIN_DIR/tclConfig.sh" ; then + if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then AC_MSG_RESULT([loading]) - . $TCL_BIN_DIR/tclConfig.sh + . "${TCL_BIN_DIR}/tclConfig.sh" else - AC_MSG_RESULT([file not found]) + AC_MSG_RESULT([could not find ${TCL_BIN_DIR}/tclConfig.sh]) fi # @@ -158,7 +310,6 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [ # SC_LOAD_TKCONFIG -- # # Load the tkConfig.sh file -# Currently a no-op for Windows # # Arguments: # @@ -172,13 +323,13 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [ #------------------------------------------------------------------------ AC_DEFUN([SC_LOAD_TKCONFIG], [ - AC_MSG_CHECKING([for existence of $TK_BIN_DIR/tkConfig.sh]) + AC_MSG_CHECKING([for existence of ${TK_BIN_DIR}/tkConfig.sh]) - if test -f "$TK_BIN_DIR/tkConfig.sh" ; then + if test -f "${TK_BIN_DIR}/tkConfig.sh" ; then AC_MSG_RESULT([loading]) - . $TK_BIN_DIR/tkConfig.sh + . "${TK_BIN_DIR}/tkConfig.sh" else - AC_MSG_RESULT([could not find $TK_BIN_DIR/tkConfig.sh]) + AC_MSG_RESULT([could not find ${TK_BIN_DIR}/tkConfig.sh]) fi @@ -212,7 +363,7 @@ AC_DEFUN([SC_ENABLE_SHARED], [ AC_MSG_CHECKING([how to build libraries]) AC_ARG_ENABLE(shared, [ --enable-shared build and link with shared libraries (default: on)], - [tcl_ok=$enableval], [tcl_ok=yes]) + [tcl_ok=$enableval], [tcl_ok=yes]) if test "${enable_shared+set}" = set; then enableval="$enable_shared" @@ -227,7 +378,7 @@ AC_DEFUN([SC_ENABLE_SHARED], [ else AC_MSG_RESULT([static]) SHARED_BUILD=0 - AC_DEFINE(STATIC_BUILD) + AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?]) fi ]) @@ -270,7 +421,7 @@ AC_DEFUN([SC_ENABLE_THREADS], [ #------------------------------------------------------------------------ # SC_ENABLE_SYMBOLS -- # -# Specify if debugging symbols should be used +# Specify if debugging symbols should be used. # Memory (TCL_MEM_DEBUG) and compile (TCL_COMPILE_DEBUG) debugging # can also be enabled. # @@ -372,6 +523,7 @@ AC_DEFUN([SC_ENABLE_SYMBOLS], [ # RES # # MAKE_LIB +# MAKE_STUB_LIB # MAKE_EXE # MAKE_DLL # @@ -482,6 +634,8 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ # set various compiler flags depending on whether we are using gcc or cl if test "${GCC}" = "yes" ; then + extra_cflags="-pipe" + extra_ldflags="-pipe -static-libgcc" AC_CACHE_CHECK(for mingw32 version of gcc, ac_cv_win32, AC_TRY_COMPILE([ @@ -529,13 +683,11 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ RC_DEFINE=--define RES=res.o MAKE_LIB="\${STLIB_LD} \[$]@" + MAKE_STUB_LIB="\${STLIB_LD} \[$]@" POST_MAKE_LIB="\${RANLIB} \[$]@" MAKE_EXE="\${CC} -o \[$]@" LIBPREFIX="lib" - extra_cflags="$extra_cflags -pipe" - extra_ldflags="$extra_ldflags -pipe" - if test "${SHARED_BUILD}" = "0" ; then # static AC_MSG_RESULT([using static flags]) @@ -559,9 +711,8 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ LIBRARIES="\${SHARED_LIBRARIES}" fi # Link with gcc since ld does not link to default libs like - # -luser32 and -lmsvcrt by default. Make sure CFLAGS is - # included so -mno-cygwin passed the correct libs to the linker. - SHLIB_LD='${CC} -shared ${CFLAGS}' + # -luser32 and -lmsvcrt by default. + SHLIB_LD='${CC} -shared' SHLIB_LD_LIBS='${LIBS}' MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \[$]@ ${extra_ldflags} \ -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\[$]@)" @@ -810,6 +961,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ RC_DEFINE=-d RES=res MAKE_LIB="\${STLIB_LD} -out:\[$]@" + MAKE_STUB_LIB="\${STLIB_LD} -nodefaultlib -out:\[$]@" POST_MAKE_LIB= MAKE_EXE="\${CC} -Fe\[$]@" LIBPREFIX="" diff --git a/win/tclAppInit.c b/win/tclAppInit.c index 56f45a0..a6c1a67 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -3,7 +3,8 @@ * * Provides a default version of the main program and Tcl_AppInit * procedure for tclsh and other Tcl-based applications (without Tk). - * Note that this program must be built in Win32 console mode to work properly. + * Note that this program must be built in Win32 console mode to work + * properly. * * Copyright (c) 1993 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -33,19 +34,23 @@ extern Tcl_PackageInitProc Dde_SafeInit; #endif #ifdef TCL_BROKEN_MAINARGS +int _CRT_glob = 0; static void setargv(int *argcPtr, TCHAR ***argvPtr); -#endif +#endif /* TCL_BROKEN_MAINARGS */ /* * The following #if block allows you to change the AppInit function by using * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The - * #if checks for that #define and uses Tcl_AppInit if it doesn't exist. + * #if checks for that #define and uses Tcl_AppInit if it does not exist. */ #ifndef TCL_LOCAL_APPINIT #define TCL_LOCAL_APPINIT Tcl_AppInit #endif -extern int TCL_LOCAL_APPINIT(Tcl_Interp *interp); +#ifndef MODULE_SCOPE +# define MODULE_SCOPE extern +#endif +MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *); /* * The following #if block allows you to change how Tcl finds the startup @@ -54,7 +59,7 @@ extern int TCL_LOCAL_APPINIT(Tcl_Interp *interp); */ #ifdef TCL_LOCAL_MAIN_HOOK -extern int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv); +MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv); #endif /* @@ -77,15 +82,15 @@ extern int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv); #ifdef TCL_BROKEN_MAINARGS int main( - int argc, - char *dummy[]) + int argc, /* Number of command-line arguments. */ + char *dummy[]) /* Not used. */ { TCHAR **argv; #else int _tmain( - int argc, - TCHAR *argv[]) + int argc, /* Number of command-line arguments. */ + TCHAR *argv[]) /* Values of command-line arguments. */ { #endif TCHAR *p; @@ -99,7 +104,7 @@ _tmain( #ifdef TCL_BROKEN_MAINARGS /* - * Get our args from the c-runtime. Ignore lpszCmdLine. + * Get our args from the c-runtime. Ignore command line. */ setargv(&argc, &argv); @@ -189,11 +194,12 @@ Tcl_AppInit( /* * Specify a user-specific startup file to invoke if the application is * run interactively. Typically the startup file is "~/.apprc" where "app" - * is the name of the application. If this line is deleted then no user- - * specific startup file will be run under any conditions. + * is the name of the application. If this line is deleted then no + * user-specific startup file will be run under any conditions. */ - (Tcl_SetVar)(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY); + (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL, + Tcl_NewStringObj("~/tclshrc.tcl", -1), TCL_GLOBAL_ONLY); return TCL_OK; } diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index 019d76f..634e1d2 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -25,23 +25,6 @@ static HINSTANCE hInstance; /* HINSTANCE of this DLL. */ static int platformId; /* Running under NT, or 95/98? */ -#ifdef HAVE_NO_SEH -/* - * Unlike Borland and Microsoft, we don't register exception handlers by - * pushing registration records onto the runtime stack. Instead, we register - * them by creating an EXCEPTION_REGISTRATION within the activation record. - */ - -typedef struct EXCEPTION_REGISTRATION { - struct EXCEPTION_REGISTRATION *link; - EXCEPTION_DISPOSITION (*handler)( - struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*); - void *ebp; - void *esp; - int status; -} EXCEPTION_REGISTRATION; -#endif - /* * VC++ 5.x has no 'cpuid' assembler instruction, so we must emulate it */ @@ -198,11 +181,11 @@ void TclWinInit( HINSTANCE hInst) /* Library instance handle. */ { - OSVERSIONINFO os; + OSVERSIONINFOW os; hInstance = hInst; - os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); - GetVersionEx(&os); + os.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW); + GetVersionExW(&os); platformId = os.dwPlatformId; /* @@ -281,16 +264,9 @@ TclWinNoBackslash( /* *--------------------------------------------------------------------------- * - * TclWinSetInterfaces -- + * TclpSetInterfaces -- * - * A helper proc that allows the test library to change the tclWinProcs - * structure to dispatch to either the wide-character or multi-byte - * versions of the operating system calls, depending on whether Unicode - * is the system encoding. - * - * As well as this, we can also try to load in some additional procs - * which may/may not be present depending on the current Windows version - * (e.g. Win95 will not have the procs below). + * A helper proc that initializes winTCharEncoding. * * Results: * None. @@ -302,15 +278,10 @@ TclWinNoBackslash( */ void -TclWinSetInterfaces( - int wide) /* Non-zero to use wide interfaces, 0 - * otherwise. */ +TclpSetInterfaces(void) { - TclWinResetInterfaces(); - - if (wide) { - winTCharEncoding = Tcl_GetEncoding(NULL, "unicode"); - } + TclWinResetInterfaces(); + winTCharEncoding = Tcl_GetEncoding(NULL, "unicode"); } /* @@ -318,9 +289,7 @@ TclWinSetInterfaces( * * TclWinEncodingsCleanup -- * - * Called during finalization to free up any encodings we use. The - * tclWinProcs-> look up table is still ok to use after this call, - * provided no encoding conversion is required. + * Called during finalization to free up any encodings we use. * * We also clean up any memory allocated in our mount point map which is * used to follow certain kinds of symlinks. That code should never be @@ -363,8 +332,6 @@ TclWinEncodingsCleanup(void) * TclWinResetInterfaces -- * * Called during finalization to reset us to a safe state for reuse. - * After this call, it is best not to use the tclWinProcs-> look up table - * since it is likely to be different to what is expected. * * Results: * None. @@ -678,7 +645,7 @@ TclWinCPUID( # else - EXCEPTION_REGISTRATION registration; + TCLEXCEPTION_REGISTRATION registration; /* * Execute the CPUID instruction with the given index, and store results @@ -687,7 +654,7 @@ TclWinCPUID( __asm__ __volatile__( /* - * Construct an EXCEPTION_REGISTRATION to protect the CPUID + * Construct an TCLEXCEPTION_REGISTRATION to protect the CPUID * instruction (early 486's don't have CPUID) */ @@ -701,7 +668,7 @@ TclWinCPUID( "movl %[error], 0x10(%%edx)" "\n\t" /* status */ /* - * Link the EXCEPTION_REGISTRATION on the chain + * Link the TCLEXCEPTION_REGISTRATION on the chain */ "movl %%edx, %%fs:0" "\n\t" @@ -720,7 +687,7 @@ TclWinCPUID( "movl %%edx, 0xc(%%edi)" "\n\t" /* - * Come here on a normal exit. Recover the EXCEPTION_REGISTRATION and + * Come here on a normal exit. Recover the TCLEXCEPTION_REGISTRATION and * store a TCL_OK status. */ @@ -730,7 +697,7 @@ TclWinCPUID( "jmp 2f" "\n" /* - * Come here on an exception. Get the EXCEPTION_REGISTRATION that we + * Come here on an exception. Get the TCLEXCEPTION_REGISTRATION that we * previously put on the chain. */ @@ -740,7 +707,7 @@ TclWinCPUID( /* * Come here however we exited. Restore context from the - * EXCEPTION_REGISTRATION in case the stack is unbalanced. + * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 52b9e32..21115f7 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -119,23 +119,6 @@ static const Tcl_ChannelType fileChannelType = { FileThreadActionProc, /* Thread action proc. */ FileTruncateProc /* Truncate proc. */ }; - -#ifdef HAVE_NO_SEH -/* - * Unlike Borland and Microsoft, we don't register exception handlers by - * pushing registration records onto the runtime stack. Instead, we register - * them by creating an EXCEPTION_REGISTRATION within the activation record. - */ - -typedef struct EXCEPTION_REGISTRATION { - struct EXCEPTION_REGISTRATION *link; - EXCEPTION_DISPOSITION (*handler)( - struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*); - void *ebp; - void *esp; - int status; -} EXCEPTION_REGISTRATION; -#endif /* *---------------------------------------------------------------------- @@ -1030,7 +1013,7 @@ Tcl_MakeFileChannel( * TCL_WRITABLE to indicate file mode. */ { #if defined(HAVE_NO_SEH) && !defined(_WIN64) - EXCEPTION_REGISTRATION registration; + TCLEXCEPTION_REGISTRATION registration; #endif char channelName[16 + TCL_INTEGER_SPACE]; Tcl_Channel channel = NULL; @@ -1111,7 +1094,7 @@ Tcl_MakeFileChannel( "movl %[dupedHandle], %%ebx" "\n\t" /* - * Construct an EXCEPTION_REGISTRATION to protect the call to + * Construct an TCLEXCEPTION_REGISTRATION to protect the call to * CloseHandle. */ @@ -1125,7 +1108,7 @@ Tcl_MakeFileChannel( "movl $0, 0x10(%%edx)" "\n\t" /* status */ /* - * Link the EXCEPTION_REGISTRATION on the chain. + * Link the TCLEXCEPTION_REGISTRATION on the chain. */ "movl %%edx, %%fs:0" "\n\t" @@ -1138,7 +1121,7 @@ Tcl_MakeFileChannel( "call _CloseHandle@4" "\n\t" /* - * Come here on normal exit. Recover the EXCEPTION_REGISTRATION + * Come here on normal exit. Recover the TCLEXCEPTION_REGISTRATION * and put a TRUE status return into it. */ @@ -1148,7 +1131,7 @@ Tcl_MakeFileChannel( "jmp 2f" "\n" /* - * Come here on an exception. Recover the EXCEPTION_REGISTRATION + * Come here on an exception. Recover the TCLEXCEPTION_REGISTRATION */ "1:" "\t" @@ -1157,7 +1140,7 @@ Tcl_MakeFileChannel( /* * Come here however we exited. Restore context from the - * EXCEPTION_REGISTRATION in case the stack is unbalanced. + * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index 5aab255..0ec22c5 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -11,7 +11,6 @@ */ #include "tclWinInt.h" -#include <sys/stat.h> /* * The following variable is used to tell whether this module has been @@ -801,7 +800,7 @@ ConsoleOutputProc( * the channel is in non-blocking mode. */ - errno = EAGAIN; + errno = EWOULDBLOCK; goto error; } @@ -1080,7 +1079,7 @@ WaitForRead( * is in non-blocking mode. */ - errno = EAGAIN; + errno = EWOULDBLOCK; return -1; } diff --git a/win/tclWinDde.c b/win/tclWinDde.c index d0600e6..ce0b413 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -11,8 +11,9 @@ */ #undef STATIC_BUILD -#undef USE_TCL_STUBS -#define USE_TCL_STUBS +#ifndef USE_TCL_STUBS +# define USE_TCL_STUBS +#endif #include "tclInt.h" #include <dde.h> #include <ddeml.h> @@ -385,7 +386,8 @@ DdeSetServerName( Tcl_DStringSetLength(&dString, offset + sizeof(TCHAR) * TCL_INTEGER_SPACE); actualName = (TCHAR *) Tcl_DStringValue(&dString); } - _stprintf((TCHAR *) (Tcl_DStringValue(&dString) + offset), TEXT("%d"), suffix); + _sntprintf((TCHAR *) (Tcl_DStringValue(&dString) + offset), + TCL_INTEGER_SPACE, TEXT("%d"), suffix); } /* diff --git a/win/tclWinError.c b/win/tclWinError.c index 49eeed3..4d3250d 100644 --- a/win/tclWinError.c +++ b/win/tclWinError.c @@ -292,7 +292,7 @@ static const unsigned char errorTable[] = { */ static const unsigned char wsaErrorTable[] = { - EAGAIN, /* WSAEWOULDBLOCK */ + EWOULDBLOCK, /* WSAEWOULDBLOCK */ EINPROGRESS, /* WSAEINPROGRESS */ EALREADY, /* WSAEALREADY */ ENOTSOCK, /* WSAENOTSOCK */ diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index ac88861..2700cb3 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -67,25 +67,6 @@ const TclFileAttrProcs tclpFileAttrProcs[] = { {GetWinFileShortName, CannotSetAttribute}, {GetWinFileAttributes, SetWinFileAttributes}}; -#ifdef HAVE_NO_SEH - -/* - * Unlike Borland and Microsoft, we don't register exception handlers by - * pushing registration records onto the runtime stack. Instead, we register - * them by creating an EXCEPTION_REGISTRATION within the activation record. - */ - -typedef struct EXCEPTION_REGISTRATION { - struct EXCEPTION_REGISTRATION *link; - EXCEPTION_DISPOSITION (*handler)( - struct _EXCEPTION_RECORD *, void *, struct _CONTEXT *, void *); - void *ebp; - void *esp; - int status; -} EXCEPTION_REGISTRATION; - -#endif - /* * Prototype for the TraverseWinTree callback function. */ @@ -176,7 +157,7 @@ DoRenameFile( * (native). */ { #if defined(HAVE_NO_SEH) && !defined(_WIN64) - EXCEPTION_REGISTRATION registration; + TCLEXCEPTION_REGISTRATION registration; #endif DWORD srcAttr, dstAttr; int retval = -1; @@ -213,7 +194,7 @@ DoRenameFile( "movl %[nativeSrc], %%ecx" "\n\t" /* - * Construct an EXCEPTION_REGISTRATION to protect the call to + * Construct an TCLEXCEPTION_REGISTRATION to protect the call to * MoveFile. */ @@ -227,7 +208,7 @@ DoRenameFile( "movl $0, 0x10(%%edx)" "\n\t" /* status */ /* - * Link the EXCEPTION_REGISTRATION on the chain. + * Link the TCLEXCEPTION_REGISTRATION on the chain. */ "movl %%edx, %%fs:0" "\n\t" @@ -242,7 +223,7 @@ DoRenameFile( "call *%%eax" "\n\t" /* - * Come here on normal exit. Recover the EXCEPTION_REGISTRATION and + * Come here on normal exit. Recover the TCLEXCEPTION_REGISTRATION and * put the status return from MoveFile into it. */ @@ -251,7 +232,7 @@ DoRenameFile( "jmp 2f" "\n" /* - * Come here on an exception. Recover the EXCEPTION_REGISTRATION + * Come here on an exception. Recover the TCLEXCEPTION_REGISTRATION */ "1:" "\t" @@ -260,7 +241,7 @@ DoRenameFile( /* * Come here however we exited. Restore context from the - * EXCEPTION_REGISTRATION in case the stack is unbalanced. + * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" @@ -563,7 +544,7 @@ DoCopyFile( const TCHAR *nativeDst) /* Pathname of file to copy to (native). */ { #if defined(HAVE_NO_SEH) && !defined(_WIN64) - EXCEPTION_REGISTRATION registration; + TCLEXCEPTION_REGISTRATION registration; #endif int retval = -1; @@ -600,7 +581,7 @@ DoCopyFile( "movl %[nativeSrc], %%ecx" "\n\t" /* - * Construct an EXCEPTION_REGISTRATION to protect the call to + * Construct an TCLEXCEPTION_REGISTRATION to protect the call to * CopyFile. */ @@ -614,7 +595,7 @@ DoCopyFile( "movl $0, 0x10(%%edx)" "\n\t" /* status */ /* - * Link the EXCEPTION_REGISTRATION on the chain. + * Link the TCLEXCEPTION_REGISTRATION on the chain. */ "movl %%edx, %%fs:0" "\n\t" @@ -630,7 +611,7 @@ DoCopyFile( "call *%%eax" "\n\t" /* - * Come here on normal exit. Recover the EXCEPTION_REGISTRATION and + * Come here on normal exit. Recover the TCLEXCEPTION_REGISTRATION and * put the status return from CopyFile into it. */ @@ -639,7 +620,7 @@ DoCopyFile( "jmp 2f" "\n" /* - * Come here on an exception. Recover the EXCEPTION_REGISTRATION + * Come here on an exception. Recover the TCLEXCEPTION_REGISTRATION */ "1:" "\t" @@ -648,7 +629,7 @@ DoCopyFile( /* * Come here however we exited. Restore context from the - * EXCEPTION_REGISTRATION in case the stack is unbalanced. + * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" @@ -1105,49 +1086,6 @@ DoRemoveJustDirectory( SetFileAttributes(nativePath, attr | FILE_ATTRIBUTE_READONLY); } - - /* - * Windows 95 reports removing a non-empty directory as - * EACCES, not EEXIST. If the directory is not empty, change errno - * so caller knows what's going on. - */ - - if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) { - const char *path, *find; - HANDLE handle; - WIN32_FIND_DATAA data; - Tcl_DString buffer; - int len; - - path = (const char *) nativePath; - - Tcl_DStringInit(&buffer); - len = strlen(path); - find = Tcl_DStringAppend(&buffer, path, len); - if ((len > 0) && (find[len - 1] != '\\')) { - TclDStringAppendLiteral(&buffer, "\\"); - } - find = TclDStringAppendLiteral(&buffer, "*.*"); - handle = FindFirstFileA(find, &data); - if (handle != INVALID_HANDLE_VALUE) { - while (1) { - if ((strcmp(data.cFileName, ".") != 0) - && (strcmp(data.cFileName, "..") != 0)) { - /* - * Found something in this directory. - */ - - Tcl_SetErrno(EEXIST); - break; - } - if (FindNextFileA(handle, &data) == FALSE) { - break; - } - } - FindClose(handle); - } - Tcl_DStringFree(&buffer); - } } } diff --git a/win/tclWinFile.c b/win/tclWinFile.c index a1189f5..f69ad23 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -15,7 +15,6 @@ #include "tclWinInt.h" #include "tclFileSystem.h" #include <winioctl.h> -#include <sys/stat.h> #include <shlobj.h> #include <lm.h> /* For TclpGetUserHome(). */ @@ -160,7 +159,7 @@ static unsigned short NativeStatMode(DWORD attr, int checkLinks, int isExec); static int NativeIsExec(const TCHAR *path); static int NativeReadReparse(const TCHAR *LinkDirectory, - REPARSE_DATA_BUFFER *buffer); + REPARSE_DATA_BUFFER *buffer, DWORD desiredAccess); static int NativeWriteReparse(const TCHAR *LinkDirectory, REPARSE_DATA_BUFFER *buffer); static int NativeMatchType(int isDrive, DWORD attr, @@ -444,7 +443,7 @@ TclWinSymLinkCopyDirectory( DUMMY_REPARSE_BUFFER dummy; REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy; - if (NativeReadReparse(linkOrigPath, reparseBuffer)) { + if (NativeReadReparse(linkOrigPath, reparseBuffer, GENERIC_READ)) { return -1; } return NativeWriteReparse(linkCopyPath, reparseBuffer); @@ -542,7 +541,7 @@ WinReadLinkDirectory( if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) { goto invalidError; } - if (NativeReadReparse(linkDirPath, reparseBuffer)) { + if (NativeReadReparse(linkDirPath, reparseBuffer, 0)) { return NULL; } @@ -663,12 +662,13 @@ WinReadLinkDirectory( static int NativeReadReparse( const TCHAR *linkDirPath, /* The junction to read */ - REPARSE_DATA_BUFFER *buffer)/* Pointer to buffer. Cannot be NULL */ + REPARSE_DATA_BUFFER *buffer,/* Pointer to buffer. Cannot be NULL */ + DWORD desiredAccess) { HANDLE hFile; DWORD returnedLength; - hFile = CreateFile(linkDirPath, GENERIC_READ, 0, NULL, OPEN_EXISTING, + hFile = CreateFile(linkDirPath, desiredAccess, 0, NULL, OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL); if (hFile == INVALID_HANDLE_VALUE) { @@ -799,7 +799,7 @@ tclWinDebugPanic( WCHAR msgString[TCL_MAX_WARN_LEN]; va_start(argList, format); - _vsnprintf(buf, sizeof(buf), format, argList); + vsnprintf(buf, sizeof(buf), format, argList); msgString[TCL_MAX_WARN_LEN-1] = L'\0'; MultiByteToWideChar(CP_UTF8, 0, buf, -1, msgString, TCL_MAX_WARN_LEN); @@ -1537,14 +1537,9 @@ NativeAccess( * File might not exist. */ - WIN32_FIND_DATA ffd; - HANDLE hFind; - hFind = FindFirstFile(nativePath, &ffd); - if (hFind != INVALID_HANDLE_VALUE) { - attr = ffd.dwFileAttributes; - FindClose(hFind); - } else { - TclWinConvertError(GetLastError()); + DWORD lasterror = GetLastError(); + if (lasterror != ERROR_SHARING_VIOLATION) { + TclWinConvertError(lasterror); return -1; } } @@ -2002,15 +1997,17 @@ NativeStat( if (GetFileAttributesEx(nativePath, GetFileExInfoStandard, &data) != TRUE) { - /* - * We might have just been denied access - */ - + HANDLE hFind; WIN32_FIND_DATA ffd; - HANDLE hFind = FindFirstFile(nativePath, &ffd); + DWORD lasterror = GetLastError(); + if (lasterror != ERROR_SHARING_VIOLATION) { + TclWinConvertError(lasterror); + return -1; + } + hFind = FindFirstFile(nativePath, &ffd); if (hFind == INVALID_HANDLE_VALUE) { - Tcl_SetErrno(ENOENT); + TclWinConvertError(GetLastError()); return -1; } memcpy(&data, &ffd, sizeof(data)); @@ -2418,361 +2415,213 @@ TclpObjNormalizePath( Tcl_DStringInit(&dsNorm); path = Tcl_GetString(pathPtr); - if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) { - /* - * We're on Win95, 98 or ME. There are two assumptions in this block - * of code. First that the native (NULL) encoding is basically ascii, - * and second that symbolic links are not possible. Both of these - * assumptions appear to be true of these operating systems. - * - * FIXME: This code branch may be derelict as those are not supported - * platforms any more. - */ - - currentPathEndPosition = path + nextCheckpoint; - if (*currentPathEndPosition == '/') { - currentPathEndPosition++; - } - - while (1) { - char cur = *currentPathEndPosition; + currentPathEndPosition = path + nextCheckpoint; + if (*currentPathEndPosition == '/') { + currentPathEndPosition++; + } + while (1) { + char cur = *currentPathEndPosition; - if ((cur=='/' || cur==0) && (path != currentPathEndPosition)) { - /* - * Reached directory separator, or end of string. - */ + if ((cur=='/' || cur==0) && (path != currentPathEndPosition)) { + /* + * Reached directory separator, or end of string. + */ - const char *nativePath = Tcl_UtfToExternalDString(NULL, path, - currentPathEndPosition - path, &ds); + WIN32_FILE_ATTRIBUTE_DATA data; + const TCHAR *nativePath = Tcl_WinUtfToTChar(path, + currentPathEndPosition - path, &ds); + if (GetFileAttributesEx(nativePath, + GetFileExInfoStandard, &data) != TRUE) { /* - * Now we convert the tail of the current path to its 'long - * form', and append it to 'dsNorm' which holds the current - * normalized path, if the file exists. + * File doesn't exist. */ if (isDrive) { - if (GetFileAttributesA(nativePath) - == INVALID_FILE_ATTRIBUTES) { - /* - * File doesn't exist. - */ - - if (isDrive) { - int len = WinIsReserved(path); - - if (len > 0) { - /* - * Actually it does exist - COM1, etc. - */ - - int i; - - for (i=0 ; i<len ; i++) { - if (nativePath[i] >= 'a') { - ((char *) nativePath)[i] -= ('a'-'A'); - } - } - Tcl_DStringAppend(&dsNorm, nativePath, len); - lastValidPathEnd = currentPathEndPosition; - } - } - Tcl_DStringFree(&ds); - break; - } - if (nativePath[0] >= 'a') { - ((char *) nativePath)[0] -= ('a' - 'A'); - } - Tcl_DStringAppend(&dsNorm, nativePath, - Tcl_DStringLength(&ds)); - } else { - char *checkDots = NULL; - - if (lastValidPathEnd[1] == '.') { - checkDots = lastValidPathEnd + 1; - while (checkDots < currentPathEndPosition) { - if (*checkDots != '.') { - checkDots = NULL; - break; - } - checkDots++; - } - } - if (checkDots != NULL) { - int dotLen = currentPathEndPosition-lastValidPathEnd; + int len = WinIsReserved(path); + if (len > 0) { /* - * Path is just dots. We shouldn't really ever see a - * path like that. However, to be nice we at least - * don't mangle the path - we just add the dots as a - * path segment and continue + * Actually it does exist - COM1, etc. */ - Tcl_DStringAppend(&dsNorm, (const char *) - (nativePath + Tcl_DStringLength(&ds)-dotLen), - dotLen); - } else { - /* - * Normal path. - */ - - WIN32_FIND_DATAA fData; - HANDLE handle; + int i; - handle = FindFirstFileA(nativePath, &fData); - if (handle == INVALID_HANDLE_VALUE) { - if (GetFileAttributesA(nativePath) - == INVALID_FILE_ATTRIBUTES) { - /* - * File doesn't exist. - */ + for (i=0 ; i<len ; i++) { + WCHAR wc = ((WCHAR *) nativePath)[i]; - Tcl_DStringFree(&ds); - break; + if (wc >= L'a') { + wc -= (L'a' - L'A'); + ((WCHAR *) nativePath)[i] = wc; } - - /* - * This is usually the '/' in 'c:/' at end of - * string. - */ - - TclDStringAppendLiteral(&dsNorm, "/"); - } else { - char *nativeName; - - if (fData.cFileName[0] != '\0') { - nativeName = fData.cFileName; - } else { - nativeName = fData.cAlternateFileName; - } - FindClose(handle); - TclDStringAppendLiteral(&dsNorm, "/"); - Tcl_DStringAppend(&dsNorm, nativeName, -1); } + Tcl_DStringAppend(&dsNorm, + (const char *)nativePath, + (int)(sizeof(WCHAR) * len)); + lastValidPathEnd = currentPathEndPosition; + } else if (nextCheckpoint == 0) { + /* Path starts with a drive designation + * that's not actually on the system. + * We still must normalize up past the + * first separator. [Bug 3603434] */ + currentPathEndPosition++; } } Tcl_DStringFree(&ds); - lastValidPathEnd = currentPathEndPosition; - if (cur == 0) { - break; - } - - /* - * If we get here, we've got past one directory delimiter, so - * we know it is no longer a drive. - */ - - isDrive = 0; + break; } - currentPathEndPosition++; - } - } else { - /* - * We're on WinNT (or 2000 or XP; something with an NT core). - */ - currentPathEndPosition = path + nextCheckpoint; - if (*currentPathEndPosition == '/') { - currentPathEndPosition++; - } - while (1) { - char cur = *currentPathEndPosition; + /* + * File 'nativePath' does exist if we get here. We now want to + * check if it is a symlink and otherwise continue with the + * rest of the path. + */ - if ((cur=='/' || cur==0) && (path != currentPathEndPosition)) { - /* - * Reached directory separator, or end of string. - */ + /* + * Check for symlinks, except at last component of path (we + * don't follow final symlinks). Also a drive (C:/) for + * example, may sometimes have the reparse flag set for some + * reason I don't understand. We therefore don't perform this + * check for drives. + */ - WIN32_FILE_ATTRIBUTE_DATA data; - const TCHAR *nativePath = Tcl_WinUtfToTChar(path, - currentPathEndPosition - path, &ds); + if (cur != 0 && !isDrive && + data.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT){ + Tcl_Obj *to = WinReadLinkDirectory(nativePath); - if (GetFileAttributesEx(nativePath, - GetFileExInfoStandard, &data) != TRUE) { + if (to != NULL) { /* - * File doesn't exist. + * Read the reparse point ok. Now, reparse points need + * not be normalized, otherwise we could use: + * + * Tcl_GetStringFromObj(to, &pathLen); + * nextCheckpoint = pathLen; + * + * So, instead we have to start from the beginning. */ - if (isDrive) { - int len = WinIsReserved(path); - - if (len > 0) { - /* - * Actually it does exist - COM1, etc. - */ + nextCheckpoint = 0; + Tcl_AppendToObj(to, currentPathEndPosition, -1); - int i; - - for (i=0 ; i<len ; i++) { - WCHAR wc = ((WCHAR *) nativePath)[i]; + /* + * Convert link to forward slashes. + */ - if (wc >= L'a') { - wc -= (L'a' - L'A'); - ((WCHAR *) nativePath)[i] = wc; - } - } - Tcl_DStringAppend(&dsNorm, - (const char *)nativePath, - (int)(sizeof(WCHAR) * len)); - lastValidPathEnd = currentPathEndPosition; + for (path = Tcl_GetString(to); *path != 0; path++) { + if (*path == '\\') { + *path = '/'; } } - Tcl_DStringFree(&ds); - break; - } - - /* - * File 'nativePath' does exist if we get here. We now want to - * check if it is a symlink and otherwise continue with the - * rest of the path. - */ - - /* - * Check for symlinks, except at last component of path (we - * don't follow final symlinks). Also a drive (C:/) for - * example, may sometimes have the reparse flag set for some - * reason I don't understand. We therefore don't perform this - * check for drives. - */ + path = Tcl_GetString(to); + currentPathEndPosition = path + nextCheckpoint; + if (temp != NULL) { + Tcl_DecrRefCount(temp); + } + temp = to; - if (cur != 0 && !isDrive && - data.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT){ - Tcl_Obj *to = WinReadLinkDirectory(nativePath); + /* + * Reset variables so we can restart normalization. + */ - if (to != NULL) { - /* - * Read the reparse point ok. Now, reparse points need - * not be normalized, otherwise we could use: - * - * Tcl_GetStringFromObj(to, &pathLen); - * nextCheckpoint = pathLen; - * - * So, instead we have to start from the beginning. - */ + isDrive = 1; + Tcl_DStringFree(&dsNorm); + Tcl_DStringFree(&ds); + continue; + } + } - nextCheckpoint = 0; - Tcl_AppendToObj(to, currentPathEndPosition, -1); +#ifndef TclNORM_LONG_PATH + /* + * Now we convert the tail of the current path to its 'long + * form', and append it to 'dsNorm' which holds the current + * normalized path + */ - /* - * Convert link to forward slashes. - */ + if (isDrive) { + WCHAR drive = ((WCHAR *) nativePath)[0]; - for (path = Tcl_GetString(to); *path != 0; path++) { - if (*path == '\\') { - *path = '/'; - } - } - path = Tcl_GetString(to); - currentPathEndPosition = path + nextCheckpoint; - if (temp != NULL) { - Tcl_DecrRefCount(temp); + if (drive >= L'a') { + drive -= (L'a' - L'A'); + ((WCHAR *) nativePath)[0] = drive; + } + Tcl_DStringAppend(&dsNorm, (const char *)nativePath, + Tcl_DStringLength(&ds)); + } else { + char *checkDots = NULL; + + if (lastValidPathEnd[1] == '.') { + checkDots = lastValidPathEnd + 1; + while (checkDots < currentPathEndPosition) { + if (*checkDots != '.') { + checkDots = NULL; + break; } - temp = to; - - /* - * Reset variables so we can restart normalization. - */ - - isDrive = 1; - Tcl_DStringFree(&dsNorm); - Tcl_DStringFree(&ds); - continue; + checkDots++; } } + if (checkDots != NULL) { + int dotLen = currentPathEndPosition-lastValidPathEnd; -#ifndef TclNORM_LONG_PATH - /* - * Now we convert the tail of the current path to its 'long - * form', and append it to 'dsNorm' which holds the current - * normalized path - */ - - if (isDrive) { - WCHAR drive = ((WCHAR *) nativePath)[0]; + /* + * Path is just dots. We shouldn't really ever see a + * path like that. However, to be nice we at least + * don't mangle the path - we just add the dots as a + * path segment and continue. + */ - if (drive >= L'a') { - drive -= (L'a' - L'A'); - ((WCHAR *) nativePath)[0] = drive; - } - Tcl_DStringAppend(&dsNorm, (const char *)nativePath, - Tcl_DStringLength(&ds)); + Tcl_DStringAppend(&dsNorm, ((const char *)nativePath) + + Tcl_DStringLength(&ds) + - (dotLen * sizeof(TCHAR)), + (int)(dotLen * sizeof(TCHAR))); } else { - char *checkDots = NULL; - - if (lastValidPathEnd[1] == '.') { - checkDots = lastValidPathEnd + 1; - while (checkDots < currentPathEndPosition) { - if (*checkDots != '.') { - checkDots = NULL; - break; - } - checkDots++; - } - } - if (checkDots != NULL) { - int dotLen = currentPathEndPosition-lastValidPathEnd; + /* + * Normal path. + */ - /* - * Path is just dots. We shouldn't really ever see a - * path like that. However, to be nice we at least - * don't mangle the path - we just add the dots as a - * path segment and continue. - */ + WIN32_FIND_DATAW fData; + HANDLE handle; - Tcl_DStringAppend(&dsNorm, ((const char *)nativePath) - + Tcl_DStringLength(&ds) - - (dotLen * sizeof(TCHAR)), - (int)(dotLen * sizeof(TCHAR))); - } else { + handle = FindFirstFileW((WCHAR *) nativePath, &fData); + if (handle == INVALID_HANDLE_VALUE) { /* - * Normal path. + * This is usually the '/' in 'c:/' at end of + * string. */ - WIN32_FIND_DATAW fData; - HANDLE handle; - - handle = FindFirstFileW((WCHAR *) nativePath, &fData); - if (handle == INVALID_HANDLE_VALUE) { - /* - * This is usually the '/' in 'c:/' at end of - * string. - */ + Tcl_DStringAppend(&dsNorm, (const char *) L"/", + sizeof(WCHAR)); + } else { + WCHAR *nativeName; - Tcl_DStringAppend(&dsNorm, (const char *) L"/", - sizeof(WCHAR)); + if (fData.cFileName[0] != '\0') { + nativeName = fData.cFileName; } else { - WCHAR *nativeName; - - if (fData.cFileName[0] != '\0') { - nativeName = fData.cFileName; - } else { - nativeName = fData.cAlternateFileName; - } - FindClose(handle); - Tcl_DStringAppend(&dsNorm, (const char *) L"/", - sizeof(WCHAR)); - Tcl_DStringAppend(&dsNorm, - (const char *) nativeName, - (int) (wcslen(nativeName)*sizeof(WCHAR))); + nativeName = fData.cAlternateFileName; } + FindClose(handle); + Tcl_DStringAppend(&dsNorm, (const char *) L"/", + sizeof(WCHAR)); + Tcl_DStringAppend(&dsNorm, + (const char *) nativeName, + (int) (wcslen(nativeName)*sizeof(WCHAR))); } } + } #endif /* !TclNORM_LONG_PATH */ - Tcl_DStringFree(&ds); - lastValidPathEnd = currentPathEndPosition; - if (cur == 0) { - break; - } + Tcl_DStringFree(&ds); + lastValidPathEnd = currentPathEndPosition; + if (cur == 0) { + break; + } - /* - * If we get here, we've got past one directory delimiter, so - * we know it is no longer a drive. - */ + /* + * If we get here, we've got past one directory delimiter, so + * we know it is no longer a drive. + */ - isDrive = 0; - } - currentPathEndPosition++; + isDrive = 0; } + currentPathEndPosition++; #ifdef TclNORM_LONG_PATH /* diff --git a/win/tclWinInit.c b/win/tclWinInit.c index f552e2c..7b027c5 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -486,13 +486,10 @@ TclpSetInitialEncodings(void) Tcl_DStringFree(&encodingName); } -void -TclpSetInterfaces(void) +void TclWinSetInterfaces( + int dummy) /* Not used. */ { - int useWide; - - useWide = (TclWinGetPlatformId() != VER_PLATFORM_WIN32_WINDOWS); - TclWinSetInterfaces(useWide); + TclpSetInterfaces(); } const char * @@ -533,7 +530,7 @@ TclpSetVariables( SYSTEM_INFO info; OemId oemId; } sys; - OSVERSIONINFOA osInfo; + OSVERSIONINFOW osInfo; Tcl_DString ds; TCHAR szUserName[UNLEN+1]; DWORD cchUserNameLen = UNLEN; @@ -541,8 +538,8 @@ TclpSetVariables( Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL, TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY); - osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA); - GetVersionExA(&osInfo); + osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW); + GetVersionExW(&osInfo); GetSystemInfo(&sys.info); diff --git a/win/tclWinInt.h b/win/tclWinInt.h index 22ad8e9..c7066bb 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -14,6 +14,23 @@ #include "tclInt.h" +#ifdef HAVE_NO_SEH +/* + * Unlike Borland and Microsoft, we don't register exception handlers by + * pushing registration records onto the runtime stack. Instead, we register + * them by creating an TCLEXCEPTION_REGISTRATION within the activation record. + */ + +typedef struct TCLEXCEPTION_REGISTRATION { + struct TCLEXCEPTION_REGISTRATION *link; + EXCEPTION_DISPOSITION (*handler)( + struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*); + void *ebp; + void *esp; + int status; +} TCLEXCEPTION_REGISTRATION; +#endif + /* * Some versions of Borland C have a define for the OSVERSIONINFO for * Win32s and for NT, but not for Windows 95. @@ -33,12 +50,6 @@ # define TCL_I_MODIFIER "" #endif -#ifdef _WIN64 -# define TCL_I_MODIFIER "I" -#else -# define TCL_I_MODIFIER "" -#endif - /* * Declarations of functions that are not accessible by way of the * stubs table. diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 36ae58a..77fc776 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -12,8 +12,6 @@ #include "tclWinInt.h" -#include <sys/stat.h> - /* * The following variable is used to tell whether this module has been * initialized. @@ -1051,15 +1049,8 @@ TclpCreateProcess( * sink. */ - if ((TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) - && (applType == APPL_DOS)) { - if (CreatePipe(&h, &startInfo.hStdOutput, &secAtts, 0) != FALSE) { - CloseHandle(h); - } - } else { - startInfo.hStdOutput = CreateFileA("NUL:", GENERIC_WRITE, 0, - &secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL); - } + startInfo.hStdOutput = CreateFile(TEXT("NUL:"), GENERIC_WRITE, 0, + &secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL); } else { DuplicateHandle(hProcess, outputHandle, hProcess, &startInfo.hStdOutput, 0, TRUE, DUPLICATE_SAME_ACCESS); @@ -1078,7 +1069,7 @@ TclpCreateProcess( * sink. */ - startInfo.hStdError = CreateFileA("NUL:", GENERIC_WRITE, 0, + startInfo.hStdError = CreateFile(TEXT("NUL:"), GENERIC_WRITE, 0, &secAtts, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); } else { DuplicateHandle(hProcess, errorHandle, hProcess, &startInfo.hStdError, @@ -1893,7 +1884,7 @@ PipeClose2Proc( SetEvent(pipePtr->stopWriter); if (WaitForSingleObject(pipePtr->writable, 0) == WAIT_TIMEOUT) { - return EAGAIN; + return EWOULDBLOCK; } } else { @@ -2170,7 +2161,7 @@ PipeOutputProc( * the channel is in non-blocking mode. */ - errno = EAGAIN; + errno = EWOULDBLOCK; goto error; } @@ -2721,7 +2712,7 @@ WaitForRead( * is in non-blocking mode. */ - errno = EAGAIN; + errno = EWOULDBLOCK; return -1; } diff --git a/win/tclWinPort.h b/win/tclWinPort.h index 48f7894..61f149b 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -82,6 +82,7 @@ typedef DWORD_PTR * PDWORD_PTR; *--------------------------------------------------------------------------- */ +#include <time.h> #include <wchar.h> #include <io.h> #include <errno.h> @@ -92,11 +93,9 @@ typedef DWORD_PTR * PDWORD_PTR; #include <signal.h> #include <limits.h> -#ifndef strncasecmp -# define strncasecmp strnicmp -#endif -#ifndef strcasecmp -# define strcasecmp stricmp +#ifndef __GNUC__ +# define strncasecmp _strnicmp +# define strcasecmp _stricmp #endif /* @@ -114,8 +113,6 @@ typedef DWORD_PTR * PDWORD_PTR; # endif /* __BORLANDC__ */ #endif /* __MWERKS__ */ -#include <time.h> - /* * The following defines redefine the Windows Socket errors as * BSD errors so Tcl_PosixError can do the right thing. @@ -469,11 +466,12 @@ typedef DWORD_PTR * PDWORD_PTR; * including the *printf family and others. Tell it to shut up. * (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0) */ -#if _MSC_VER >= 1400 -#pragma warning(disable:4996) +#if defined(_MSC_VER) && (_MSC_VER >= 1400) +# pragma warning(disable:4244) +# pragma warning(disable:4267) +# pragma warning(disable:4996) #endif - /* *--------------------------------------------------------------------------- * The following macros and declarations represent the interface between diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 6ac5caf..327e4a3 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -13,9 +13,9 @@ */ #undef STATIC_BUILD -#undef USE_TCL_STUBS -#define USE_TCL_STUBS - +#ifndef USE_TCL_STUBS +# define USE_TCL_STUBS +#endif #include "tclInt.h" #ifdef _MSC_VER # pragma comment (lib, "advapi32.lib") diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index 458b05b..b9c9a9f 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -14,8 +14,6 @@ #include "tclWinInt.h" -#include <sys/stat.h> - /* * The following variable is used to tell whether this module has been * initialized. @@ -934,7 +932,7 @@ SerialInputProc( bufSize = cStat.cbInQue; } } else { - errno = *errorCode = EAGAIN; + errno = *errorCode = EWOULDBLOCK; return -1; } } else { @@ -1036,7 +1034,7 @@ SerialOutputProc( * the channel is in non-blocking mode. */ - errno = EAGAIN; + errno = EWOULDBLOCK; goto error1; } diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 1a74354..11b4162 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -1316,8 +1316,9 @@ CreateSocket( if (connect(sock, addrPtr->ai_addr, addrPtr->ai_addrlen) == SOCKET_ERROR) { - TclWinConvertError((DWORD) WSAGetLastError()); - if (Tcl_GetErrno() != EAGAIN) { + DWORD error = (DWORD) WSAGetLastError(); + if (error != WSAEWOULDBLOCK) { + TclWinConvertError(error); goto looperror; } @@ -1358,10 +1359,10 @@ CreateSocket( } error: - if (addrlist == NULL) { + if (addrlist != NULL) { freeaddrinfo(addrlist); } - if (myaddrlist == NULL) { + if (myaddrlist != NULL) { freeaddrinfo(myaddrlist); } @@ -1440,7 +1441,7 @@ WaitForSocketEvent( } else if (infoPtr->readyEvents & events) { break; } else if (infoPtr->flags & SOCKET_ASYNC) { - *errorCodePtr = EAGAIN; + *errorCodePtr = EWOULDBLOCK; result = 0; break; } @@ -1925,7 +1926,7 @@ TcpOutputProc( if (error == WSAEWOULDBLOCK) { infoPtr->readyEvents &= ~(FD_WRITE); if (infoPtr->flags & SOCKET_ASYNC) { - *errorCodePtr = EAGAIN; + *errorCodePtr = EWOULDBLOCK; bytesWritten = -1; break; } @@ -2735,6 +2736,7 @@ TclWinSetSockOpt( return setsockopt(s, level, optname, optval, optlen); } +#undef TclpInetNtoa char * TclpInetNtoa( struct in_addr addr) diff --git a/win/tclWinTest.c b/win/tclWinTest.c index 136c4db..b83c0ba 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -211,7 +211,7 @@ TestvolumetypeCmd( TclWinConvertError(GetLastError()); return TCL_ERROR; } - Tcl_SetResult(interp, volType, TCL_VOLATILE); + Tcl_AppendResult(interp, volType, NULL); return TCL_OK; #undef VOL_BUF_SIZE } diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index 7b0f6f8..1c9d483 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -14,7 +14,6 @@ #include "tclWinInt.h" #include <float.h> -#include <sys/stat.h> /* Workaround for mingw versions which don't provide this in float.h */ #ifndef _MCW_EM diff --git a/win/tclWinTime.c b/win/tclWinTime.c index daa229d..7045c72 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -280,7 +280,7 @@ NativeGetTime( Tcl_Time *timePtr, ClientData clientData) { - struct timeb t; + struct _timeb t; int useFtime = 1; /* Flag == TRUE if we need to fall back on * ftime rather than using the perf counter. */ @@ -446,7 +446,7 @@ NativeGetTime( * High resolution timer is not available. Just use ftime. */ - ftime(&t); + _ftime(&t); timePtr->sec = (long)t.time; timePtr->usec = t.millitm * 1000; } diff --git a/win/tclooConfig.sh b/win/tclooConfig.sh index 721825b..08cc4c5 100644 --- a/win/tclooConfig.sh +++ b/win/tclooConfig.sh @@ -16,4 +16,4 @@ TCLOO_STUB_LIB_SPEC="" TCLOO_INCLUDE_SPEC="" TCLOO_PRIVATE_INCLUDE_SPEC="" TCLOO_CFLAGS="" -TCLOO_VERSION=1.0 +TCLOO_VERSION=1.0.1 diff --git a/win/tclsh.exe.manifest.in b/win/tclsh.exe.manifest.in new file mode 100644 index 0000000..aaa34e1 --- /dev/null +++ b/win/tclsh.exe.manifest.in @@ -0,0 +1,33 @@ +<?xml version="1.0" encoding="UTF-8" standalone="yes"?> +<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0" + xmlns:asmv3="urn:schemas-microsoft-com:asm.v3"> + <assemblyIdentity + version="@TCL_WIN_VERSION@" + processorArchitecture="@MACHINE@" + name="Tcl.tclsh" + type="win32" + /> + <description>Tcl command line shell (tclsh)</description> + <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3"> + <security> + <requestedPrivileges> + <requestedExecutionLevel + level="asInvoker" + uiAccess="false" + /> + </requestedPrivileges> + </security> + </trustInfo> + <compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1"> + <application> + <!-- Windows 8.1 --> + <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/> + <!-- Windows 8 --> + <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/> + <!-- Windows 7 --> + <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/> + <!-- Windows Vista --> + <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/> + </application> + </compatibility> +</assembly> diff --git a/win/tclsh.rc b/win/tclsh.rc index 16eaf83..161da50 100644 --- a/win/tclsh.rc +++ b/win/tclsh.rc @@ -1,3 +1,4 @@ +// // Version Resource Script // @@ -67,3 +68,15 @@ END // tclsh ICON DISCARDABLE "tclsh.ico" + +// +// This is needed for Windows 8.1 onwards. +// + +#ifndef RT_MANIFEST +#define RT_MANIFEST 24 +#endif +#ifndef CREATEPROCESS_MANIFEST_RESOURCE_ID +#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1 +#endif +CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST "tclsh.exe.manifest" |