summaryrefslogtreecommitdiffstats
path: root/doc/src/snippets/code/src.scripttools.qscriptenginedebugger.cpp
diff options
context:
space:
mode:
authorck <qt-info@nokia.com>2010-02-02 08:04:39 (GMT)
committerck <qt-info@nokia.com>2010-02-02 08:04:39 (GMT)
commit0a9edf7a672b4a30b817439ad67a0e08e3670e8f (patch)
tree63cd6a33baf941ffd234e26b06cf17cf6eb326cc /doc/src/snippets/code/src.scripttools.qscriptenginedebugger.cpp
parent470b2de3e24b8eca056a31728a5e1039a9a25d79 (diff)
downloadQt-0a9edf7a672b4a30b817439ad67a0e08e3670e8f.zip
Qt-0a9edf7a672b4a30b817439ad67a0e08e3670e8f.tar.gz
Qt-0a9edf7a672b4a30b817439ad67a0e08e3670e8f.tar.bz2
Webkit: Fix missing namespace.
Diffstat (limited to 'doc/src/snippets/code/src.scripttools.qscriptenginedebugger.cpp')
0 files changed, 0 insertions, 0 deletions
606683 Tcl is a high-level, general-purpose, interpreted, dynamic programming language. It was designed with the goal of being very simple but powerful.
summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.fossil-settings/binary-glob3
-rw-r--r--.fossil-settings/crnl-glob0
-rw-r--r--.fossil-settings/ignore-glob24
-rw-r--r--.project11
-rw-r--r--.settings/org.eclipse.core.resources.prefs2
-rw-r--r--.settings/org.eclipse.core.runtime.prefs2
-rw-r--r--ChangeLog529
-rw-r--r--README31
-rw-r--r--changes141
-rw-r--r--compat/fake-rfc2553.c6
-rw-r--r--compat/zlib/CMakeLists.txt52
-rw-r--r--compat/zlib/ChangeLog63
-rw-r--r--compat/zlib/Makefile.in20
-rw-r--r--compat/zlib/README6
-rw-r--r--compat/zlib/as400/bndsrc10
-rw-r--r--compat/zlib/as400/compile.clp2
-rw-r--r--compat/zlib/as400/readme.txt2
-rw-r--r--compat/zlib/as400/zlib.inc14
-rw-r--r--compat/zlib/compress.c2
-rwxr-xr-xcompat/zlib/configure171
-rw-r--r--compat/zlib/contrib/README.contrib1
-rw-r--r--compat/zlib/contrib/blast/blast.c8
-rw-r--r--compat/zlib/contrib/blast/blast.h8
-rw-r--r--compat/zlib/contrib/delphi/ZLib.pas2
-rw-r--r--compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs4
-rw-r--r--compat/zlib/contrib/infback9/infback9.c4
-rw-r--r--compat/zlib/contrib/infback9/inftree9.c6
-rw-r--r--compat/zlib/contrib/minizip/configure.ac2
-rw-r--r--compat/zlib/contrib/minizip/crypt.h8
-rw-r--r--compat/zlib/contrib/minizip/iowin32.c98
-rw-r--r--compat/zlib/contrib/minizip/miniunzip.163
-rw-r--r--compat/zlib/contrib/minizip/minizip.146
-rw-r--r--compat/zlib/contrib/minizip/unzip.c12
-rw-r--r--compat/zlib/contrib/minizip/unzip.h4
-rw-r--r--compat/zlib/contrib/minizip/zip.c2
-rw-r--r--compat/zlib/contrib/pascal/zlibpas.pas4
-rw-r--r--compat/zlib/contrib/puff/puff.c7
-rw-r--r--compat/zlib/contrib/puff/puff.h4
-rw-r--r--compat/zlib/contrib/puff/pufftest.c4
-rw-r--r--compat/zlib/contrib/testzlib/testzlib.c4
-rw-r--r--compat/zlib/contrib/vstudio/readme.txt7
-rw-r--r--compat/zlib/contrib/vstudio/vc10/miniunz.vcxproj.user3
-rw-r--r--compat/zlib/contrib/vstudio/vc10/minizip.vcxproj.user3
-rw-r--r--compat/zlib/contrib/vstudio/vc10/testzlib.vcxproj.user3
-rw-r--r--compat/zlib/contrib/vstudio/vc10/testzlibdll.vcxproj.user3
-rw-r--r--compat/zlib/contrib/vstudio/vc10/zlib.rc10
-rw-r--r--compat/zlib/contrib/vstudio/vc10/zlibstat.vcxproj16
-rw-r--r--compat/zlib/contrib/vstudio/vc10/zlibstat.vcxproj.user3
-rw-r--r--compat/zlib/contrib/vstudio/vc10/zlibvc.def12
-rw-r--r--compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj30
-rw-r--r--compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj.user3
-rw-r--r--compat/zlib/contrib/vstudio/vc11/miniunz.vcxproj314
-rw-r--r--compat/zlib/contrib/vstudio/vc11/minizip.vcxproj311
-rw-r--r--compat/zlib/contrib/vstudio/vc11/testzlib.vcxproj426
-rw-r--r--compat/zlib/contrib/vstudio/vc11/testzlibdll.vcxproj314
-rw-r--r--compat/zlib/contrib/vstudio/vc11/zlib.rc32
-rw-r--r--compat/zlib/contrib/vstudio/vc11/zlibstat.vcxproj464
-rw-r--r--compat/zlib/contrib/vstudio/vc11/zlibvc.def143
-rw-r--r--compat/zlib/contrib/vstudio/vc11/zlibvc.sln117
-rw-r--r--compat/zlib/contrib/vstudio/vc11/zlibvc.vcxproj688
-rw-r--r--compat/zlib/contrib/vstudio/vc9/zlib.rc10
-rw-r--r--compat/zlib/contrib/vstudio/vc9/zlibvc.def14
-rw-r--r--compat/zlib/deflate.c12
-rw-r--r--compat/zlib/deflate.h2
-rw-r--r--compat/zlib/examples/enough.c39
-rw-r--r--compat/zlib/examples/gun.c11
-rw-r--r--compat/zlib/examples/gzappend.c22
-rw-r--r--compat/zlib/examples/gzjoin.c13
-rw-r--r--compat/zlib/examples/gzlog.c21
-rw-r--r--compat/zlib/examples/gzlog.h6
-rw-r--r--compat/zlib/examples/zran.c11
-rw-r--r--compat/zlib/gzguts.h22
-rw-r--r--compat/zlib/gzlib.c40
-rw-r--r--compat/zlib/gzread.c21
-rw-r--r--compat/zlib/gzwrite.c64
-rw-r--r--compat/zlib/infback.c2
-rw-r--r--compat/zlib/inffast.c6
-rw-r--r--compat/zlib/inflate.c64
-rw-r--r--compat/zlib/inftrees.c14
-rw-r--r--compat/zlib/qnx/package.qpg10
-rw-r--r--compat/zlib/test/example.c8
-rw-r--r--compat/zlib/test/minigzip.c20
-rw-r--r--compat/zlib/treebuild.xml4
-rw-r--r--compat/zlib/trees.c14
-rw-r--r--compat/zlib/uncompr.c2
-rw-r--r--compat/zlib/win32/Makefile.msc77
-rw-r--r--compat/zlib/win32/README-WIN32.txt4
-rw-r--r--compat/zlib/win32/README.txt17
-rw-r--r--compat/zlib/win32/zdll.libbin15256 -> 15658 bytes
-rw-r--r--compat/zlib/win32/zlib.def2
-rwxr-xr-x[-rw-r--r--]compat/zlib/win32/zlib1.dllbin107520 -> 107520 bytes
-rw-r--r--compat/zlib/win32/zlib1.rc2
-rw-r--r--compat/zlib/win64/libz.dll.abin0 -> 46874 bytes
-rw-r--r--compat/zlib/win64/zdll.libbin14896 -> 15288 bytes
-rwxr-xr-x[-rw-r--r--]compat/zlib/win64/zlib1.dllbin112640 -> 112640 bytes
-rw-r--r--compat/zlib/zconf.h33
-rw-r--r--compat/zlib/zconf.h.cmakein33
-rw-r--r--compat/zlib/zconf.h.in33
-rw-r--r--compat/zlib/zlib.36
-rw-r--r--compat/zlib/zlib.3.pdfbin8760 -> 8734 bytes
-rw-r--r--compat/zlib/zlib.h48
-rw-r--r--compat/zlib/zlib.map5
-rw-r--r--compat/zlib/zutil.c2
-rw-r--r--compat/zlib/zutil.h9
-rw-r--r--doc/Access.32
-rw-r--r--doc/AddErrInfo.314
-rw-r--r--doc/Alloc.32
-rw-r--r--doc/AllowExc.32
-rw-r--r--doc/AppInit.32
-rw-r--r--doc/AssocData.32
-rw-r--r--doc/Async.32
-rw-r--r--doc/BackgdErr.32
-rw-r--r--doc/Backslash.32
-rw-r--r--doc/BoolObj.32
-rw-r--r--doc/ByteArrObj.32
-rw-r--r--doc/CallDel.32
-rw-r--r--doc/Cancel.32
-rw-r--r--doc/ChnlStack.32
-rw-r--r--doc/Class.34
-rw-r--r--doc/CmdCmplt.32
-rw-r--r--doc/Concat.32
-rw-r--r--doc/CrtChannel.32
-rw-r--r--doc/CrtChnlHdlr.32
-rw-r--r--doc/CrtCloseHdlr.32
-rw-r--r--doc/CrtCommand.32
-rw-r--r--doc/CrtFileHdlr.32
-rw-r--r--doc/CrtInterp.39
-rw-r--r--doc/CrtMathFnc.32
-rw-r--r--doc/CrtObjCmd.32
-rw-r--r--doc/CrtSlave.32
-rw-r--r--doc/CrtTimerHdlr.32
-rw-r--r--doc/CrtTrace.32
-rw-r--r--doc/DString.32
-rw-r--r--doc/DetachPids.32
-rw-r--r--doc/DictObj.32
-rw-r--r--doc/DoOneEvent.32
-rw-r--r--doc/DoWhenIdle.32
-rw-r--r--doc/DoubleObj.32
-rw-r--r--doc/DumpActiveMemory.32
-rw-r--r--doc/Encoding.32
-rw-r--r--doc/Ensemble.32
-rw-r--r--doc/Environment.34
-rw-r--r--doc/Eval.32
-rw-r--r--doc/Exit.32
-rw-r--r--doc/ExprLong.32
-rw-r--r--doc/ExprLongObj.32
-rw-r--r--doc/FileSystem.32
-rw-r--r--doc/FindExec.32
-rw-r--r--[-rwxr-xr-x]doc/GetCwd.32
-rw-r--r--doc/GetHostName.32
-rw-r--r--doc/GetIndex.32
-rw-r--r--doc/GetInt.32
-rw-r--r--doc/GetOpnFl.32
-rw-r--r--doc/GetStdChan.32
-rw-r--r--doc/GetTime.32
-rw-r--r--[-rwxr-xr-x]doc/GetVersion.32
-rw-r--r--doc/Hash.32
-rw-r--r--doc/Init.32
-rw-r--r--doc/InitStubs.32
-rw-r--r--doc/IntObj.32
-rw-r--r--doc/Interp.32
-rw-r--r--doc/Limit.32
-rw-r--r--doc/LinkVar.32
-rw-r--r--doc/ListObj.32
-rw-r--r--doc/Load.32
-rw-r--r--doc/Method.37
-rw-r--r--doc/NRE.316
-rw-r--r--doc/Namespace.32
-rw-r--r--doc/Notifier.32
-rw-r--r--doc/OOInitStubs.354
-rw-r--r--doc/Object.32
-rw-r--r--doc/ObjectType.32
-rw-r--r--doc/OpenFileChnl.32
-rw-r--r--doc/OpenTcp.32
-rw-r--r--doc/Panic.32
-rw-r--r--doc/ParseArgs.32
-rw-r--r--doc/ParseCmd.32
-rw-r--r--doc/PkgRequire.32
-rw-r--r--doc/Preserve.32
-rw-r--r--doc/PrintDbl.32
-rw-r--r--doc/RecEvalObj.32
-rw-r--r--doc/RecordEval.32
-rw-r--r--doc/RegConfig.32
-rw-r--r--doc/RegExp.32
-rw-r--r--doc/SaveResult.32
-rw-r--r--doc/SetChanErr.32
-rw-r--r--doc/SetErrno.32
-rw-r--r--doc/SetRecLmt.32
-rw-r--r--doc/SetResult.32
-rw-r--r--doc/SetVar.32
-rw-r--r--doc/Signal.32
-rw-r--r--doc/Sleep.32
-rw-r--r--doc/SourceRCFile.32
-rw-r--r--doc/SplitList.32
-rw-r--r--doc/SplitPath.32
-rw-r--r--doc/StaticPkg.32
-rw-r--r--doc/StdChannels.32
-rw-r--r--doc/StrMatch.32
-rw-r--r--doc/StringObj.32
-rw-r--r--doc/SubstObj.32
-rw-r--r--doc/TCL_MEM_DEBUG.32
-rw-r--r--doc/Tcl.n43
-rw-r--r--doc/TclZlib.32
-rw-r--r--doc/Tcl_Main.32
-rw-r--r--doc/Thread.32
-rw-r--r--doc/ToUpper.32
-rw-r--r--doc/TraceCmd.32
-rw-r--r--doc/TraceVar.32
-rw-r--r--doc/Translate.32
-rw-r--r--doc/UniCharIsAlpha.32
-rw-r--r--doc/UpVar.32
-rw-r--r--doc/Utf.32
-rw-r--r--doc/WrongNumArgs.32
-rw-r--r--doc/after.n2
-rw-r--r--doc/append.n2
-rw-r--r--doc/apply.n2
-rw-r--r--doc/array.n2
-rw-r--r--doc/bgerror.n7
-rw-r--r--doc/binary.n28
-rw-r--r--doc/break.n2
-rw-r--r--doc/case.n2
-rw-r--r--doc/catch.n5
-rw-r--r--doc/cd.n2
-rw-r--r--doc/chan.n2
-rw-r--r--doc/class.n2
-rw-r--r--doc/clock.n2
-rw-r--r--doc/close.n2
-rw-r--r--doc/concat.n2
-rw-r--r--doc/continue.n2
-rw-r--r--doc/copy.n2
-rw-r--r--doc/coroutine.n2
-rw-r--r--doc/dde.n2
-rw-r--r--doc/define.n2
-rw-r--r--doc/dict.n2
-rw-r--r--doc/encoding.n36
-rw-r--r--doc/eof.n2
-rw-r--r--doc/error.n2
-rw-r--r--doc/eval.n5
-rw-r--r--doc/exec.n2
-rw-r--r--doc/exit.n2
-rw-r--r--doc/expr.n2
-rw-r--r--doc/fconfigure.n2
-rw-r--r--doc/fcopy.n29
-rw-r--r--doc/file.n9
-rw-r--r--doc/fileevent.n2
-rw-r--r--doc/filename.n2
-rw-r--r--doc/flush.n2
-rw-r--r--doc/for.n2
-rw-r--r--doc/foreach.n2
-rw-r--r--doc/format.n2
-rw-r--r--doc/gets.n2
-rw-r--r--doc/glob.n2
-rw-r--r--doc/global.n2
-rw-r--r--doc/history.n2
-rw-r--r--doc/http.n2
-rw-r--r--doc/if.n2
-rw-r--r--doc/incr.n2
-rw-r--r--doc/info.n14
-rw-r--r--doc/interp.n2
-rw-r--r--doc/join.n2
-rw-r--r--doc/lappend.n2
-rw-r--r--doc/lassign.n2
-rw-r--r--doc/library.n12
-rw-r--r--doc/lindex.n2
-rw-r--r--doc/linsert.n2
-rw-r--r--doc/list.n2
-rw-r--r--doc/llength.n2
-rw-r--r--doc/lmap.n2
-rw-r--r--doc/load.n2
-rw-r--r--doc/lrange.n2
-rw-r--r--doc/lrepeat.n2
-rw-r--r--doc/lreplace.n2
-rw-r--r--doc/lreverse.n2
-rw-r--r--doc/lsearch.n2
-rw-r--r--[-rwxr-xr-x]doc/lset.n2
-rw-r--r--doc/lsort.n2
-rw-r--r--doc/mathfunc.n2
-rw-r--r--doc/mathop.n2
-rw-r--r--doc/memory.n2
-rw-r--r--doc/msgcat.n11
-rw-r--r--doc/my.n2
-rw-r--r--doc/namespace.n4
-rw-r--r--doc/next.n13
-rw-r--r--doc/object.n2
-rw-r--r--doc/open.n2
-rw-r--r--doc/package.n2
-rw-r--r--doc/packagens.n2
-rw-r--r--doc/pid.n2
-rw-r--r--doc/pkgMkIndex.n2
-rw-r--r--doc/platform.n2
-rw-r--r--doc/platform_shell.n2
-rw-r--r--doc/prefix.n2
-rw-r--r--doc/proc.n2
-rw-r--r--doc/puts.n2
-rw-r--r--doc/pwd.n2
-rw-r--r--doc/read.n2
-rw-r--r--doc/refchan.n2
-rw-r--r--doc/regexp.n2
-rw-r--r--doc/registry.n2
-rw-r--r--doc/regsub.n2
-rw-r--r--doc/rename.n2
-rw-r--r--doc/return.n6
-rw-r--r--doc/safe.n2
-rw-r--r--doc/scan.n6
-rw-r--r--doc/seek.n2
-rw-r--r--doc/self.n2
-rw-r--r--doc/set.n2
-rw-r--r--doc/socket.n2
-rw-r--r--doc/source.n2
-rw-r--r--doc/split.n2
-rw-r--r--doc/string.n34
-rw-r--r--doc/subst.n2
-rw-r--r--doc/switch.n2
-rw-r--r--doc/tailcall.n2
-rw-r--r--doc/tclsh.110
-rw-r--r--doc/tcltest.n2
-rw-r--r--doc/tclvars.n4
-rw-r--r--doc/tell.n2
-rw-r--r--doc/throw.n4
-rw-r--r--doc/time.n2
-rw-r--r--doc/tm.n2
-rw-r--r--doc/trace.n2
-rw-r--r--doc/transchan.n2
-rw-r--r--doc/try.n4
-rw-r--r--doc/unknown.n2
-rw-r--r--doc/unload.n2
-rw-r--r--doc/unset.n2
-rw-r--r--doc/update.n2
-rw-r--r--doc/uplevel.n2
-rw-r--r--doc/upvar.n2
-rw-r--r--doc/variable.n2
-rw-r--r--doc/vwait.n2
-rw-r--r--doc/while.n2
-rw-r--r--doc/zlib.n2
-rw-r--r--generic/regc_color.c7
-rw-r--r--generic/regc_locale.c22
-rw-r--r--generic/regc_nfa.c339
-rw-r--r--generic/regcomp.c14
-rw-r--r--generic/regerrs.h1
-rw-r--r--generic/regex.h1
-rw-r--r--generic/regexec.c7
-rw-r--r--generic/regguts.h9
-rw-r--r--generic/tcl.h85
-rw-r--r--generic/tclAssembly.c170
-rw-r--r--generic/tclBasic.c1057
-rw-r--r--generic/tclBinary.c391
-rw-r--r--generic/tclCkalloc.c4
-rw-r--r--generic/tclClock.c38
-rw-r--r--generic/tclCmdAH.c10
-rw-r--r--generic/tclCmdIL.c123
-rw-r--r--generic/tclCmdMZ.c89
-rw-r--r--generic/tclCompCmds.c4141
-rw-r--r--generic/tclCompCmdsGR.c3171
-rw-r--r--generic/tclCompCmdsSZ.c1910
-rw-r--r--generic/tclCompExpr.c124
-rw-r--r--generic/tclCompile.c1831
-rw-r--r--generic/tclCompile.h343
-rw-r--r--generic/tclConfig.c107
-rw-r--r--generic/tclDate.c2
-rw-r--r--generic/tclDecls.h145
-rw-r--r--generic/tclDictObj.c56
-rw-r--r--generic/tclEncoding.c13
-rw-r--r--generic/tclEnsemble.c219
-rw-r--r--generic/tclEnv.c88
-rw-r--r--generic/tclEvent.c15
-rw-r--r--generic/tclExecute.c2096
-rw-r--r--generic/tclFCmd.c20
-rw-r--r--generic/tclFileName.c1
-rw-r--r--generic/tclGet.c2
-rw-r--r--generic/tclIO.c1232
-rw-r--r--generic/tclIO.h126
-rw-r--r--generic/tclIOCmd.c28
-rw-r--r--generic/tclIOGT.c127
-rw-r--r--generic/tclIORChan.c277
-rw-r--r--generic/tclIOUtil.c12
-rw-r--r--generic/tclIndexObj.c41
-rw-r--r--generic/tclInt.decls38
-rw-r--r--generic/tclInt.h242
-rw-r--r--generic/tclIntDecls.h53
-rw-r--r--generic/tclIntPlatDecls.h32
-rw-r--r--generic/tclInterp.c87
-rw-r--r--generic/tclLink.c21
-rw-r--r--generic/tclListObj.c16
-rw-r--r--generic/tclLiteral.c63
-rw-r--r--generic/tclLoad.c4
-rw-r--r--generic/tclLoadNone.c33
-rw-r--r--generic/tclMain.c6
-rw-r--r--generic/tclNamesp.c169
-rw-r--r--generic/tclNotify.c6
-rw-r--r--generic/tclOO.c14
-rw-r--r--generic/tclOO.decls20
-rw-r--r--generic/tclOO.h38
-rw-r--r--generic/tclOOBasic.c114
-rw-r--r--generic/tclOOCall.c11
-rw-r--r--generic/tclOODecls.h80
-rw-r--r--generic/tclOODefineCmds.c51
-rw-r--r--generic/tclOOInt.h6
-rw-r--r--generic/tclOOIntDecls.h41
-rw-r--r--generic/tclOOMethod.c75
-rw-r--r--generic/tclOOStubLib.c2
-rw-r--r--generic/tclObj.c117
-rw-r--r--generic/tclOptimize.c444
-rw-r--r--generic/tclPanic.c4
-rw-r--r--generic/tclParse.c15
-rw-r--r--generic/tclPathObj.c14
-rw-r--r--generic/tclPkg.c7
-rw-r--r--generic/tclPlatDecls.h14
-rw-r--r--generic/tclPort.h5
-rw-r--r--generic/tclProc.c131
-rw-r--r--generic/tclRegexp.c10
-rw-r--r--generic/tclResult.c7
-rw-r--r--generic/tclScan.c6
-rw-r--r--[-rwxr-xr-x]generic/tclStrToD.c4
-rw-r--r--generic/tclStringObj.c46
-rw-r--r--generic/tclStringTrim.h43
-rw-r--r--generic/tclStubInit.c157
-rw-r--r--generic/tclStubLibTbl.c58
-rw-r--r--generic/tclTest.c61
-rw-r--r--generic/tclTestObj.c8
-rw-r--r--generic/tclThread.c8
-rw-r--r--generic/tclThreadAlloc.c39
-rw-r--r--generic/tclThreadJoin.c4
-rw-r--r--generic/tclThreadTest.c21
-rw-r--r--generic/tclTimer.c2
-rw-r--r--generic/tclTomMathDecls.h8
-rw-r--r--generic/tclTrace.c15
-rw-r--r--generic/tclUniData.c196
-rw-r--r--generic/tclUtf.c47
-rw-r--r--generic/tclUtil.c19
-rw-r--r--generic/tclVar.c131
-rw-r--r--generic/tclZlib.c20
-rw-r--r--library/auto.tcl99
-rw-r--r--library/clock.tcl4
-rw-r--r--[-rwxr-xr-x]library/encoding/tis-620.enc0
-rw-r--r--library/http/http.tcl100
-rw-r--r--library/http/pkgIndex.tcl2
-rw-r--r--library/init.tcl97
-rw-r--r--library/msgcat/msgcat.tcl46
-rw-r--r--library/msgcat/pkgIndex.tcl2
-rw-r--r--[-rwxr-xr-x]library/msgs/af.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/af_za.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ar.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ar_in.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ar_jo.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ar_lb.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ar_sy.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/be.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/bg.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/bn.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/bn_in.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ca.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/cs.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/da.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/de.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/de_at.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/de_be.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/el.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_au.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_be.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_bw.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_ca.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_gb.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_hk.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_ie.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_in.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_nz.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_ph.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_sg.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_za.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/en_zw.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/eo.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_ar.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_bo.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_cl.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_co.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_cr.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_do.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_ec.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_gt.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_hn.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_mx.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_ni.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_pa.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_pe.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_pr.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_py.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_sv.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_uy.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/es_ve.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/et.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/eu.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/eu_es.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/fa.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/fa_in.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/fa_ir.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/fi.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/fo.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/fo_fo.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/fr.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/fr_be.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/fr_ca.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/fr_ch.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ga.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ga_ie.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/gl.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/gl_es.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/gv.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/gv_gb.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/he.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/hi.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/hi_in.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/hr.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/hu.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/id.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/id_id.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/is.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/it.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/it_ch.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ja.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/kl.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/kl_gl.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ko.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ko_kr.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/kok.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/kok_in.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/kw.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/kw_gb.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/lt.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/lv.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/mk.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/mr.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/mr_in.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ms.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ms_my.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/mt.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/nb.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/nl.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/nl_be.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/nn.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/pl.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/pt.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/pt_br.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ro.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ru.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ru_ua.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/sh.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/sk.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/sl.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/sq.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/sr.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/sv.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/sw.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ta.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/ta_in.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/te.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/te_in.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/th.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/tr.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/uk.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/vi.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/zh.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/zh_cn.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/zh_hk.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/zh_sg.msg0
-rw-r--r--[-rwxr-xr-x]library/msgs/zh_tw.msg0
-rw-r--r--library/package.tcl26
-rw-r--r--library/parray.tcl2
-rw-r--r--library/platform/pkgIndex.tcl2
-rw-r--r--library/platform/platform.tcl4
-rw-r--r--library/tcltest/pkgIndex.tcl2
-rw-r--r--library/tcltest/tcltest.tcl208
-rw-r--r--library/tm.tcl19
-rw-r--r--[-rwxr-xr-x]library/tzdata/Africa/Asmara0
-rw-r--r--library/tzdata/Africa/Cairo4
-rw-r--r--library/tzdata/Africa/Casablanca304
-rw-r--r--library/tzdata/Africa/Gaborone3
-rw-r--r--library/tzdata/Africa/Juba40
-rw-r--r--library/tzdata/Africa/Tripoli177
-rw-r--r--library/tzdata/America/Anguilla7
-rw-r--r--library/tzdata/America/Araguaina174
-rw-r--r--library/tzdata/America/Argentina/San_Luis2
-rw-r--r--library/tzdata/America/Aruba8
-rw-r--r--library/tzdata/America/Asuncion174
-rw-r--r--[-rwxr-xr-x]library/tzdata/America/Atikokan0
-rw-r--r--library/tzdata/America/Barbados6
-rw-r--r--[-rwxr-xr-x]library/tzdata/America/Blanc-Sablon0
-rw-r--r--library/tzdata/America/Bogota6
-rw-r--r--library/tzdata/America/Cayman4
-rw-r--r--library/tzdata/America/Costa_Rica6
-rw-r--r--library/tzdata/America/Curacao4
-rw-r--r--library/tzdata/America/Dominica7
-rw-r--r--library/tzdata/America/Grand_Turk4
-rw-r--r--library/tzdata/America/Grenada7
-rw-r--r--library/tzdata/America/Guadeloupe7
-rw-r--r--[-rwxr-xr-x]library/tzdata/America/Indiana/Petersburg0
-rw-r--r--[-rwxr-xr-x]library/tzdata/America/Indiana/Tell_City0
-rw-r--r--[-rwxr-xr-x]library/tzdata/America/Indiana/Vincennes0
-rw-r--r--[-rwxr-xr-x]library/tzdata/America/Indiana/Winamac0
-rw-r--r--library/tzdata/America/Jamaica6
-rw-r--r--library/tzdata/America/Marigot6
-rw-r--r--[-rwxr-xr-x]library/tzdata/America/Moncton0
-rw-r--r--library/tzdata/America/Montserrat7
-rw-r--r--library/tzdata/America/Nassau4
-rw-r--r--[-rwxr-xr-x]library/tzdata/America/North_Dakota/New_Salem0
-rw-r--r--library/tzdata/America/Port-au-Prince174
-rw-r--r--[-rwxr-xr-x]library/tzdata/America/Resolute0
-rw-r--r--library/tzdata/America/Santiago348
-rw-r--r--library/tzdata/America/St_Barthelemy6
-rw-r--r--library/tzdata/America/St_Kitts7
-rw-r--r--library/tzdata/America/St_Lucia8
-rw-r--r--library/tzdata/America/St_Thomas7
-rw-r--r--library/tzdata/America/St_Vincent8
-rw-r--r--library/tzdata/America/Tortola7
-rw-r--r--library/tzdata/America/Virgin6
-rw-r--r--library/tzdata/Antarctica/Macquarie9
-rw-r--r--library/tzdata/Antarctica/McMurdo258
-rw-r--r--library/tzdata/Antarctica/Palmer348
-rw-r--r--library/tzdata/Antarctica/South_Pole6
-rw-r--r--library/tzdata/Asia/Aden4
-rw-r--r--library/tzdata/Asia/Amman175
-rw-r--r--library/tzdata/Asia/Dili2
-rw-r--r--library/tzdata/Asia/Gaza189
-rw-r--r--library/tzdata/Asia/Hebron185
-rw-r--r--library/tzdata/Asia/Hong_Kong4
-rw-r--r--library/tzdata/Asia/Jakarta12
-rw-r--r--library/tzdata/Asia/Jayapura4
-rw-r--r--library/tzdata/Asia/Jerusalem178
-rw-r--r--library/tzdata/Asia/Khandyga72
-rw-r--r--library/tzdata/Asia/Makassar4
-rw-r--r--library/tzdata/Asia/Muscat4
-rw-r--r--library/tzdata/Asia/Pontianak12
-rw-r--r--library/tzdata/Asia/Rangoon4
-rw-r--r--library/tzdata/Asia/Shanghai4
-rw-r--r--library/tzdata/Asia/Ust-Nera70
-rw-r--r--library/tzdata/Atlantic/Bermuda4
-rw-r--r--[-rwxr-xr-x]library/tzdata/Atlantic/Faroe0
-rw-r--r--[-rwxr-xr-x]library/tzdata/Australia/Eucla0
-rw-r--r--library/tzdata/Europe/Busingen5
-rw-r--r--[-rwxr-xr-x]library/tzdata/Europe/Guernsey0
-rw-r--r--[-rwxr-xr-x]library/tzdata/Europe/Isle_of_Man0
-rw-r--r--[-rwxr-xr-x]library/tzdata/Europe/Jersey0
-rw-r--r--[-rwxr-xr-x]library/tzdata/Europe/Podgorica0
-rw-r--r--library/tzdata/Europe/Vaduz246
-rw-r--r--library/tzdata/Europe/Vienna4
-rw-r--r--[-rwxr-xr-x]library/tzdata/Europe/Volgograd0
-rw-r--r--library/tzdata/Europe/Zurich4
-rw-r--r--library/tzdata/Pacific/Easter348
-rw-r--r--library/tzdata/Pacific/Fiji82
-rw-r--r--library/tzdata/Pacific/Johnston6
-rw-r--r--library/word.tcl10
-rw-r--r--macosx/README4
-rw-r--r--macosx/tclMacOSXFCmd.c5
-rw-r--r--pkgs/README2
-rw-r--r--pkgs/package.list.txt11
-rw-r--r--tests/assemble.test3
-rw-r--r--tests/assocd.test30
-rw-r--r--tests/autoMkindex.test32
-rw-r--r--tests/basic.test32
-rw-r--r--tests/binary.test159
-rw-r--r--tests/chanio.test14
-rw-r--r--tests/clock.test9
-rw-r--r--tests/cmdAH.test16
-rw-r--r--tests/cmdIL.test9
-rw-r--r--tests/cmdInfo.test8
-rw-r--r--tests/compile.test100
-rw-r--r--tests/coroutine.test122
-rw-r--r--tests/dcall.test8
-rw-r--r--tests/dict.test93
-rw-r--r--tests/env.test29
-rw-r--r--tests/error.test162
-rw-r--r--tests/expr-old.test14
-rw-r--r--tests/fCmd.test16
-rw-r--r--tests/fileSystem.test23
-rw-r--r--tests/for.test376
-rw-r--r--tests/foreach.test11
-rw-r--r--tests/http.test39
-rw-r--r--tests/httpd2
-rw-r--r--tests/info.test434
-rw-r--r--tests/interp.test14
-rw-r--r--tests/io.test71
-rw-r--r--tests/ioCmd.test98
-rw-r--r--tests/ioTrans.test43
-rw-r--r--tests/iogt.test35
-rw-r--r--tests/listObj.test2
-rw-r--r--tests/lmap.test19
-rw-r--r--tests/load.test6
-rw-r--r--[-rwxr-xr-x]tests/lsetComp.test0
-rw-r--r--tests/main.test26
-rw-r--r--tests/misc.test7
-rw-r--r--tests/msgcat.test16
-rw-r--r--tests/namespace.test19
-rw-r--r--[-rwxr-xr-x]tests/notify.test0
-rw-r--r--tests/obj.test4
-rw-r--r--tests/oo.test154
-rw-r--r--tests/ooNext2.test2
-rw-r--r--tests/parse.test54
-rw-r--r--tests/parseExpr.test8
-rw-r--r--tests/parseOld.test22
-rw-r--r--tests/pkgMkIndex.test16
-rw-r--r--tests/platform.test17
-rw-r--r--tests/reg.test78
-rw-r--r--tests/regexp.test61
-rw-r--r--tests/rename.test7
-rw-r--r--tests/result.test6
-rw-r--r--tests/safe.test80
-rw-r--r--tests/scan.test772
-rw-r--r--tests/set-old.test5
-rw-r--r--tests/set.test5
-rw-r--r--tests/socket.test28
-rw-r--r--tests/source.test10
-rw-r--r--tests/stack.test6
-rw-r--r--tests/string.test15
-rw-r--r--tests/stringComp.test34
-rw-r--r--tests/subst.test4
-rw-r--r--[-rwxr-xr-x]tests/tcltest.test17
-rw-r--r--tests/thread.test22
-rw-r--r--tests/tm.test2
-rw-r--r--tests/trace.test368
-rw-r--r--tests/unixFCmd.test15
-rw-r--r--tests/unixForkEvent.test45
-rw-r--r--tests/unixInit.test16
-rw-r--r--tests/unknown.test10
-rw-r--r--tests/upvar.test43
-rw-r--r--tests/utf.test4
-rw-r--r--tests/var.test85
-rw-r--r--tests/winFCmd.test100
-rw-r--r--tests/winFile.test18
-rw-r--r--tests/winPipe.test8
-rw-r--r--tests/zlib.test49
-rw-r--r--[-rwxr-xr-x]tools/encoding/ebcdic.txt0
-rw-r--r--[-rwxr-xr-x]tools/encoding/tis-620.txt0
-rw-r--r--tools/genStubs.tcl11
-rw-r--r--tools/man2help2.tcl2
-rw-r--r--tools/tcltk-man2html-utils.tcl3
-rwxr-xr-xtools/tcltk-man2html.tcl9
-rw-r--r--tools/uniClass.tcl2
-rw-r--r--unix/Makefile.in180
-rw-r--r--unix/README5
-rwxr-xr-xunix/configure842
-rw-r--r--unix/configure.in22
-rw-r--r--unix/dltest/Makefile.in15
-rw-r--r--unix/dltest/pkgb.c4
-rw-r--r--unix/dltest/pkgooa.c141
-rw-r--r--unix/tcl.m4289
-rw-r--r--unix/tcl.pc.in8
-rw-r--r--unix/tcl.spec2
-rw-r--r--unix/tclAppInit.c22
-rw-r--r--unix/tclConfig.h.in18
-rw-r--r--unix/tclConfig.sh.in2
-rw-r--r--unix/tclUnixChan.c412
-rw-r--r--unix/tclUnixCompat.c15
-rw-r--r--unix/tclUnixFCmd.c195
-rw-r--r--unix/tclUnixFile.c13
-rw-r--r--unix/tclUnixInit.c31
-rw-r--r--unix/tclUnixNotfy.c125
-rw-r--r--unix/tclUnixPort.h66
-rw-r--r--unix/tclUnixSock.c21
-rw-r--r--unix/tclUnixTest.c58
-rw-r--r--unix/tclUnixThrd.c2
-rw-r--r--unix/tclUnixTime.c2
-rw-r--r--unix/tclXtNotify.c26
-rw-r--r--unix/tclooConfig.sh2
-rw-r--r--win/Makefile.in36
-rw-r--r--win/README4
-rw-r--r--[-rwxr-xr-x]win/buildall.vc.bat0
-rwxr-xr-xwin/configure59
-rw-r--r--win/configure.in25
-rw-r--r--win/makefile.bc30
-rw-r--r--win/makefile.vc14
-rw-r--r--win/tcl.m442
-rw-r--r--win/tclAppInit.c32
-rw-r--r--win/tclConfig.sh.in2
-rw-r--r--win/tclWin32Dll.c67
-rw-r--r--win/tclWinChan.c136
-rw-r--r--win/tclWinConsole.c12
-rw-r--r--win/tclWinDde.c8
-rw-r--r--win/tclWinError.c2
-rw-r--r--win/tclWinFCmd.c98
-rw-r--r--win/tclWinFile.c564
-rw-r--r--win/tclWinInit.c48
-rw-r--r--win/tclWinInt.h25
-rw-r--r--win/tclWinPipe.c27
-rw-r--r--win/tclWinPort.h27
-rw-r--r--win/tclWinReg.c6
-rw-r--r--win/tclWinSerial.c31
-rw-r--r--win/tclWinSock.c96
-rw-r--r--win/tclWinTest.c4
-rw-r--r--win/tclWinThrd.c1
-rw-r--r--win/tclWinTime.c4
-rw-r--r--win/tclooConfig.sh2
-rw-r--r--win/tclsh.exe.manifest.in33
-rw-r--r--win/tclsh.rc13
793 files changed, 24958 insertions, 14930 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
diff --git a/ChangeLog b/ChangeLog
index e56d8df..bb441a5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,493 @@
+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
@@ -55,7 +545,7 @@
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
+ 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>
@@ -120,8 +610,8 @@
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>
@@ -4532,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>
@@ -6387,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>
@@ -8347,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" ***
+ ******************************************************************
diff --git a/README b/README
index f8965b4..7004bc5 100644
--- a/README
+++ b/README
@@ -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
diff --git a/changes b/changes
index 63c3877..659319c 100644
--- a/changes
+++ b/changes
@@ -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
index 669b186..8e6f719 100644
--- a/compat/zlib/win32/zdll.lib
+++ b/compat/zlib/win32/zdll.lib
Binary files differ
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
index 9943b3e..9ea38d5 100644..100755
--- a/compat/zlib/win32/zlib1.dll
+++ b/compat/zlib/win32/zlib1.dll
Binary files differ
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
new file mode 100644
index 0000000..a3ae403
--- /dev/null
+++ b/compat/zlib/win64/libz.dll.a
Binary files differ
diff --git a/compat/zlib/win64/zdll.lib b/compat/zlib/win64/zdll.lib
index d7dfb09..ac9ffc9 100644
--- a/compat/zlib/win64/zdll.lib
+++ b/compat/zlib/win64/zdll.lib
Binary files differ
diff --git a/compat/zlib/win64/zlib1.dll b/compat/zlib/win64/zlib1.dll
index 631439b..bd1dbc6 100644..100755
--- a/compat/zlib/win64/zlib1.dll
+++ b/compat/zlib/win64/zlib1.dll
Binary files differ
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
index 485306c..a346b5d 100644
--- a/compat/zlib/zlib.3.pdf
+++ b/compat/zlib/zlib.3.pdf
Binary files differ
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 57bb76e..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
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..84cde650 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
diff --git a/doc/Eval.3 b/doc/Eval.3
index 0ecf7fa..c104f7a 100644
--- a/doc/Eval.3
+++ b/doc/Eval.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_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
diff --git a/doc/Exit.3 b/doc/Exit.3
index fd251c7..3ea09bf 100644
--- a/doc/Exit.3
+++ b/doc/Exit.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_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..100644
--- 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..100644
--- 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
diff --git a/doc/Hash.3 b/doc/Hash.3
index 73b89c5..fcc0d83a 100644
--- a/doc/Hash.3
+++ b/doc/Hash.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_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
diff --git a/doc/Init.3 b/doc/Init.3
index f421479..33c27a3 100644
--- a/doc/Init.3
+++ b/doc/Init.3
@@ -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 4dc62c6..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
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
diff --git a/doc/Load.3 b/doc/Load.3
index bbfc662..0ffaf57 100644
--- a/doc/Load.3
+++ b/doc/Load.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 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.
diff --git a/doc/NRE.3 b/doc/NRE.3
index 4ad78b3..a8ac477 100644
--- a/doc/NRE.3
+++ b/doc/NRE.3
@@ -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
diff --git a/doc/Tcl.n b/doc/Tcl.n
index 68146ab..c7fa9f6 100644
--- a/doc/Tcl.n
+++ b/doc/Tcl.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 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
diff --git a/doc/Utf.3 b/doc/Utf.3
index 55906e7..3b2ef91 100644
--- a/doc/Utf.3
+++ b/doc/Utf.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 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
diff --git a/doc/case.n b/doc/case.n
index 0155a61..54d5bf4 100644
--- a/doc/case.n
+++ b/doc/case.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 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:
diff --git a/doc/cd.n b/doc/cd.n
index eb3854c..67cdd17 100644
--- a/doc/cd.n
+++ b/doc/cd.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 cd 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/chan.n b/doc/chan.n
index c518455..12b2c81 100644
--- a/doc/chan.n
+++ b/doc/chan.n
@@ -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
diff --git a/doc/copy.n b/doc/copy.n
index f5002f8..100d564 100644
--- a/doc/copy.n
+++ b/doc/copy.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 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
diff --git a/doc/dde.n b/doc/dde.n
index 3fe0f87..37d491b 100644
--- a/doc/dde.n
+++ b/doc/dde.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 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
diff --git a/doc/dict.n b/doc/dict.n
index c014448..77c460b 100644
--- a/doc/dict.n
+++ b/doc/dict.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 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..5782199 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
@@ -14,10 +14,21 @@ encoding \- Manipulate encodings
.BE
.SH INTRODUCTION
.PP
-Strings in Tcl are encoded using 16-bit Unicode characters. Different
-operating system interfaces or applications may generate strings in
-other encodings such as Shift-JIS. The \fBencoding\fR command helps
-to bridge the gap between Unicode and these other formats.
+Strings in Tcl are logically a sequence of 16-bit Unicode characters.
+These strings are represented in memory as a sequence of bytes that
+may be in one of several encodings: modified UTF\-8 (which uses 1 to 3
+bytes per character), 16-bit
+.QW Unicode
+(which uses 2 bytes per character, with an endianness that is
+dependent on the host architecture), and binary (which uses a single
+byte per character but only handles a restricted range of characters).
+Tcl does not guarantee to always use the same encoding for the same
+string.
+.PP
+Different operating system interfaces or applications may generate
+strings in other encodings such as Shift\-JIS. The \fBencoding\fR
+command helps to bridge the gap between Unicode and these other
+formats.
.SH DESCRIPTION
.PP
Performs one of several encoding related operations, depending on
@@ -37,8 +48,9 @@ system encoding is used.
Convert \fIstring\fR from Unicode to the specified \fIencoding\fR.
The result is a sequence of bytes that represents the converted
string. Each byte is stored in the lower 8-bits of a Unicode
-character. If \fIencoding\fR is not specified, the current
-system encoding is used.
+character (indeed, the resulting string is a binary string as far as
+Tcl is concerned, at least initially). If \fIencoding\fR is not
+specified, the current system encoding is used.
.TP
\fBencoding dirs\fR ?\fIdirectoryList\fR?
.
@@ -56,6 +68,11 @@ searchable directory, that element is ignored.
.
Returns a list containing the names of all of the encodings that are
currently available.
+The encodings
+.QW utf-8
+and
+.QW iso8859-1
+are guaranteed to be present in the list.
.TP
\fBencoding system\fR ?\fIencoding\fR?
.
@@ -73,7 +90,7 @@ However, because the \fBsource\fR command always reads files using the
current system encoding, Tcl will only source such files correctly
when the encoding used to write the file is the same. This tends not
to be true in an internationalized setting. For example, if such a
-file was sourced in North America (where the ISO8859-1 is normally
+file was sourced in North America (where the ISO8859\-1 is normally
used), each byte in the file would be treated as a separate character
that maps to the 00 page in Unicode. The resulting Tcl strings will
not contain the expected Japanese characters. Instead, they will
@@ -93,3 +110,6 @@ which is the Hiragana letter HA.
Tcl_GetEncoding(3)
.SH KEYWORDS
encoding, unicode
+.\" Local Variables:
+.\" mode: nroff
+.\" End:
diff --git a/doc/eof.n b/doc/eof.n
index 017b10e..75f3c48 100644
--- a/doc/eof.n
+++ b/doc/eof.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 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
diff --git a/doc/eval.n b/doc/eval.n
index da88757..3ef5023 100644
--- a/doc/eval.n
+++ b/doc/eval.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 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:
diff --git a/doc/exec.n b/doc/exec.n
index 5072d61..c3f316b 100644
--- a/doc/exec.n
+++ b/doc/exec.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 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
diff --git a/doc/exit.n b/doc/exit.n
index ceb0529..ab5c87d 100644
--- a/doc/exit.n
+++ b/doc/exit.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 exit 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/expr.n b/doc/expr.n
index 8698f5c..a595207 100644
--- a/doc/expr.n
+++ b/doc/expr.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 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 550d071..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
diff --git a/doc/fcopy.n b/doc/fcopy.n
index 6a4bf1a..071896c 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
@@ -46,8 +46,11 @@ non-blocking mode; the \fBfcopy\fR command takes care of that automatically.
However, it is necessary to enter the event loop by using
the \fBvwait\fR command or by using Tk.
.PP
-You are not allowed to do other I/O operations with
-\fIinchan\fR or \fIoutchan\fR during a background \fBfcopy\fR.
+You are not allowed to do other input operations with \fIinchan\fR, or
+output operations with \fIoutchan\fR, during a background
+\fBfcopy\fR. The converse is entirely legitimate, as exhibited by the
+bidirectional fcopy example below.
+.PP
If either \fIinchan\fR or \fIoutchan\fR get closed
while the copy is in progress, the current copy is stopped
and the command callback is \fInot\fR made.
@@ -57,7 +60,7 @@ then all data already queued for \fIoutchan\fR is written out.
Note that \fIinchan\fR can become readable during a background copy.
You should turn off any \fBfileevent\fR handlers during a background
copy so those handlers do not interfere with the copy.
-Any I/O attempted by a \fBfileevent\fR handler will get a
+Any wrong-sided I/O attempted (by a \fBfileevent\fR handler or otherwise) will get a
.QW "channel busy"
error.
.PP
@@ -149,6 +152,24 @@ set total 0
-command [list CopyMore $in $out $chunk]
vwait done
.CE
+.PP
+The fourth example starts an asynchronous, bidirectional fcopy between
+two sockets. Those could also be pipes from two [open "|hal 9000" r+]
+(though their conversation would remain secret to the script, since
+all four fileevent slots are busy).
+.PP
+.CS
+set flows 2
+proc Done {dir args} {
+ global flows done
+ puts "$dir is over."
+ incr flows -1
+ if {$flows<=0} {set done 1}
+}
+\fBfcopy\fR $sok1 $sok2 -command [list Done UP]
+\fBfcopy\fR $sok2 $sok1 -command [list Done DOWN]
+vwait done
+.CE
.SH "SEE ALSO"
eof(n), fblocked(n), fconfigure(n), file(n)
.SH KEYWORDS
diff --git a/doc/file.n b/doc/file.n
index eef4647..5ff45fd 100644
--- a/doc/file.n
+++ b/doc/file.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 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 e453748..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
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
diff --git a/doc/for.n b/doc/for.n
index 4c65793..40c7cab 100644
--- a/doc/for.n
+++ b/doc/for.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 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
diff --git a/doc/gets.n b/doc/gets.n
index fe24058..0150f29 100644
--- a/doc/gets.n
+++ b/doc/gets.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 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
diff --git a/doc/glob.n b/doc/glob.n
index 7b71189..86e450b 100644
--- a/doc/glob.n
+++ b/doc/glob.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 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
diff --git a/doc/http.n b/doc/http.n
index 631a141..26054cd 100644
--- a/doc/http.n
+++ b/doc/http.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 "http" n 2.7 http "Tcl Bundled Packages"
+.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
diff --git a/doc/if.n b/doc/if.n
index 700f325..776f811 100644
--- a/doc/if.n
+++ b/doc/if.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 if 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/incr.n b/doc/incr.n
index 595cc27..9052c5a 100644
--- a/doc/incr.n
+++ b/doc/incr.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 incr 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/info.n b/doc/info.n
index e65a083..1ad908d 100644
--- a/doc/info.n
+++ b/doc/info.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 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
diff --git a/doc/join.n b/doc/join.n
index 1b23667..c8179bb 100644
--- a/doc/join.n
+++ b/doc/join.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 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
diff --git a/doc/list.n b/doc/list.n
index 5705254..c2797f3 100644
--- a/doc/list.n
+++ b/doc/list.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 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
diff --git a/doc/lmap.n b/doc/lmap.n
index 880b05a..2038fc2 100644
--- a/doc/lmap.n
+++ b/doc/lmap.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 lmap 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/load.n b/doc/load.n
index 350a2ae..2ab8f2e 100644
--- a/doc/load.n
+++ b/doc/load.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 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
diff --git a/doc/lset.n b/doc/lset.n
index 805de16..954bd30 100755..100644
--- a/doc/lset.n
+++ b/doc/lset.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 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
diff --git a/doc/my.n b/doc/my.n
index b5afc67..b91bc9a0 100644
--- a/doc/my.n
+++ b/doc/my.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 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
diff --git a/doc/next.n b/doc/next.n
index 0ad752a..7dacac2 100644
--- a/doc/next.n
+++ b/doc/next.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 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
diff --git a/doc/open.n b/doc/open.n
index d4842f2..0b1b83f 100644
--- a/doc/open.n
+++ b/doc/open.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 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
diff --git a/doc/pid.n b/doc/pid.n
index 97a42a7..a4df2f3 100644
--- a/doc/pid.n
+++ b/doc/pid.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 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
diff --git a/doc/proc.n b/doc/proc.n
index 570a37d..632485e 100644
--- a/doc/proc.n
+++ b/doc/proc.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 proc 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/puts.n b/doc/puts.n
index 4a53d44..01ca122 100644
--- a/doc/puts.n
+++ b/doc/puts.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 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
diff --git a/doc/pwd.n b/doc/pwd.n
index 65fed84..31d378f 100644
--- a/doc/pwd.n
+++ b/doc/pwd.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 pwd 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/read.n b/doc/read.n
index 007c0ac..87aa897 100644
--- a/doc/read.n
+++ b/doc/read.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 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:
diff --git a/doc/safe.n b/doc/safe.n
index ebd9b4d..76184a5 100644
--- a/doc/safe.n
+++ b/doc/safe.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 "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
diff --git a/doc/scan.n b/doc/scan.n
index cc5ed79..5b91449 100644
--- a/doc/scan.n
+++ b/doc/scan.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 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
diff --git a/doc/seek.n b/doc/seek.n
index 96d5c4e..02c5341 100644
--- a/doc/seek.n
+++ b/doc/seek.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 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
diff --git a/doc/self.n b/doc/self.n
index 2a04157..0ad5428 100644
--- a/doc/self.n
+++ b/doc/self.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 self 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/set.n b/doc/set.n
index 32a788e..545b15f 100644
--- a/doc/set.n
+++ b/doc/set.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 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..163abdd 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
@@ -343,10 +343,13 @@ misleading.
\fBstring bytelength \fIstring\fR
.
Returns a decimal string giving the number of bytes used to represent
-\fIstring\fR in memory. Because UTF\-8 uses one to three bytes to
-represent Unicode characters, the byte length will not be the same as
-the character length in general. The cases where a script cares about
-the byte length are rare.
+\fIstring\fR in memory when encoded as Tcl's internal modified UTF\-8;
+Tcl may use other encodings for \fIstring\fR as well, and does not
+guarantee to only use a single encoding for a particular \fIstring\fR.
+Because UTF\-8 uses a variable number of bytes to represent Unicode
+characters, the byte length will not be the same as the character
+length in general. The cases where a script cares about the byte
+length are rare.
.RS
.PP
In almost all cases, you should use the
@@ -354,10 +357,27 @@ In almost all cases, you should use the
Tcl byte array value). Refer to the \fBTcl_NumUtfChars\fR manual
entry for more details on the UTF\-8 representation.
.PP
+Formally, the \fBstring bytelength\fR operation returns the content of
+the \fIlength\fR field of the \fBTcl_Obj\fR structure, after calling
+\fBTcl_GetString\fR to ensure that the \fIbytes\fR field is populated.
+This is highly unlikely to be useful to Tcl scripts, as Tcl's internal
+encoding is not strict UTF\-8, but rather a modified CESU\-8 with a
+denormalized NUL (identical to that used in a number of places by
+Java's serialization mechanism) to enable basic processing with
+non-Unicode-aware C functions. As this representation should only
+ever be used by Tcl's implementation, the number of bytes used to
+store the representation is of very low value (except to C extension
+code, which has direct access for the purpose of memory management,
+etc.)
+.PP
\fICompatibility note:\fR it is likely that this subcommand will be
withdrawn in a future version of Tcl. It is better to use the
\fBencoding convertto\fR command to convert a string to a known
encoding and then apply \fBstring length\fR to that.
+.PP
+.CS
+\fBstring length\fR [encoding convertto utf-8 $theString]
+.CE
.RE
.TP
\fBstring wordend \fIstring charIndex\fR
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..9d7a4ce 100644
--- a/doc/tclvars.n
+++ b/doc/tclvars.n
@@ -5,12 +5,12 @@
'\" 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
-argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_library, tcl_nonwordchars, tcl_patchLevel, tcl_pkgPath, tcl_platform, tcl_precision, tcl_rcFileName, tcl_traceCompile, tcl_traceEval, tcl_wordchars, tcl_version \- Variables used by Tcl
+argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_library, tcl_nonwordchars, tcl_patchLevel, tcl_pkgPath, tcl_platform, tcl_precision, tcl_rcFileName, tcl_traceCompile, tcl_traceExec, tcl_wordchars, tcl_version \- Variables used by Tcl
.BE
.SH DESCRIPTION
.PP
diff --git a/doc/tell.n b/doc/tell.n
index 87e63b0..e8bf3af 100644
--- a/doc/tell.n
+++ b/doc/tell.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 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:
diff --git a/doc/time.n b/doc/time.n
index 52730a1..35b41c4 100644
--- a/doc/time.n
+++ b/doc/time.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 time 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/tm.n b/doc/tm.n
index ddfbac2..5602686 100644
--- a/doc/tm.n
+++ b/doc/tm.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 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
diff --git a/doc/try.n b/doc/try.n
index 393fe5b..834ccc1 100644
--- a/doc/try.n
+++ b/doc/try.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 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
diff --git a/doc/zlib.n b/doc/zlib.n
index 951b713..b8d0ee5 100644
--- a/doc/zlib.n
+++ b/doc/zlib.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 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 7155453..e557290 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"
/*
*----------------------------------------------------------------------------
@@ -67,15 +67,12 @@ extern "C" {
* We use this method because there is no autoconf equivalent.
*/
-#ifndef __WIN32__
-# if defined(_WIN32) || defined(WIN32) || defined(__MINGW32__) || defined(__BORLANDC__) || (defined(__WATCOMC__) && defined(__WINDOWS_386__))
+#ifdef _WIN32
+# ifndef __WIN32__
# define __WIN32__
-# ifndef WIN32
-# define WIN32
-# endif
-# ifndef _WIN32
-# define _WIN32
-# endif
+# endif
+# ifndef WIN32
+# define WIN32
# endif
#endif
@@ -83,11 +80,11 @@ extern "C" {
* STRICT: See MSDN Article Q83456
*/
-#ifdef __WIN32__
+#ifdef _WIN32
# ifndef STRICT
# define STRICT
# endif
-#endif /* __WIN32__ */
+#endif /* _WIN32 */
/*
* Utility macros: STRINGIFY takes an argument and wraps it in "" (double
@@ -168,7 +165,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__))
@@ -191,7 +188,7 @@ extern "C" {
* MSVCRT.
*/
-#if (defined(__WIN32__) && (defined(_MSC_VER) || (__BORLANDC__ >= 0x0550) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
+#if (defined(_WIN32) && (defined(_MSC_VER) || (defined(__BORLANDC__) && (__BORLANDC__ >= 0x0550)) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
# define HAVE_DECLSPEC 1
# ifdef STATIC_BUILD
# define DLLIMPORT
@@ -315,24 +312,26 @@ extern "C" {
* VOID. This block is skipped under Cygwin and Mingw.
*/
-#if defined(__WIN32__) && !defined(HAVE_WINNT_IGNORE_VOID)
+#if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID)
#ifndef VOID
#define VOID void
typedef char CHAR;
typedef short SHORT;
typedef long LONG;
#endif
-#endif /* __WIN32__ && !HAVE_WINNT_IGNORE_VOID */
+#endif /* _WIN32 && !HAVE_WINNT_IGNORE_VOID */
/*
* Macro to use instead of "void" for arguments that must have type "void *"
* in ANSI C; maps them to type "char *" in non-ANSI systems.
*/
-#ifndef NO_VOID
-# define VOID void
-#else
-# define VOID char
+#ifndef __VXWORKS__
+# ifndef NO_VOID
+# define VOID void
+# else
+# define VOID char
+# endif
#endif
/*
@@ -388,7 +387,7 @@ typedef long LONG;
*/
#if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG)
-# if defined(__WIN32__)
+# if defined(_WIN32)
# define TCL_WIDE_INT_TYPE __int64
# ifdef __BORLANDC__
# define TCL_LL_MODIFIER "L"
@@ -398,7 +397,7 @@ typedef long LONG;
# elif defined(__GNUC__)
# define TCL_WIDE_INT_TYPE long long
# define TCL_LL_MODIFIER "ll"
-# else /* ! __WIN32__ && ! __GNUC__ */
+# else /* ! _WIN32 && ! __GNUC__ */
/*
* Don't know what platform it is and configure hasn't discovered what is
* going on for us. Try to guess...
@@ -413,7 +412,7 @@ typedef long LONG;
# define TCL_WIDE_INT_TYPE long long
# endif
# endif /* NO_LIMITS_H */
-# endif /* __WIN32__ */
+# endif /* _WIN32 */
#endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */
#ifdef TCL_WIDE_INT_IS_LONG
# undef TCL_WIDE_INT_TYPE
@@ -445,7 +444,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
# define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val)))
#endif /* TCL_WIDE_INT_IS_LONG */
-#if defined(__WIN32__)
+#if defined(_WIN32)
# ifdef __BORLANDC__
typedef struct stati64 Tcl_StatBuf;
# elif defined(_WIN64)
@@ -456,7 +455,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 +471,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 +503,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
@@ -560,7 +559,7 @@ typedef struct Tcl_ZLibStream_ *Tcl_ZlibStream;
* will be called as the main fuction of the new thread created by that call.
*/
-#if defined __WIN32__
+#if defined _WIN32
typedef unsigned (__stdcall Tcl_ThreadCreateProc) (ClientData clientData);
#else
typedef void (Tcl_ThreadCreateProc) (ClientData clientData);
@@ -572,7 +571,7 @@ typedef void (Tcl_ThreadCreateProc) (ClientData clientData);
* in generic/tclThreadTest.c for it's usage.
*/
-#if defined __WIN32__
+#if defined _WIN32
# define Tcl_ThreadCreateType unsigned __stdcall
# define TCL_THREAD_CREATE_RETURN return 0
#else
@@ -2415,7 +2414,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,
@@ -2434,9 +2433,15 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
/*
* Include platform specific public function declarations that are accessible
- * via the stubs table.
+ * via the stubs table. Make all TclOO symbols MODULE_SCOPE (which only
+ * has effect on building it as a shared library). See ticket [3010352].
*/
+#if defined(BUILD_tcl)
+# undef TCLAPI
+# define TCLAPI MODULE_SCOPE
+#endif
+
#include "tclPlatDecls.h"
/*
@@ -2449,15 +2454,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 +2473,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
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 7833105..d1866c8 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -20,12 +20,13 @@
*- 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
*- syntax (?)
*- returnCodeBranch
+ *- tclooNext, tclooNextClass
*/
#include "tclInt.h"
@@ -49,7 +50,7 @@ typedef enum BasicBlockCatchState {
BBCS_UNKNOWN = 0, /* Catch context has not yet been identified */
BBCS_NONE, /* Block is outside of any catch */
BBCS_INCATCH, /* Block is within a catch context */
- BBCS_CAUGHT, /* Block is within a catch context and
+ BBCS_CAUGHT /* Block is within a catch context and
* may be executed after an exception fires */
} BasicBlockCatchState;
@@ -120,7 +121,7 @@ enum BasicBlockFlags {
* marking it as the start of a 'catch'
* sequence. The 'jumpTarget' is the exception
* exit from the catch block. */
- BB_ENDCATCH = (1 << 5), /* Block ends with an 'endCatch' instruction,
+ BB_ENDCATCH = (1 << 5) /* Block ends with an 'endCatch' instruction,
* unwinding the catch from the exception
* stack. */
};
@@ -183,7 +184,7 @@ typedef enum TalInstType {
* produces N */
ASSEM_SINT1, /* One 1-byte signed-integer operand
* (INCR_STK_IMM) */
- ASSEM_SINT4_LVT4, /* Signed 4-byte integer operand followed by
+ ASSEM_SINT4_LVT4 /* Signed 4-byte integer operand followed by
* LVT entry. Fixed arity */
} TalInstType;
@@ -324,29 +325,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 +350,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 +389,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 +415,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 +426,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 +438,8 @@ 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},
+ {"numericType", ASSEM_1BYTE, INST_NUM_TYPE, 1, 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 +455,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,12 +469,17 @@ 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},
{"tclooNamespace", ASSEM_1BYTE, INST_TCLOO_NS, 1, 1},
{"tclooSelf", ASSEM_1BYTE, INST_TCLOO_SELF, 0, 1},
+ {"tryCvtToBoolean", ASSEM_1BYTE, INST_TRY_CVT_TO_BOOLEAN,1, 2},
{"tryCvtToNumeric", ASSEM_1BYTE, INST_TRY_CVT_TO_NUMERIC,1, 1},
{"uminus", ASSEM_1BYTE, INST_UMINUS, 1, 1},
{"unset", ASSEM_BOOL_LVT4,INST_UNSET_SCALAR, 0, 0},
@@ -516,6 +506,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 +516,11 @@ 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 */
+ INST_NUM_TYPE /* 180 */
};
/*
@@ -673,7 +668,7 @@ BBEmitOpcode(
}
TclEmitInt1(op, envPtr);
- envPtr->atCmdStart = ((op) == INST_START_CMD);
+ TclUpdateAtCmdStart(op, envPtr);
BBUpdateStackReqs(bbPtr, tblIdx, count);
}
@@ -705,7 +700,7 @@ BBEmitInstInt4(
* BBEmitInst1or4 --
*
* Emits a 1- or 4-byte operation according to the magnitude of the
- * operand
+ * operand.
*
*-----------------------------------------------------------------------------
*/
@@ -734,7 +729,7 @@ BBEmitInst1or4(
} else {
TclEmitInt4(param, envPtr);
}
- envPtr->atCmdStart = ((op) == INST_START_CMD);
+ TclUpdateAtCmdStart(op, envPtr);
BBUpdateStackReqs(bbPtr, tblIdx, count);
}
@@ -798,12 +793,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 +834,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 +848,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 +876,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 +895,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 +948,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 +965,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 +1020,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 +1033,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 +1041,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 +1061,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 +1143,7 @@ NewAssemblyEnv(
assemEnvPtr->envPtr = envPtr;
assemEnvPtr->parsePtr = parsePtr;
- assemEnvPtr->cmdLine = envPtr->line;
+ assemEnvPtr->cmdLine = 1;
assemEnvPtr->clNext = envPtr->clNext;
/*
@@ -2667,6 +2635,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 +3066,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 +4239,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 +4307,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 6c53547..2a334c4 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,8 +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 EvalObjvCore;
+static Tcl_NRPostProc Dispatch;
static Tcl_ObjCmdProc NRCoroInjectObjCmd;
+static Tcl_NRPostProc NRPostInvoke;
MODULE_SCOPE const TclStubs tclStubs;
@@ -185,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:
*/
@@ -199,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, TclCompileYieldToCmd, 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}
};
@@ -481,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) {
@@ -509,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 */
@@ -768,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;
@@ -1000,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);
}
}
@@ -1589,8 +1612,6 @@ DeleteInterpProc(
ckfree(eclPtr->loc);
}
- Tcl_DeleteHashTable(&eclPtr->litInfo);
-
ckfree(eclPtr);
Tcl_DeleteHashEntry(hPtr);
}
@@ -2064,10 +2085,19 @@ Tcl_CreateCommand(
*/
cmdPtr = Tcl_GetHashValue(hPtr);
- oldRefPtr = cmdPtr->importRefPtr;
- cmdPtr->importRefPtr = NULL;
+ cmdPtr->refCount++;
+ if (cmdPtr->importRefPtr) {
+ cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
+ }
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
+
+ if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
+ oldRefPtr = cmdPtr->importRefPtr;
+ cmdPtr->importRefPtr = NULL;
+ }
+ TclCleanupCommandMacro(cmdPtr);
+
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (!isNew) {
/*
@@ -2156,12 +2186,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
@@ -2228,17 +2255,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;
}
@@ -2249,10 +2281,19 @@ Tcl_CreateObjCommand(
* intact.
*/
- oldRefPtr = cmdPtr->importRefPtr;
- cmdPtr->importRefPtr = NULL;
+ cmdPtr->refCount++;
+ if (cmdPtr->importRefPtr) {
+ cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
+ }
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
+
+ if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
+ oldRefPtr = cmdPtr->importRefPtr;
+ cmdPtr->importRefPtr = NULL;
+ }
+ TclCleanupCommandMacro(cmdPtr);
+
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (!isNew) {
/*
@@ -2391,8 +2432,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.
*
*----------------------------------------------------------------------
*/
@@ -3094,12 +3135,13 @@ Tcl_DeleteCommandFromToken(
* commands were created that refer back to this command. Delete these
* imported commands now.
*/
-
- for (refPtr = cmdPtr->importRefPtr; refPtr != NULL;
- refPtr = nextRefPtr) {
- nextRefPtr = refPtr->nextPtr;
- importCmd = (Tcl_Command) refPtr->importedCmdPtr;
- Tcl_DeleteCommandFromToken(interp, importCmd);
+ if (!(cmdPtr->flags & CMD_REDEF_IN_PROGRESS)) {
+ for (refPtr = cmdPtr->importRefPtr; refPtr != NULL;
+ refPtr = nextRefPtr) {
+ nextRefPtr = refPtr->nextPtr;
+ importCmd = (Tcl_Command) refPtr->importedCmdPtr;
+ Tcl_DeleteCommandFromToken(interp, importCmd);
+ }
}
/*
@@ -3335,66 +3377,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
@@ -4155,46 +4137,39 @@ TclNREvalObjv(
* requested Command struct to be invoked. */
{
Interp *iPtr = (Interp *) interp;
- int result;
- Namespace *lookupNsPtr = iPtr->lookupNsPtr;
- Command **cmdPtrPtr;
- NRE_callback *callbackPtr;
-
- 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->deferredCallbacks) {
- callbackPtr = iPtr->deferredCallbacks;
iPtr->deferredCallbacks = NULL;
} else {
TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
- callbackPtr = TOP_CB(interp);
}
- cmdPtrPtr = (Command **) &(callbackPtr->data[0]);
-
- callbackPtr->data[2] = INT2PTR(objc);
- callbackPtr->data[3] = (ClientData) objv;
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 +4179,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,34 +4343,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);
- }
+ iPtr->cmdCount++;
+ return objProc(clientData, interp, objc, objv);
}
int
@@ -4352,13 +4400,8 @@ NRCommand(
int result)
{
Interp *iPtr = (Interp *) interp;
- Command *cmdPtr = data[0];
- /* int cmdStart = PTR2INT(data[1]); NOT USED HERE */
- if (cmdPtr) {
- TclCleanupCommandMacro(cmdPtr);
- }
- ((Interp *)interp)->numLevels--;
+ iPtr->numLevels--;
/*
* If there is a tailcall, schedule it
@@ -4385,22 +4428,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);
-}
-
/*
*----------------------------------------------------------------------
@@ -4664,27 +4691,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 +4720,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 +4745,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 +4763,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 +4773,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 +4800,6 @@ TEOV_LookupCmdFromObj(
if (lookupNsPtr) {
iPtr->varFramePtr->nsPtr = lookupNsPtr;
- iPtr->lookupNsPtr = NULL;
}
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, namePtr);
iPtr->varFramePtr->nsPtr = savedNsPtr;
@@ -5000,31 +5018,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 +5076,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 +5244,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 +5339,7 @@ TclEvalEx(
Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
commandLength);
}
+ posterror:
iPtr->flags &= ~ERR_ALREADY_LOGGED;
/*
@@ -5597,76 +5614,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.
+ */
+
+ 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.
+ */
- Tcl_SetHashValue(hPtr, cfwPtr);
+ cfwPtr->prevPtr = Tcl_GetHashValue(hPtr);
}
- } /* for */
- cfPtr->litarg = lastPtr;
- } /* if */
+ Tcl_SetHashValue(hPtr, cfwPtr);
+ }
+ } /* for */
+
+ cfPtr->litarg = lastPtr;
}
/*
@@ -5814,6 +5843,7 @@ TclArgumentGet(
*----------------------------------------------------------------------
*/
+#undef Tcl_Eval
int
Tcl_Eval(
Tcl_Interp *interp, /* Token for command interpreter (returned by
@@ -5849,6 +5879,7 @@ Tcl_Eval(
*----------------------------------------------------------------------
*/
+#undef Tcl_EvalObj
int
Tcl_EvalObj(
Tcl_Interp *interp,
@@ -5856,6 +5887,7 @@ Tcl_EvalObj(
{
return Tcl_EvalObjEx(interp, objPtr, 0);
}
+#undef Tcl_GlobalEvalObj
int
Tcl_GlobalEvalObj(
Tcl_Interp *interp,
@@ -5873,6 +5905,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
@@ -5941,13 +5978,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
@@ -5955,11 +5991,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).
*/
/*
@@ -5968,13 +5999,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) {
/*
@@ -5997,22 +6028,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;
}
TclMarkTailcall(interp);
TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
- NULL, NULL);
+ objPtr, NULL);
ListObjGetElements(listPtr, objc, objv);
return TclNREvalObjv(interp, objc, objv, flags, NULL);
@@ -6052,14 +6086,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;
@@ -6083,92 +6109,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.
- */
-
- 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.
- */
+ assert(invoker == NULL);
- 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->scriptCLLocPtr = TclContinuationsGet(objPtr);
- 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;
}
}
@@ -6228,6 +6181,7 @@ TEOEx_ListCallback(
Interp *iPtr = (Interp *) interp;
Tcl_Obj *listPtr = data[0];
CmdFrame *eoFramePtr = data[1];
+ Tcl_Obj *objPtr = data[2];
/*
* Remove the cmdFrame
@@ -6237,6 +6191,7 @@ TEOEx_ListCallback(
iPtr->cmdFramePtr = eoFramePtr->nextPtr;
TclStackFree(interp, eoFramePtr);
}
+ TclDecrRefCount(objPtr);
TclDecrRefCount(listPtr);
return result;
@@ -6599,30 +6554,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;
@@ -6638,36 +6595,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;
}
@@ -6744,6 +6692,7 @@ Tcl_ExprString(
*----------------------------------------------------------------------
*/
+#undef Tcl_AddObjErrorInfo
void
Tcl_AppendObjToErrorInfo(
Tcl_Interp *interp, /* Interpreter to which error information
@@ -6777,6 +6726,7 @@ Tcl_AppendObjToErrorInfo(
*----------------------------------------------------------------------
*/
+#undef Tcl_AddErrorInfo
void
Tcl_AddErrorInfo(
Tcl_Interp *interp, /* Interpreter to which error information
@@ -6957,6 +6907,7 @@ Tcl_VarEval(
*----------------------------------------------------------------------
*/
+#undef Tcl_GlobalEval
int
Tcl_GlobalEval(
Tcl_Interp *interp, /* Interpreter in which to evaluate
@@ -7475,7 +7426,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);
@@ -8115,39 +8066,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);
}
/*
@@ -8240,7 +8163,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);
}
/*****************************************************************************
@@ -8511,8 +8435,7 @@ TclNRYieldToObjCmd(
{
CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
Tcl_Obj *listPtr, *nsObjPtr;
- Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
- Tcl_Namespace *ns1Ptr;
+ Tcl_Namespace *nsPtr = TclGetCurrentNamespace(interp);
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
@@ -8526,11 +8449,13 @@ TclNRYieldToObjCmd(
return TCL_ERROR;
}
- /*
- * Add the tailcall in the caller env, then just yield.
- *
- * This is essentially code from TclNRTailcallObjCmd
- */
+ if (((Namespace *) nsPtr)->flags & NS_DYING) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "yieldto called in deleted namespace", -1));
+ Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
+ NULL);
+ return TCL_ERROR;
+ }
/*
* Add the tailcall in the caller env, then just yield.
@@ -8539,15 +8464,9 @@ TclNRYieldToObjCmd(
*/
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");
- }
TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
-
/*
* Add the callback in the caller's env, then instruct TEBC to yield.
*/
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 455b5a6..981f174 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[]);
@@ -139,9 +142,9 @@ static const EnsembleImplMap binaryMap[] = {
{ NULL, NULL, NULL, NULL, NULL, 0 }
};
static const EnsembleImplMap encodeMap[] = {
- { "hex", BinaryEncodeHex, TclCompileBasic1ArgCmd, NULL, (ClientData)HexDigits, 0 },
- { "uuencode", BinaryEncode64, NULL, NULL, (ClientData)UueDigits, 0 },
- { "base64", BinaryEncode64, NULL, NULL, (ClientData)B64Digits, 0 },
+ { "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[] = {
@@ -204,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)
+
/*
*----------------------------------------------------------------------
@@ -325,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;
@@ -420,7 +424,7 @@ Tcl_SetByteArrayLength(
byteArrayPtr->allocated = length;
SET_BYTEARRAY(objPtr, byteArrayPtr);
}
- Tcl_InvalidateStringRep(objPtr);
+ TclInvalidateStringRep(objPtr);
byteArrayPtr->used = length;
return byteArrayPtr->bytes;
}
@@ -606,9 +610,7 @@ UpdateStringOfByteArray(
*
* This function appends an array of bytes to a byte array object. Note
* that the object *must* be unshared, and the array of bytes *must not*
- * refer to the object being appended to. Also the caller must have
- * already checked that the final length of the bytearray after the
- * append operations is complete will not overflow the int range.
+ * refer to the object being appended to.
*
* Results:
* None.
@@ -627,6 +629,7 @@ TclAppendBytesToByteArray(
int len)
{
ByteArray *byteArrayPtr;
+ int needed;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
@@ -635,64 +638,57 @@ TclAppendBytesToByteArray(
Tcl_Panic("%s must be called with definite number of bytes to append",
"TclAppendBytesToByteArray");
}
+ if (len == 0) {
+ /* Append zero bytes is a no-op. */
+ return;
+ }
if (objPtr->typePtr != &tclByteArrayType) {
SetByteArrayFromAny(NULL, objPtr);
}
byteArrayPtr = GET_BYTEARRAY(objPtr);
+ if (len > INT_MAX - byteArrayPtr->used) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
+
+ needed = byteArrayPtr->used + len;
/*
* If we need to, resize the allocated space in the byte array.
*/
- if (byteArrayPtr->used + len > byteArrayPtr->allocated) {
- unsigned int attempt, used = byteArrayPtr->used;
- ByteArray *tmpByteArrayPtr = NULL;
+ if (needed > byteArrayPtr->allocated) {
+ ByteArray *ptr = NULL;
+ int attempt;
- attempt = byteArrayPtr->allocated;
- if (attempt < 1) {
- /*
- * No allocated bytes, so must be none used too. We use this
- * method to calculate how many bytes to allocate because we can
- * end up with a zero-length buffer otherwise, when doubling can
- * cause trouble. [Bug 3067036]
- */
-
- attempt = len + 1;
- } else {
- do {
- attempt *= 2;
- } while (attempt < used+len);
+ if (needed <= INT_MAX/2) {
+ /* Try to allocate double the total space that is needed. */
+ attempt = 2 * needed;
+ ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
}
-
- if (BYTEARRAY_SIZE(attempt) > BYTEARRAY_SIZE(used)) {
- tmpByteArrayPtr = attemptckrealloc(byteArrayPtr,
- BYTEARRAY_SIZE(attempt));
+ if (ptr == NULL) {
+ /* Try to allocate double the increment that is needed (plus). */
+ unsigned int limit = INT_MAX - needed;
+ unsigned int extra = len + TCL_MIN_GROWTH;
+ int growth = (int) ((extra > limit) ? limit : extra);
+
+ attempt = needed + growth;
+ ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
}
-
- if (tmpByteArrayPtr == NULL) {
- attempt = used + len;
- if (BYTEARRAY_SIZE(attempt) < BYTEARRAY_SIZE(used)) {
- Tcl_Panic("attempt to allocate a bigger buffer than we can handle");
- }
- tmpByteArrayPtr = ckrealloc(byteArrayPtr,
- BYTEARRAY_SIZE(attempt));
+ if (ptr == NULL) {
+ /* Last chance: Try to allocate exactly what is needed. */
+ attempt = needed;
+ ptr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
}
-
- byteArrayPtr = tmpByteArrayPtr;
+ byteArrayPtr = ptr;
byteArrayPtr->allocated = attempt;
- byteArrayPtr->used = used;
SET_BYTEARRAY(objPtr, byteArrayPtr);
}
- /*
- * Do the append if there's any point.
- */
-
- if (len > 0) {
+ if (bytes) {
memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len);
- byteArrayPtr->used += len;
- Tcl_InvalidateStringRep(objPtr);
}
+ byteArrayPtr->used += len;
+ TclInvalidateStringRep(objPtr);
}
/*
@@ -2311,7 +2307,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) {
@@ -2323,8 +2318,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;
@@ -2385,29 +2380,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;
@@ -2435,7 +2433,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
@@ -2471,7 +2469,6 @@ BinaryEncode64(
{
Tcl_Obj *resultObj;
unsigned char *data, *cursor, *limit;
- const char *digits = clientData;
int maxlen = 0;
const char *wrapchar = "\n";
int wrapcharlen = 1;
@@ -2494,6 +2491,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);
@@ -2524,17 +2528,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]);
}
}
}
@@ -2546,6 +2550,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.
@@ -2569,8 +2692,8 @@ 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 };
@@ -2596,44 +2719,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;
}
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/tclClock.c b/generic/tclClock.c
index 6d2976d..15f29e5 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -19,7 +19,7 @@
* Windows has mktime. The configurators do not check.
*/
-#ifdef __WIN32__
+#ifdef _WIN32
#define HAVE_MKTIME 1
#endif
@@ -548,18 +548,21 @@ ClockGetjuliandayfromerayearmonthdayObjCmd(
}
dict = objv[1];
if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
|| Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
&era) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR],
- &fieldPtr) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
|| TclGetIntFromObj(interp, fieldPtr, &fields.year) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_MONTH],
- &fieldPtr) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_MONTH], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
|| TclGetIntFromObj(interp, fieldPtr, &fields.month) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH],
- &fieldPtr) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
|| TclGetIntFromObj(interp, fieldPtr, &fields.dayOfMonth)!=TCL_OK
|| TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
+ if (fieldPtr == NULL)
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1));
return TCL_ERROR;
}
fields.era = era;
@@ -638,18 +641,21 @@ ClockGetjuliandayfromerayearweekdayObjCmd(
}
dict = objv[1];
if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
|| Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
&era) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR],
- &fieldPtr) != TCL_OK
- || TclGetIntFromObj(interp, fieldPtr, &fields.iso8601Year)!=TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601WEEK],
- &fieldPtr) != TCL_OK
- || TclGetIntFromObj(interp, fieldPtr, &fields.iso8601Week)!=TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFWEEK],
- &fieldPtr) != TCL_OK
- || TclGetIntFromObj(interp, fieldPtr, &fields.dayOfWeek) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
+ || TclGetIntFromObj(interp, fieldPtr, &(fields.iso8601Year)) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601WEEK], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
+ || TclGetIntFromObj(interp, fieldPtr, &(fields.iso8601Week)) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFWEEK], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
+ || TclGetIntFromObj(interp, fieldPtr, &(fields.dayOfWeek)) != TCL_OK
|| TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
+ if (fieldPtr == NULL)
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1));
return TCL_ERROR;
}
fields.era = era;
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 820eec5..d90a747 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -11,7 +11,6 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#include <sys/stat.h>
#include "tclInt.h"
#include <locale.h>
@@ -195,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);
@@ -211,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;
}
}
@@ -1592,7 +1590,7 @@ FileAttrIsOwnedCmd(
* test for equivalence to the current user.
*/
-#if defined(__WIN32__) || defined(__CYGWIN__)
+#if defined(_WIN32) || defined(__CYGWIN__)
value = 1;
#else
value = (geteuid() == buf.st_uid);
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index c70ba23..41c1eb6 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -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 95debf8..00c9f2f 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -18,6 +18,7 @@
#include "tclInt.h"
#include "tclRegexp.h"
+#include "tclStringTrim.h"
static inline Tcl_Obj * During(Tcl_Interp *interp, int resultCode,
Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
@@ -37,32 +38,33 @@ static int UniCharIsHexDigit(int character);
* UTF-8 literal string containing all Unicode space characters [TIP #413]
*/
-#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) */\
+const char tclDefaultTrimSet[] =
+ "\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) */
+;
/*
*----------------------------------------------------------------------
@@ -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)) {
@@ -3188,8 +3191,8 @@ StringTrimCmd(
if (objc == 3) {
string2 = TclGetStringFromObj(objv[2], &length2);
} else if (objc == 2) {
- string2 = DEFAULT_TRIM_SET;
- length2 = strlen(DEFAULT_TRIM_SET);
+ string2 = tclDefaultTrimSet;
+ length2 = strlen(tclDefaultTrimSet);
} else {
Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
return TCL_ERROR;
@@ -3236,8 +3239,8 @@ StringTrimLCmd(
if (objc == 3) {
string2 = TclGetStringFromObj(objv[2], &length2);
} else if (objc == 2) {
- string2 = DEFAULT_TRIM_SET;
- length2 = strlen(DEFAULT_TRIM_SET);
+ string2 = tclDefaultTrimSet;
+ length2 = strlen(tclDefaultTrimSet);
} else {
Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
return TCL_ERROR;
@@ -3282,8 +3285,8 @@ StringTrimRCmd(
if (objc == 3) {
string2 = TclGetStringFromObj(objv[2], &length2);
} else if (objc == 2) {
- string2 = DEFAULT_TRIM_SET;
- length2 = strlen(DEFAULT_TRIM_SET);
+ string2 = tclDefaultTrimSet;
+ length2 = strlen(tclDefaultTrimSet);
} else {
Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
return TCL_ERROR;
@@ -3329,21 +3332,21 @@ TclInitStringCmd(
{"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0},
{"first", StringFirstCmd, TclCompileStringFirstCmd, NULL, NULL, 0},
{"index", StringIndexCmd, TclCompileStringIndexCmd, NULL, NULL, 0},
- {"is", StringIsCmd, NULL, NULL, NULL, 0},
+ {"is", StringIsCmd, TclCompileStringIsCmd, NULL, NULL, 0},
{"last", StringLastCmd, TclCompileStringLastCmd, NULL, NULL, 0},
{"length", StringLenCmd, TclCompileStringLenCmd, NULL, NULL, 0},
{"map", StringMapCmd, TclCompileStringMapCmd, NULL, NULL, 0},
{"match", StringMatchCmd, TclCompileStringMatchCmd, NULL, NULL, 0},
{"range", StringRangeCmd, TclCompileStringRangeCmd, NULL, NULL, 0},
{"repeat", StringReptCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
- {"replace", StringRplcCmd, NULL, NULL, NULL, 0},
+ {"replace", StringRplcCmd, TclCompileStringReplaceCmd, NULL, NULL, 0},
{"reverse", StringRevCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
- {"tolower", StringLowerCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
- {"toupper", StringUpperCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
- {"totitle", StringTitleCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
- {"trim", StringTrimCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
- {"trimleft", StringTrimLCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
- {"trimright", StringTrimRCmd, TclCompileBasic1Or2ArgCmd, 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 503f339..d1d7a80 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,67 +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 */
-#define TCL_NO_ELEMENT 2 /* Do not push the array element. */
-
/*
* The structures below define the AuxData types defined in this file.
*/
@@ -120,6 +52,13 @@ const AuxDataType tclForeachInfoType = {
PrintForeachInfo /* printProc */
};
+const AuxDataType tclNewForeachInfoType = {
+ "NewForeachInfo", /* name */
+ DupForeachInfo, /* dupProc */
+ FreeForeachInfo, /* freeProc */
+ PrintNewForeachInfo /* printProc */
+};
+
const AuxDataType tclDictUpdateInfoType = {
"DictUpdateInfo", /* name */
DupDictUpdateInfo, /* dupProc */
@@ -155,9 +94,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;
@@ -169,10 +109,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;
}
/*
@@ -186,7 +127,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
@@ -194,16 +135,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);
@@ -217,8 +155,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;
@@ -253,7 +221,7 @@ TclCompileArrayExistsCmd(
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
- int simpleVarName, isScalar, localIndex;
+ int isScalar, localIndex;
if (parsePtr->numWords != 2) {
return TCL_ERROR;
@@ -261,7 +229,7 @@ TclCompileArrayExistsCmd(
tokenPtr = TokenAfter(parsePtr->tokenPtr);
PushVarNameWord(interp, tokenPtr, envPtr, TCL_NO_ELEMENT,
- &localIndex, &simpleVarName, &isScalar, 1);
+ &localIndex, &isScalar, 1);
if (!isScalar) {
return TCL_ERROR;
}
@@ -284,37 +252,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);
- if (envPtr->procPtr == NULL) {
- Tcl_Token *tokPtr = TokenAfter(tokenPtr);
+ 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);
- if (tokPtr->type != TCL_TOKEN_SIMPLE_WORD || tokPtr[1].size != 0) {
- return TCL_ERROR;
- }
+ /*
+ * 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;
}
- PushVarNameWord(interp, tokenPtr, envPtr, TCL_NO_ELEMENT,
- &localIndex, &simpleVarName, &isScalar, 1);
+
+ /*
+ * 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);
@@ -323,33 +315,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;
@@ -359,73 +357,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
@@ -439,14 +412,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, TCL_NO_ELEMENT,
- &localIndex, &simpleVarName, &isScalar, 1);
+ &localIndex, &isScalar, 1);
if (!isScalar) {
return TCL_ERROR;
}
@@ -460,13 +433,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;
}
@@ -497,16 +470,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;
}
@@ -539,12 +530,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.
@@ -573,17 +562,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;
}
@@ -591,16 +570,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;
}
@@ -610,11 +580,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
@@ -627,83 +593,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) {
@@ -714,62 +659,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;
}
@@ -800,6 +801,9 @@ TclCompileContinueCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+ ExceptionRange *rangePtr;
+ ExceptionAux *auxPtr;
+
/*
* There should be no argument after the "continue".
*/
@@ -809,11 +813,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;
}
@@ -845,11 +865,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.
@@ -866,15 +884,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;
}
@@ -884,8 +894,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);
}
@@ -894,7 +903,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;
@@ -911,8 +920,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.
@@ -936,7 +944,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;
@@ -946,7 +954,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;
@@ -958,24 +966,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;
@@ -991,7 +991,7 @@ TclCompileDictGetCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr;
- int numWords, i;
+ int i;
DefineLineInformation; /* TIP #280 */
/*
@@ -999,21 +999,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;
}
@@ -1028,7 +1028,7 @@ TclCompileDictExistsCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr;
- int numWords, i;
+ int i;
DefineLineInformation; /* TIP #280 */
/*
@@ -1036,21 +1036,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;
}
@@ -1066,14 +1066,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;
}
@@ -1085,17 +1085,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);
}
/*
@@ -1184,12 +1176,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);
@@ -1227,8 +1219,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);
@@ -1245,11 +1238,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.
@@ -1266,7 +1259,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++) {
@@ -1308,6 +1301,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);
@@ -1366,18 +1360,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);
@@ -1385,7 +1376,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);
}
/*
@@ -1394,10 +1385,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);
}
}
@@ -1411,31 +1401,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);
}
/*
@@ -1445,9 +1426,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);
}
/*
@@ -1458,7 +1439,7 @@ CompileDictEachCmd(
*/
if (collect == TCL_EACH_COLLECT) {
- PushLiteral(envPtr, "", 0);
+ PushStringLiteral(envPtr, "");
Emit14Inst( INST_STORE_SCALAR, collectVar, envPtr);
TclEmitOpcode( INST_POP, envPtr);
}
@@ -1468,20 +1449,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.
*/
@@ -1496,15 +1478,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);
@@ -1532,35 +1513,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);
@@ -1573,14 +1540,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
@@ -1588,15 +1558,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;
}
@@ -1611,10 +1580,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;
@@ -1643,17 +1610,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;
}
/*
@@ -1664,8 +1623,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++) {
@@ -1674,37 +1632,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;
@@ -1716,20 +1658,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);
/*
@@ -1740,7 +1679,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.
@@ -1761,16 +1700,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
@@ -1792,6 +1740,7 @@ TclCompileDictAppendCmd(
* speed quite so much. ;-)
*/
+ /* TODO: Consider support for compiling expanded args. */
if (parsePtr->numWords<4 || parsePtr->numWords>100) {
return TCL_ERROR;
}
@@ -1801,19 +1750,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);
}
/*
@@ -1826,7 +1765,7 @@ TclCompileDictAppendCmd(
tokenPtr = TokenAfter(tokenPtr);
}
if (parsePtr->numWords > 4) {
- TclEmitInstInt1(INST_CONCAT1, parsePtr->numWords-3, envPtr);
+ TclEmitInstInt1(INST_STR_CONCAT1, parsePtr->numWords-3, envPtr);
}
/*
@@ -1848,34 +1787,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;
}
@@ -1890,10 +1831,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;
@@ -1901,6 +1841,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;
}
@@ -1916,7 +1857,7 @@ TclCompileDictWithCmd(
tokenPtr = TokenAfter(tokenPtr);
}
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- return TCL_ERROR;
+ return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
/*
@@ -1928,7 +1869,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;
@@ -1940,11 +1882,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
@@ -1963,7 +1901,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);
@@ -1971,18 +1909,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) {
@@ -1992,7 +1928,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);
@@ -2001,24 +1937,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;
}
@@ -2031,29 +1965,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);
@@ -2068,7 +1998,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);
@@ -2078,14 +2008,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);
/*
@@ -2093,13 +2020,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) {
@@ -2113,17 +2040,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) {
@@ -2131,13 +2059,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));
@@ -2234,21 +2161,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;
}
@@ -2326,9 +2280,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) {
@@ -2360,20 +2313,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);
/*
@@ -2394,44 +2337,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) {
@@ -2452,13 +2389,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;
}
@@ -2497,6 +2435,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.
@@ -2527,19 +2496,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 */
/*
@@ -2578,8 +2538,6 @@ CompileEachloopCmd(
return TCL_ERROR;
}
- bodyIndex = i-1;
-
/*
* Allocate storage for the varcList and varvList arrays if necessary.
*/
@@ -2618,7 +2576,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) {
@@ -2649,35 +2607,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
@@ -2686,16 +2620,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];
@@ -2706,135 +2638,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]);
@@ -2988,6 +2862,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);
+ }
+}
/*
*----------------------------------------------------------------------
@@ -3067,7 +2971,8 @@ TclCompileFormatCmd(
ckfree(objv);
Tcl_DecrRefCount(formatObj);
if (tmpObj == NULL) {
- return TCL_ERROR;
+ TclCompileSyntaxError(interp, envPtr);
+ return TCL_OK;
}
/*
@@ -3193,7 +3098,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
@@ -3202,7 +3107,7 @@ TclCompileFormatCmd(
*/
TclEmitOpcode(INST_DUP, envPtr);
- PushLiteral(envPtr, "", 0);
+ PushStringLiteral(envPtr, "");
TclEmitOpcode(INST_STR_EQ, envPtr);
TclEmitOpcode(INST_POP, envPtr);
}
@@ -3212,2815 +3117,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;
-}
-
-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 | 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;
@@ -6180,8 +3310,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.
@@ -6201,12 +3330,10 @@ PushVarName(
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 {
@@ -6214,8 +3341,6 @@ PushVarName(
* The var name isn't simple: compile and push it.
*/
- envPtr->line = line;
- envPtr->clNext = clNext;
CompileTokens(envPtr, varTokenPtr, interp);
}
@@ -6226,9 +3351,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..b3e273f
--- /dev/null
+++ b/generic/tclCompCmdsGR.c
@@ -0,0 +1,3171 @@
+/*
+ * 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
+TclCompileObjectNextToCmd(
+ 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 < 2 || 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_CLASS, 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 6e31481..e6ec0a6 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -17,6 +17,7 @@
#include "tclInt.h"
#include "tclCompile.h"
+#include "tclStringTrim.h"
/*
* Prototypes for procedures defined later in this file:
@@ -27,11 +28,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 +41,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 +86,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 +184,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 +203,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 +218,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 +245,6 @@ TclCompileSetCmd(
localIndex, envPtr);
}
}
- } else {
- TclEmitOpcode((isAssignment? INST_STORE_STK : INST_LOAD_STK), envPtr);
- }
return TCL_OK;
}
@@ -424,6 +425,284 @@ TclCompileStringIndexCmd(
}
int
+TclCompileStringIsCmd(
+ 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 = TokenAfter(parsePtr->tokenPtr);
+ static const char *const isClasses[] = {
+ "alnum", "alpha", "ascii", "control",
+ "boolean", "digit", "double", "entier",
+ "false", "graph", "integer", "list",
+ "lower", "print", "punct", "space",
+ "true", "upper", "wideinteger", "wordchar",
+ "xdigit", NULL
+ };
+ enum isClasses {
+ STR_IS_ALNUM, STR_IS_ALPHA, STR_IS_ASCII, STR_IS_CONTROL,
+ STR_IS_BOOL, STR_IS_DIGIT, STR_IS_DOUBLE, STR_IS_ENTIER,
+ STR_IS_FALSE, STR_IS_GRAPH, STR_IS_INT, STR_IS_LIST,
+ STR_IS_LOWER, STR_IS_PRINT, STR_IS_PUNCT, STR_IS_SPACE,
+ STR_IS_TRUE, STR_IS_UPPER, STR_IS_WIDE, STR_IS_WORD,
+ STR_IS_XDIGIT
+ };
+ int t, range, allowEmpty = 0, end;
+ InstStringClassType strClassType;
+ Tcl_Obj *isClass;
+
+ if (parsePtr->numWords < 3 || parsePtr->numWords > 6) {
+ return TCL_ERROR;
+ }
+ isClass = Tcl_NewObj();
+ if (!TclWordKnownAtCompileTime(tokenPtr, isClass)) {
+ Tcl_DecrRefCount(isClass);
+ return TCL_ERROR;
+ } else if (Tcl_GetIndexFromObj(interp, isClass, isClasses, "class", 0,
+ &t) != TCL_OK) {
+ Tcl_DecrRefCount(isClass);
+ TclCompileSyntaxError(interp, envPtr);
+ return TCL_OK;
+ }
+ Tcl_DecrRefCount(isClass);
+
+#define GotLiteral(tokenPtr, word) \
+ ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD && \
+ (tokenPtr)[1].size > 1 && \
+ (tokenPtr)[1].start[0] == word[0] && \
+ strncmp((tokenPtr)[1].start, (word), (tokenPtr)[1].size) == 0)
+
+ /*
+ * Cannot handle the -failindex option at all, and that's the only legal
+ * way to have more than 4 arguments.
+ */
+
+ if (parsePtr->numWords != 3 && parsePtr->numWords != 4) {
+ return TCL_ERROR;
+ }
+
+ tokenPtr = TokenAfter(tokenPtr);
+ if (parsePtr->numWords == 3) {
+ allowEmpty = 1;
+ } else {
+ if (!GotLiteral(tokenPtr, "-strict")) {
+ return TCL_ERROR;
+ }
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+#undef GotLiteral
+
+ /*
+ * Compile the code. There are several main classes of check here.
+ * 1. Character classes
+ * 2. Booleans
+ * 3. Integers
+ * 4. Floats
+ * 5. Lists
+ */
+
+ CompileWord(envPtr, tokenPtr, interp, parsePtr->numWords-1);
+
+ switch ((enum isClasses) t) {
+ case STR_IS_ALNUM:
+ strClassType = STR_CLASS_ALNUM;
+ goto compileStrClass;
+ case STR_IS_ALPHA:
+ strClassType = STR_CLASS_ALPHA;
+ goto compileStrClass;
+ case STR_IS_ASCII:
+ strClassType = STR_CLASS_ASCII;
+ goto compileStrClass;
+ case STR_IS_CONTROL:
+ strClassType = STR_CLASS_CONTROL;
+ goto compileStrClass;
+ case STR_IS_DIGIT:
+ strClassType = STR_CLASS_DIGIT;
+ goto compileStrClass;
+ case STR_IS_GRAPH:
+ strClassType = STR_CLASS_GRAPH;
+ goto compileStrClass;
+ case STR_IS_LOWER:
+ strClassType = STR_CLASS_LOWER;
+ goto compileStrClass;
+ case STR_IS_PRINT:
+ strClassType = STR_CLASS_PRINT;
+ goto compileStrClass;
+ case STR_IS_PUNCT:
+ strClassType = STR_CLASS_PUNCT;
+ goto compileStrClass;
+ case STR_IS_SPACE:
+ strClassType = STR_CLASS_SPACE;
+ goto compileStrClass;
+ case STR_IS_UPPER:
+ strClassType = STR_CLASS_UPPER;
+ goto compileStrClass;
+ case STR_IS_WORD:
+ strClassType = STR_CLASS_WORD;
+ goto compileStrClass;
+ case STR_IS_XDIGIT:
+ strClassType = STR_CLASS_XDIGIT;
+ compileStrClass:
+ if (allowEmpty) {
+ OP1( STR_CLASS, strClassType);
+ } else {
+ int over, over2;
+
+ OP( DUP);
+ OP1( STR_CLASS, strClassType);
+ JUMP1( JUMP_TRUE, over);
+ OP( POP);
+ PUSH( "0");
+ JUMP1( JUMP, over2);
+ FIXJUMP1(over);
+ PUSH( "");
+ OP( STR_NEQ);
+ FIXJUMP1(over2);
+ }
+ return TCL_OK;
+
+ case STR_IS_BOOL:
+ case STR_IS_FALSE:
+ case STR_IS_TRUE:
+ OP( TRY_CVT_TO_BOOLEAN);
+ switch (t) {
+ int over, over2;
+
+ case STR_IS_BOOL:
+ if (allowEmpty) {
+ JUMP1( JUMP_TRUE, over);
+ PUSH( "");
+ OP( STR_EQ);
+ JUMP1( JUMP, over2);
+ FIXJUMP1(over);
+ OP( POP);
+ PUSH( "1");
+ FIXJUMP1(over2);
+ } else {
+ OP4( REVERSE, 2);
+ OP( POP);
+ }
+ return TCL_OK;
+ case STR_IS_TRUE:
+ JUMP1( JUMP_TRUE, over);
+ if (allowEmpty) {
+ PUSH( "");
+ OP( STR_EQ);
+ } else {
+ OP( POP);
+ PUSH( "0");
+ }
+ FIXJUMP1( over);
+ OP( LNOT);
+ OP( LNOT);
+ return TCL_OK;
+ case STR_IS_FALSE:
+ JUMP1( JUMP_TRUE, over);
+ if (allowEmpty) {
+ PUSH( "");
+ OP( STR_NEQ);
+ } else {
+ OP( POP);
+ PUSH( "1");
+ }
+ FIXJUMP1( over);
+ OP( LNOT);
+ return TCL_OK;
+ }
+
+ case STR_IS_DOUBLE: {
+ int satisfied, isEmpty;
+
+ if (allowEmpty) {
+ OP( DUP);
+ PUSH( "");
+ OP( STR_EQ);
+ JUMP1( JUMP_TRUE, isEmpty);
+ OP( NUM_TYPE);
+ JUMP1( JUMP_TRUE, satisfied);
+ PUSH( "0");
+ JUMP1( JUMP, end);
+ FIXJUMP1( isEmpty);
+ OP( POP);
+ FIXJUMP1( satisfied);
+ } else {
+ OP( NUM_TYPE);
+ JUMP1( JUMP_TRUE, satisfied);
+ PUSH( "0");
+ JUMP1( JUMP, end);
+ TclAdjustStackDepth(-1, envPtr);
+ FIXJUMP1( satisfied);
+ }
+ PUSH( "1");
+ FIXJUMP1( end);
+ return TCL_OK;
+ }
+
+ case STR_IS_INT:
+ case STR_IS_WIDE:
+ case STR_IS_ENTIER:
+ if (allowEmpty) {
+ int testNumType;
+
+ OP( DUP);
+ OP( NUM_TYPE);
+ OP( DUP);
+ JUMP1( JUMP_TRUE, testNumType);
+ OP( POP);
+ PUSH( "");
+ OP( STR_EQ);
+ JUMP1( JUMP, end);
+ TclAdjustStackDepth(1, envPtr);
+ FIXJUMP1( testNumType);
+ OP4( REVERSE, 2);
+ OP( POP);
+ } else {
+ OP( NUM_TYPE);
+ OP( DUP);
+ JUMP1( JUMP_FALSE, end);
+ }
+
+ switch (t) {
+ case STR_IS_INT:
+ PUSH( "1");
+ OP( EQ);
+ break;
+ case STR_IS_WIDE:
+ PUSH( "2");
+ OP( LE);
+ break;
+ case STR_IS_ENTIER:
+ PUSH( "3");
+ OP( LE);
+ break;
+ }
+ FIXJUMP1( end);
+ return TCL_OK;
+
+ case STR_IS_LIST:
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ OP4( BEGIN_CATCH4, range);
+ ExceptionRangeStarts(envPtr, range);
+ OP( DUP);
+ OP( LIST_LENGTH);
+ OP( POP);
+ ExceptionRangeEnds(envPtr, range);
+ ExceptionRangeTarget(envPtr, range, catchOffset);
+ OP( POP);
+ OP( PUSH_RETURN_CODE);
+ OP( END_CATCH);
+ OP( LNOT);
+ return TCL_OK;
+ }
+
+ return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+}
+
+int
TclCompileStringMatchCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
@@ -448,7 +727,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 +736,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 +857,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 +897,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 +907,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 +936,320 @@ 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;
+ }
+}
+
+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, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
+ }
+ 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, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
+ }
+ 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, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
+ }
+ 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;
+}
+
+/*
+ * Support definitions for the [string is] compilation.
+ */
+
+static int
+UniCharIsAscii(
+ int character)
+{
+ return (character >= 0) && (character < 0x80);
+}
+
+static int
+UniCharIsHexDigit(
+ int character)
+{
+ return (character >= 0) && (character < 0x80) && isxdigit(character);
+}
+
+StringClassDesc const tclStringClassTable[] = {
+ {"alnum", Tcl_UniCharIsAlnum},
+ {"alpha", Tcl_UniCharIsAlpha},
+ {"ascii", UniCharIsAscii},
+ {"control", Tcl_UniCharIsControl},
+ {"digit", Tcl_UniCharIsDigit},
+ {"graph", Tcl_UniCharIsGraph},
+ {"lower", Tcl_UniCharIsLower},
+ {"print", Tcl_UniCharIsPrint},
+ {"punct", Tcl_UniCharIsPunct},
+ {"space", Tcl_UniCharIsSpace},
+ {"upper", Tcl_UniCharIsUpper},
+ {"word", Tcl_UniCharIsWordChar},
+ {"xdigit", UniCharIsHexDigit},
+ {NULL, NULL}
+};
/*
*----------------------------------------------------------------------
@@ -798,18 +1353,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 +1425,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 +1449,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 +1473,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 +1483,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 +1499,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 +1515,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 +1525,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 +1543,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 +1562,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 +1601,6 @@ TclSubstCompile(
* Instructions are added to envPtr to execute the "switch" command at
* runtime.
*
- * FIXME:
- * Stack depths are probably not calculated correctly.
- *
*----------------------------------------------------------------------
*/
@@ -1343,13 +1891,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 +1937,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 +1949,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 +1964,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 +1976,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 +2009,7 @@ IssueSwitchChainedTests(
* when the RE == "".
*/
- PushLiteral(envPtr, "1", 1);
+ PUSH("1");
break;
}
@@ -1569,13 +2106,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 +2133,7 @@ IssueSwitchChainedTests(
if (!foundDefault) {
OP( POP);
- PushLiteral(envPtr, "", 0);
+ PUSH("");
}
/*
@@ -1633,8 +2169,6 @@ IssueSwitchChainedTests(
}
TclStackFree(interp, fixupTargetArray);
TclStackFree(interp, fixupArray);
-
- envPtr->currStackDepth = savedStackDepth + 1;
}
/*
@@ -1654,11 +2188,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 +2198,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 +2303,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 +2324,7 @@ IssueSwitchJumpTable(
*/
OP4( JUMP4, 0);
+ TclAdjustStackDepth(-1, envPtr);
}
}
@@ -1813,10 +2335,9 @@ IssueSwitchJumpTable(
*/
if (!foundDefault) {
- envPtr->currStackDepth = savedStackDepth;
TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault,
envPtr->codeStart+jumpToDefault+1);
- PushLiteral(envPtr, "", 0);
+ PUSH("");
}
/*
@@ -1834,7 +2355,6 @@ IssueSwitchJumpTable(
*/
TclStackFree(interp, finalFixups);
- envPtr->currStackDepth = savedStackDepth + 1;
}
/*
@@ -1954,6 +2474,7 @@ TclCompileTailcallCmd(
}
/* 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);
@@ -1992,9 +2513,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;
@@ -2004,77 +2525,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;
}
@@ -2124,8 +2634,7 @@ TclCompileTryCmd(
*/
DefineLineInformation; /* TIP #280 */
- SetLineInformation(1);
- CompileBody(envPtr, bodyToken, interp);
+ BODY(bodyToken, 1);
return TCL_OK;
}
@@ -2216,12 +2725,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;
}
@@ -2229,12 +2737,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;
}
@@ -2282,14 +2789,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);
}
/*
@@ -2315,12 +2825,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.
*
@@ -2328,7 +2839,7 @@ TclCompileTryCmd(
*/
static int
-IssueTryInstructions(
+IssueTryClausesInstructions(
Tcl_Interp *interp,
CompileEnv *envPtr,
Tcl_Token *bodyToken,
@@ -2341,32 +2852,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);
@@ -2386,14 +2916,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);
/*
@@ -2405,9 +2938,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 */
}
@@ -2431,8 +2965,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;
@@ -2440,19 +2976,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);
}
/*
@@ -2464,24 +3025,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,
@@ -2494,31 +3061,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);
@@ -2528,161 +3117,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);
}
- TclStackFree(interp, forwardsToFix);
- TclStackFree(interp, addrsToFix);
+
+ endOfThisArm:
+ if (i+1 < numHandlers) {
+ JUMP4( JUMP, addrsToFix[i]);
+ TclAdjustStackDepth(1, envPtr);
+ }
+ 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
@@ -2692,16 +3296,106 @@ 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;
+}
/*
*----------------------------------------------------------------------
@@ -2731,38 +3425,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 (numWords > 0 && 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--;
- }
- } else {
- /*
- * Cannot guarantee that the first word is not '-nocomplain' at
- * evaluation with reasonable effort, so spill to interpreted version.
- */
+ /* 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;
+ }
+ 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
@@ -2772,15 +3509,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 {
@@ -2796,7 +3531,7 @@ TclCompileUnsetCmd(
varTokenPtr = TokenAfter(varTokenPtr);
}
- PushLiteral(envPtr, "", 0);
+ PUSH("");
return TCL_OK;
}
@@ -2830,7 +3565,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;
@@ -2888,7 +3622,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
@@ -2914,7 +3648,7 @@ TclCompileWhileCmd(
* INST_START_CMD, and hence counted properly. [Bug 1752146]
*/
- envPtr->atCmdStart = 0;
+ envPtr->atCmdStart &= ~1;
testCodeOffset = CurrentOffset(envPtr);
}
@@ -2922,11 +3656,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);
/*
@@ -2941,10 +3677,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) {
@@ -2968,14 +3703,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;
}
@@ -3011,7 +3746,7 @@ TclCompileYieldCmd(
}
if (parsePtr->numWords == 1) {
- PushLiteral(envPtr, "", 0);
+ PUSH("");
} else {
DefineLineInformation; /* TIP #280 */
Tcl_Token *valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
@@ -3025,240 +3760,45 @@ TclCompileYieldCmd(
/*
*----------------------------------------------------------------------
*
- * PushVarName --
+ * TclCompileYieldToCmd --
*
- * Procedure used in the compiling where pushing a variable name is
- * necessary (append, lappend, set).
+ * Procedure called to compile the "yieldto" 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 "set" command at
+ * Instructions are added to envPtr to execute the "yieldto" command at
* runtime.
*
*----------------------------------------------------------------------
*/
-static int
-PushVarName(
+int
+TclCompileYieldToCmd(
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.
- */
+ 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 = TokenAfter(parsePtr->tokenPtr);
+ int i;
- envPtr->line = line;
- envPtr->clNext = clNext;
- CompileTokens(envPtr, varTokenPtr, interp);
+ if (parsePtr->numWords < 2) {
+ return TCL_ERROR;
}
- if (removedParen) {
- varTokenPtr[removedParen].size++;
- }
- if (allocedTokens) {
- TclStackFree(interp, elemTokenPtr);
+ OP( NS_CURRENT);
+ for (i = 1 ; i < parsePtr->numWords ; i++) {
+ CompileWord(envPtr, tokenPtr, interp, i);
+ tokenPtr = TokenAfter(tokenPtr);
}
- *localIndexPtr = localIndex;
- *simpleVarNamePtr = simpleVarName;
- *isScalarPtr = (elName == NULL);
+ OP4( LIST, i);
+ OP( YIELD_TO_INVOKE);
return TCL_OK;
}
@@ -3333,6 +3873,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);
@@ -3416,8 +3957,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);
@@ -3431,7 +3973,7 @@ CompileComparisonOpCmd(
return TCL_ERROR;
} else {
- int tmpIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+ int tmpIndex = AnonymousLocal(envPtr);
int words;
tokenPtr = TokenAfter(parsePtr->tokenPtr);
@@ -3588,7 +4130,7 @@ TclCompilePowOpCmd(
CompileWord(envPtr, tokenPtr, interp, words);
}
if (parsePtr->numWords <= 2) {
- PushLiteral(envPtr, "1", 1);
+ PUSH("1");
words++;
}
while (--words > 1) {
@@ -3753,6 +4295,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.
@@ -3798,6 +4341,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.
@@ -3806,7 +4350,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 45a74d7..347e3f0 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 => ... */
@@ -491,6 +493,7 @@ InstructionDesc const tclInstructionTable[] = {
* qualified version, or produces the empty string if no such command
* exists. Never generates errors.
* Stack: ... cmdName => ... fullCmdName */
+
{"tclooSelf", 1, +1, 0, {OPERAND_NONE}},
/* Push the identity of the current TclOO object (i.e., the name of
* its current public access command) on the stack. */
@@ -534,6 +537,119 @@ 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}},
+ /* Call the next item on the TclOO call chain, passing opnd arguments
+ * (min 1, max 255, *includes* "next"). The result of the invoked
+ * method implementation will be pushed on the stack in place of the
+ * arguments (similar to invokeStk).
+ * Stack: ... "next" arg2 arg3 -- argN => ... result */
+ {"tclooNextClass", 2, INT_MIN, 1, {OPERAND_UINT1}},
+ /* Call the following item on the TclOO call chain defined by class
+ * className, passing opnd arguments (min 2, max 255, *includes*
+ * "nextto" and the class name). The result of the invoked method
+ * implementation will be pushed on the stack in place of the
+ * arguments (similar to invokeStk).
+ * Stack: ... "nextto" className arg3 arg4 -- argN => ... result */
+
+ {"yieldToInvoke", 1, 0, 0, {OPERAND_NONE}},
+ /* Makes the current coroutine yield the value at the top of the
+ * stack, invoking the given command/args with resolution in the given
+ * namespace (all packed into a list), and places the list of values
+ * that are the response back on top of the stack when it resumes.
+ * Stack: ... [list ns cmd arg1 ... argN] => ... resumeList */
+
+ {"numericType", 1, 0, 0, {OPERAND_NONE}},
+ /* Pushes the numeric type code of the word at the top of the stack.
+ * Stack: ... value => ... typeCode */
+ {"tryCvtToBoolean", 1, +1, 0, {OPERAND_NONE}},
+ /* Try converting stktop to boolean if possible. No errors.
+ * Stack: ... value => ... value isStrictBool */
+ {"strclass", 2, 0, 1, {OPERAND_SCLS1}},
+ /* See if all the characters of the given string are a member of the
+ * specified (by opnd) character class. Note that an empty string will
+ * satisfy the class check (standard definition of "all").
+ * Stack: ... stringValue => ... boolean */
+
{NULL, 0, 0, 0, {OPERAND_NONE}}
};
@@ -554,11 +670,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,
@@ -573,6 +693,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
@@ -612,6 +733,13 @@ static const Tcl_ObjType tclInstNameType = {
UpdateStringOfInstName, /* updateStringProc */
NULL, /* setFromAnyProc */
};
+
+/*
+ * Helper macros.
+ */
+
+#define TclIncrUInt4AtPtr(ptr, delta) \
+ TclStoreInt4AtPtr(TclGetUInt4AtPtr(ptr)+(delta), (ptr));
/*
*----------------------------------------------------------------------
@@ -650,11 +778,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
@@ -692,9 +818,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);
@@ -706,6 +830,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.
*/
@@ -722,35 +880,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);
@@ -789,8 +926,7 @@ SetByteCodeFromAny(
if (interp == NULL) {
return TCL_ERROR;
}
- TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
- return TCL_OK;
+ return TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
}
/*
@@ -844,10 +980,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);
@@ -867,9 +1002,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.
*
*----------------------------------------------------------------------
*/
@@ -944,7 +1078,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++) {
@@ -957,17 +1091,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++);
}
}
@@ -992,22 +1118,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);
}
}
@@ -1021,6 +1132,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 --
@@ -1144,14 +1326,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;
}
@@ -1183,12 +1370,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);
+}
/*
*----------------------------------------------------------------------
@@ -1221,6 +1427,8 @@ TclInitCompileEnv(
{
Interp *iPtr = (Interp *) interp;
+ assert(tclInstructionTable[LAST_INST_OPCODE+1].name == NULL);
+
envPtr->iPtr = iPtr;
envPtr->source = stringPtr;
envPtr->numSrcBytes = numBytes;
@@ -1244,6 +1452,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;
@@ -1252,6 +1461,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
@@ -1267,9 +1477,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.
@@ -1383,7 +1592,6 @@ TclInitCompileEnv(
* data is available.
*/
- envPtr->clLoc = NULL;
envPtr->clNext = NULL;
envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace;
@@ -1422,6 +1630,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);
}
@@ -1430,6 +1664,7 @@ TclFreeCompileEnv(
}
if (envPtr->mallocedExceptArray) {
ckfree(envPtr->exceptArrayPtr);
+ ckfree(envPtr->exceptAuxArrayPtr);
}
if (envPtr->mallocedCmdMap) {
ckfree(envPtr->cmdMapPtr);
@@ -1438,17 +1673,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;
}
}
@@ -1550,474 +1776,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;
+
+ if (cmdObj) {
+ CompileCmdLiteral(interp, cmdObj, envPtr);
+ wordIdx = 1;
+ tokenPtr = TokenAfter(tokenPtr);
+ }
- Tcl_DStringInit(&ds);
+ for (; wordIdx < numWords; wordIdx++, tokenPtr = TokenAfter(tokenPtr)) {
+ int objIdx;
- if (numBytes < 0) {
- numBytes = strlen(script);
+ 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);
}
/*
@@ -2081,7 +2300,7 @@ TclCompileVarSubst(
localVar = TclFindCompiledLocal(name, nameBytes, localVarName, envPtr);
}
if (localVar < 0) {
- TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameBytes), envPtr);
+ PushLiteral(envPtr, name, nameBytes);
}
/*
@@ -2093,7 +2312,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 {
@@ -2123,11 +2342,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
@@ -2160,6 +2380,7 @@ TclCompileTokens(
clPosition = ckalloc(maxNumCL * sizeof(int));
}
+ adjust = 0;
Tcl_DStringInit(&textBuffer);
numObjsToConcat = 0;
for ( ; count > 0; count--, tokenPtr++) {
@@ -2203,6 +2424,7 @@ TclCompileTokens(
clPosition[numCL] = clPos;
numCL ++;
}
+ adjust++;
}
break;
@@ -2219,15 +2441,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;
@@ -2267,7 +2490,7 @@ TclCompileTokens(
TclEmitPush(literal, envPtr);
numObjsToConcat++;
if (numCL) {
- TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr,
+ TclContinuationsEnter(TclFetchLiteral(envPtr, literal),
numCL, clPosition);
}
numCL = 0;
@@ -2278,11 +2501,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);
}
/*
@@ -2290,7 +2513,7 @@ TclCompileTokens(
*/
if (envPtr->codeNext == entryCodeNext) {
- TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+ PushStringLiteral(envPtr, "");
}
Tcl_DStringFree(&textBuffer);
@@ -2302,6 +2525,7 @@ TclCompileTokens(
if (maxNumCL) {
ckfree(clPosition);
}
+ TclCheckStackDepth(depth+1, envPtr);
}
/*
@@ -2349,7 +2573,7 @@ TclCompileCmdWord(
*/
TclCompileTokens(interp, tokenPtr, count, envPtr);
- TclEmitOpcode(INST_EVAL_STK, envPtr);
+ TclEmitInvoke(envPtr, INST_EVAL_STK);
}
}
@@ -2405,19 +2629,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);
}
@@ -2451,21 +2675,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;
}
@@ -2514,6 +2734,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;
@@ -2571,7 +2795,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.
@@ -2588,9 +2814,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;
}
}
@@ -2639,7 +2865,7 @@ TclInitByteCodeObj(
*/
TclFreeIntRep(objPtr);
- objPtr->internalRep.otherValuePtr = codePtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
objPtr->typePtr = &tclByteCodeType;
/*
@@ -2651,6 +2877,9 @@ TclInitByteCodeObj(
&isNew), envPtr->extCmdMapPtr);
envPtr->extCmdMapPtr = NULL;
+ /* We've used up the CompileEnv. Mark as uninitialized. */
+ envPtr->iPtr = NULL;
+
codePtr->localCachePtr = NULL;
}
@@ -3065,6 +3294,7 @@ TclCreateExceptRange(
* new ExceptionRange structure. */
{
register ExceptionRange *rangePtr;
+ register ExceptionAux *auxPtr;
int index = envPtr->exceptArrayNext;
if (index >= envPtr->exceptArrayEnd) {
@@ -3076,12 +3306,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
@@ -3089,9 +3323,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;
@@ -3106,10 +3343,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 --
@@ -3469,70 +3990,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.
+ */
+
+ 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;
+ }
+
+ /*
+ * 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;
- MAP *map = (MAP*) ckalloc (sizeof(MAP) * eclPtr->litInfo.numEntries);
+ if (auxBreakPtr != NULL) {
+ auxBreakPtr = envPtr->exceptAuxArrayPtr + breakRange;
+ }
+ if (auxContinuePtr != NULL) {
+ auxContinuePtr = envPtr->exceptAuxArrayPtr + continueRange;
+ }
- Tcl_HashSearch hSearch;
- Tcl_HashEntry* hPtr;
- int n, k, isnew;
+ 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);
}
/*
@@ -3563,7 +4229,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.
@@ -3579,8 +4245,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). */
@@ -3681,12 +4347,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);
}
/*
@@ -4058,7 +4724,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;
@@ -4431,6 +5097,11 @@ FormatInstruction(
}
Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", (unsigned) opnd);
break;
+ case OPERAND_SCLS1:
+ opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
+ Tcl_AppendPrintfToObj(bufferObj, "%s ",
+ tclStringClassTable[opnd].name);
+ break;
case OPERAND_NONE:
default:
break;
@@ -4563,7 +5234,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);
}
@@ -4643,7 +5318,7 @@ PrintSourceToObj(
int maxChars) /* Maximum number of chars to print. */
{
register const char *p;
- register int i = 0;
+ register int i = 0, len;
if (stringPtr == NULL) {
Tcl_AppendToObj(appendObj, "\"\"", -1);
@@ -4652,32 +5327,50 @@ PrintSourceToObj(
Tcl_AppendToObj(appendObj, "\"", -1);
p = stringPtr;
- for (; (*p != '\0') && (i < maxChars); p++, i++) {
- switch (*p) {
+ for (; (*p != '\0') && (i < maxChars); p+=len) {
+ Tcl_UniChar ch;
+
+ len = TclUtfToUniChar(p, &ch);
+ switch (ch) {
case '"':
Tcl_AppendToObj(appendObj, "\\\"", -1);
+ i += 2;
continue;
case '\f':
Tcl_AppendToObj(appendObj, "\\f", -1);
+ i += 2;
continue;
case '\n':
Tcl_AppendToObj(appendObj, "\\n", -1);
+ i += 2;
continue;
case '\r':
Tcl_AppendToObj(appendObj, "\\r", -1);
+ i += 2;
continue;
case '\t':
Tcl_AppendToObj(appendObj, "\\t", -1);
+ i += 2;
continue;
case '\v':
Tcl_AppendToObj(appendObj, "\\v", -1);
+ i += 2;
continue;
default:
- Tcl_AppendPrintfToObj(appendObj, "%c", *p);
+ if (ch < 0x20 || ch >= 0x7f) {
+ Tcl_AppendPrintfToObj(appendObj, "\\u%04x", ch);
+ i += 6;
+ } else {
+ Tcl_AppendPrintfToObj(appendObj, "%c", ch);
+ i++;
+ }
continue;
}
}
Tcl_AppendToObj(appendObj, "\"", -1);
+ if (*p != '\0') {
+ Tcl_AppendToObj(appendObj, "...", -1);
+ }
}
#ifdef TCL_COMPILE_STATS
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 4d8ed65..5665ca9 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
@@ -700,6 +751,8 @@ typedef struct ByteCode {
#define INST_INFO_LEVEL_NUM 152
#define INST_INFO_LEVEL_ARGS 153
#define INST_RESOLVE_COMMAND 154
+
+/* For compilation relating to TclOO */
#define INST_TCLOO_SELF 155
#define INST_TCLOO_CLASS 156
#define INST_TCLOO_NS 157
@@ -713,8 +766,41 @@ typedef struct ByteCode {
#define INST_INVOKE_REPLACE 163
+#define INST_LIST_CONCAT 164
+
+#define INST_EXPAND_DROP 165
+
+/* New foreach implementation */
+#define INST_FOREACH_START 166
+#define INST_FOREACH_STEP 167
+#define INST_FOREACH_END 168
+#define INST_LMAP_COLLECT 169
+
+/* For compilation of [string trim] and related */
+#define INST_STR_TRIM 170
+#define INST_STR_TRIM_LEFT 171
+#define INST_STR_TRIM_RIGHT 172
+
+#define INST_CONCAT_STK 173
+
+#define INST_STR_UPPER 174
+#define INST_STR_LOWER 175
+#define INST_STR_TITLE 176
+#define INST_STR_REPLACE 177
+
+#define INST_ORIGIN_COMMAND 178
+
+#define INST_TCLOO_NEXT 179
+#define INST_TCLOO_NEXT_CLASS 180
+
+#define INST_YIELD_TO_INVOKE 181
+
+#define INST_NUM_TYPE 182
+#define INST_TRY_CVT_TO_BOOLEAN 183
+#define INST_STR_CLASS 184
+
/* The last opcode */
-#define LAST_INST_OPCODE 163
+#define LAST_INST_OPCODE 184
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
@@ -739,8 +825,9 @@ typedef enum InstOperandType {
* variable table. */
OPERAND_LVT4, /* Four byte unsigned index into the local
* variable table. */
- OPERAND_AUX4 /* Four byte unsigned index into the aux data
+ OPERAND_AUX4, /* Four byte unsigned index into the aux data
* table. */
+ OPERAND_SCLS1 /* Index into tclStringClassTable. */
} InstOperandType;
typedef struct InstructionDesc {
@@ -759,6 +846,40 @@ typedef struct InstructionDesc {
MODULE_SCOPE InstructionDesc const tclInstructionTable[];
/*
+ * Constants used by INST_STRING_CLASS to indicate character classes. These
+ * correspond closely by name with what [string is] can support, but there is
+ * no requirement to keep the values the same.
+ */
+
+typedef enum InstStringClassType {
+ STR_CLASS_ALNUM, /* Unicode alphabet or digit characters. */
+ STR_CLASS_ALPHA, /* Unicode alphabet characters. */
+ STR_CLASS_ASCII, /* Characters in range U+000000..U+00007F. */
+ STR_CLASS_CONTROL, /* Unicode control characters. */
+ STR_CLASS_DIGIT, /* Unicode digit characters. */
+ STR_CLASS_GRAPH, /* Unicode printing characters, excluding
+ * space. */
+ STR_CLASS_LOWER, /* Unicode lower-case alphabet characters. */
+ STR_CLASS_PRINT, /* Unicode printing characters, including
+ * spaces. */
+ STR_CLASS_PUNCT, /* Unicode punctuation characters. */
+ STR_CLASS_SPACE, /* Unicode space characters. */
+ STR_CLASS_UPPER, /* Unicode upper-case alphabet characters. */
+ STR_CLASS_WORD, /* Unicode word (alphabetic, digit, connector
+ * punctuation) characters. */
+ STR_CLASS_XDIGIT /* Characters that can be used as digits in
+ * hexadecimal numbers ([0-9A-Fa-f]). */
+} InstStringClassType;
+
+typedef struct StringClassDesc {
+ const char *name; /* Name of the class. */
+ int (*comparator)(int); /* Function to test if a single unicode
+ * character is a member of the class. */
+} StringClassDesc;
+
+MODULE_SCOPE StringClassDesc const tclStringClassTable[];
+
+/*
* Compilation of some Tcl constructs such as if commands and the logical or
* (||) and logical and (&&) operators in expressions requires the generation
* of forward jumps. Since the PC target of these jumps isn't known when the
@@ -847,6 +968,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
@@ -861,6 +986,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
@@ -879,6 +1007,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.
*/
@@ -916,7 +1047,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);
@@ -925,6 +1061,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);
@@ -949,16 +1088,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);
@@ -967,16 +1106,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);
@@ -987,9 +1134,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);
@@ -1027,6 +1175,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
@@ -1071,6 +1228,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.
@@ -1093,6 +1265,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:
*
@@ -1105,7 +1289,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)
@@ -1157,7 +1341,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)
@@ -1175,7 +1359,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)
@@ -1199,6 +1383,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:
@@ -1308,16 +1504,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
@@ -1331,15 +1527,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
@@ -1368,14 +1568,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 = \
@@ -1406,6 +1603,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 fe9ba2b..91c0add 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:
*/
@@ -59,7 +63,7 @@ EXTERN void Tcl_DbCkfree(char *ptr, const char *file, int line);
/* 8 */
EXTERN char * Tcl_DbCkrealloc(char *ptr, unsigned int size,
const char *file, int line);
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 9 */
EXTERN void Tcl_CreateFileHandler(int fd, int mask,
Tcl_FileProc *proc, ClientData clientData);
@@ -69,7 +73,7 @@ EXTERN void Tcl_CreateFileHandler(int fd, int mask,
EXTERN void Tcl_CreateFileHandler(int fd, int mask,
Tcl_FileProc *proc, ClientData clientData);
#endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 10 */
EXTERN void Tcl_DeleteFileHandler(int fd);
#endif /* UNIX */
@@ -507,7 +511,7 @@ EXTERN Tcl_Interp * Tcl_GetMaster(Tcl_Interp *interp);
EXTERN const char * Tcl_GetNameOfExecutable(void);
/* 166 */
EXTERN Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp);
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 167 */
EXTERN int Tcl_GetOpenFile(Tcl_Interp *interp,
const char *chanID, int forWriting,
@@ -1831,19 +1835,19 @@ typedef struct TclStubs {
char * (*tcl_DbCkalloc) (unsigned int size, const char *file, int line); /* 6 */
void (*tcl_DbCkfree) (char *ptr, const char *file, int line); /* 7 */
char * (*tcl_DbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 8 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
#endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
void (*reserved9)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
#endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
void (*tcl_DeleteFileHandler) (int fd); /* 10 */
#endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
void (*reserved10)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
@@ -2005,10 +2009,10 @@ typedef struct TclStubs {
Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */
const char * (*tcl_GetNameOfExecutable) (void); /* 165 */
Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */
#endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
void (*reserved167)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
@@ -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
@@ -2511,7 +2513,7 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_DbCkfree) /* 7 */
#define Tcl_DbCkrealloc \
(tclStubsPtr->tcl_DbCkrealloc) /* 8 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#define Tcl_CreateFileHandler \
(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
#endif /* UNIX */
@@ -2519,7 +2521,7 @@ extern const TclStubs *tclStubsPtr;
#define Tcl_CreateFileHandler \
(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
#endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#define Tcl_DeleteFileHandler \
(tclStubsPtr->tcl_DeleteFileHandler) /* 10 */
#endif /* UNIX */
@@ -2839,7 +2841,7 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_GetNameOfExecutable) /* 165 */
#define Tcl_GetObjResult \
(tclStubsPtr->tcl_GetObjResult) /* 166 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#define Tcl_GetOpenFile \
(tclStubsPtr->tcl_GetOpenFile) /* 167 */
#endif /* UNIX */
@@ -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,16 +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:
*/
-#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
-# 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
+
+#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 170e744..e31d708 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -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 7d2206b..d246cb2 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -9,7 +9,6 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#include <sys/stat.h>
#include "tclInt.h"
typedef size_t (LengthProc)(const char *src);
@@ -183,6 +182,7 @@ TCL_DECLARE_MUTEX(encodingMutex)
static Tcl_Encoding defaultEncoding;
static Tcl_Encoding systemEncoding;
+Tcl_Encoding tclIdentityEncoding;
/*
* The following variable is used in the sparse matrix code for a
@@ -271,7 +271,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].
*/
@@ -314,7 +314,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);
@@ -335,7 +335,7 @@ static void
FreeEncodingIntRep(
Tcl_Obj *objPtr)
{
- Tcl_FreeEncoding(objPtr->internalRep.otherValuePtr);
+ Tcl_FreeEncoding(objPtr->internalRep.twoPtrValue.ptr1);
objPtr->typePtr = NULL;
}
@@ -354,7 +354,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);
}
/*
@@ -568,7 +568,7 @@ TclInitEncodingSubsystem(void)
type.freeProc = NULL;
type.nullSize = 1;
type.clientData = NULL;
- Tcl_CreateEncoding(&type);
+ tclIdentityEncoding = Tcl_CreateEncoding(&type);
type.encodingName = "utf-8";
type.toUtfProc = UtfExtToUtfIntProc;
@@ -652,6 +652,7 @@ TclFinalizeEncodingSubsystem(void)
Tcl_MutexLock(&encodingMutex);
encodingsInitialized = 0;
FreeEncoding(systemEncoding);
+ FreeEncoding(tclIdentityEncoding);
hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
while (hPtr != NULL) {
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 88de9f3..9bb7a0c 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -35,9 +35,6 @@ 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);
@@ -88,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(
@@ -1537,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);
/*
@@ -1588,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);
@@ -1718,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 &&
@@ -2196,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 {
@@ -2238,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);
@@ -2250,7 +2237,7 @@ MakeCachedEnsembleCommand(
TclFreeIntRep(objPtr);
ensembleCmd = ckalloc(sizeof(EnsembleCmdRep));
- objPtr->internalRep.otherValuePtr = ensembleCmd;
+ objPtr->internalRep.twoPtrValue.ptr1 = ensembleCmd;
objPtr->typePtr = &tclEnsembleCmdType;
}
@@ -2645,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);
@@ -2677,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;
@@ -2715,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;
@@ -3004,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;
}
@@ -3039,95 +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;
- int savedNumCmds = envPtr->numCommands;
+ 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);
/*
- * If our target fails to compile, revert the number of commands and the
- * pointer to the place to issue the next instruction. [Bug 3600328]
+ * Undo the shift.
+ */
+
+ mapPtr->loc[eclIndex].line -= (depth - 1);
+ mapPtr->loc[eclIndex].next -= (depth - 1);
+
+ parsePtr->numWords += (depth - 1);
+ parsePtr->tokenPtr = saveTokenPtr;
+
+ /*
+ * 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().
*/
if (result != TCL_OK) {
- envPtr->numCommands = savedNumCmds;
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.
+ */
- /*
- * Clean up if necessary.
- */
+ 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
+ }
- Tcl_FreeParse(&synthetic);
return result;
}
@@ -3157,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);
}
/*
@@ -3190,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);
@@ -3198,9 +3179,7 @@ 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);
}
/*
@@ -3224,51 +3203,13 @@ CompileBasicNArgCommand(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
- Tcl_Token *tokenPtr;
- Tcl_Obj *objPtr;
- char *bytes;
- int length, i, literal;
- DefineLineInformation;
-
- /*
- * Push the name of the command we're actually dispatching to as part of
- * the implementation.
- */
+ Tcl_Obj *objPtr = Tcl_NewObj();
- objPtr = Tcl_NewObj();
+ Tcl_IncrRefCount(objPtr);
Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
- bytes = Tcl_GetStringFromObj(objPtr, &length);
- literal = TclRegisterNewCmdLiteral(envPtr, bytes, length);
- TclSetCmdNameObj(interp, envPtr->literalArrayPtr[literal].objPtr, cmdPtr);
- TclEmitPush(literal, envPtr);
- TclDecrRefCount(objPtr);
-
- /*
- * Push the words of the command.
- */
-
- tokenPtr = TokenAfter(parsePtr->tokenPtr);
- for (i=1 ; i<parsePtr->numWords ; i++) {
- if (envPtr->clNext) {
- SetLineInformation(i);
- }
- if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- PushLiteral(envPtr, tokenPtr[1].start, tokenPtr[1].size);
- } else {
- CompileTokens(envPtr, tokenPtr, interp);
- }
- tokenPtr = TokenAfter(tokenPtr);
- }
-
- /*
- * Do the standard dispatch.
- */
-
- if (i <= 255) {
- TclEmitInstInt1(INST_INVOKE_STK1, i, envPtr);
- } else {
- TclEmitInstInt4(INST_INVOKE_STK4, i, envPtr);
- }
+ TclCompileInvocation(interp, parsePtr->tokenPtr, objPtr,
+ parsePtr->numWords, envPtr);
+ Tcl_DecrRefCount(objPtr);
return TCL_OK;
}
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index b5ae6ea..cd1a954 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);
@@ -395,7 +444,7 @@ TclUnsetEnv(
* that no = should be included, and Windows requires it.
*/
-#if defined(__WIN32__) || defined(__CYGWIN__)
+#if defined(_WIN32) || defined(__CYGWIN__)
string = ckalloc(length + 2);
memcpy(string, name, (size_t) length);
string[length] = '=';
@@ -404,7 +453,7 @@ TclUnsetEnv(
string = ckalloc(length + 1);
memcpy(string, name, (size_t) length);
string[length] = '\0';
-#endif /* WIN32 */
+#endif /* _WIN32 */
Tcl_UtfToExternalDString(NULL, string, -1, &envString);
string = ckrealloc(string, Tcl_DStringLength(&envString) + 1);
@@ -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 628dfe7..4ecca5b 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -174,34 +174,32 @@ static BuiltinFunc const tclBuiltinFuncTable[] = {
typedef struct TEBCdata {
ByteCode *codePtr; /* Constant until the BC returns */
/* -----------------------------------------*/
- const unsigned char *pc; /* These fields are used on return TO this */
- ptrdiff_t *catchTop; /* this level: they record the state when a */
- int cleanup; /* new codePtr was received for NR */
- Tcl_Obj *auxObjList; /* execution. */
- int checkInterp;
- CmdFrame cmdFrame;
+ ptrdiff_t *catchTop; /* These fields are used on return TO this */
+ Tcl_Obj *auxObjList; /* this level: they record the state when a */
+ CmdFrame cmdFrame; /* new codePtr was received for NR */
+ /* execution. */
void *stack[1]; /* Start of the actual combined catch and obj
* stacks; the struct will be expanded as
* necessary */
} TEBCdata;
#define TEBC_YIELD() \
- do { \
- esPtr->tosPtr = tosPtr; \
- TD->pc = pc; \
- TD->cleanup = cleanup; \
- TclNRAddCallback(interp, TEBCresume, TD, INT2PTR(1), NULL, NULL); \
+ do { \
+ esPtr->tosPtr = tosPtr; \
+ TclNRAddCallback(interp, TEBCresume, \
+ TD, pc, INT2PTR(cleanup), NULL); \
} while (0)
#define TEBC_DATA_DIG() \
do { \
- pc = TD->pc; \
- cleanup = TD->cleanup; \
tosPtr = esPtr->tosPtr; \
} while (0)
#define PUSH_TAUX_OBJ(objPtr) \
do { \
+ if (auxObjList) { \
+ objPtr->length += auxObjList->length; \
+ } \
objPtr->internalRep.ptrAndLongRep.ptr = auxObjList; \
auxObjList = objPtr; \
} while (0)
@@ -257,10 +255,13 @@ VarHashCreateVar(
/* Verify the stack depth, only when no expansion is in progress */
-#if TCL_COMPILE_DEBUG
+#ifdef TCL_COMPILE_DEBUG
#define CHECK_STACK() \
- ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH, \
- /*checkStack*/ auxObjList == NULL)
+ do { \
+ ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH, \
+ /*checkStack*/ !(starting || auxObjList)); \
+ starting = 0; \
+ } while (0)
#else
#define CHECK_STACK()
#endif
@@ -287,12 +288,14 @@ 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)
@@ -312,6 +315,70 @@ VarHashCreateVar(
} \
} while (0)
+#ifndef TCL_COMPILE_DEBUG
+#define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \
+ do { \
+ pc += (pcAdjustment); \
+ switch (*pc) { \
+ case INST_JUMP_FALSE1: \
+ NEXT_INST_F(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \
+ case INST_JUMP_TRUE1: \
+ NEXT_INST_F(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \
+ case INST_JUMP_FALSE4: \
+ NEXT_INST_F(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \
+ case INST_JUMP_TRUE4: \
+ NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
+ default: \
+ if ((condition) < 0) { \
+ TclNewIntObj(objResultPtr, -1); \
+ } else { \
+ objResultPtr = TCONST((condition) > 0); \
+ } \
+ NEXT_INST_F(0, (cleanup), 1); \
+ } \
+ } while (0)
+#define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
+ do { \
+ pc += (pcAdjustment); \
+ switch (*pc) { \
+ case INST_JUMP_FALSE1: \
+ NEXT_INST_V(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \
+ case INST_JUMP_TRUE1: \
+ NEXT_INST_V(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \
+ case INST_JUMP_FALSE4: \
+ NEXT_INST_V(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \
+ case INST_JUMP_TRUE4: \
+ NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
+ default: \
+ if ((condition) < 0) { \
+ TclNewIntObj(objResultPtr, -1); \
+ } else { \
+ objResultPtr = TCONST((condition) > 0); \
+ } \
+ NEXT_INST_V(0, (cleanup), 1); \
+ } \
+ } while (0)
+#else /* TCL_COMPILE_DEBUG */
+#define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \
+ do{ \
+ if ((condition) < 0) { \
+ TclNewIntObj(objResultPtr, -1); \
+ } else { \
+ objResultPtr = TCONST((condition) > 0); \
+ } \
+ NEXT_INST_F((pcAdjustment), (cleanup), 1); \
+ } while (0)
+#define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
+ do{ \
+ if ((condition) < 0) { \
+ TclNewIntObj(objResultPtr, -1); \
+ } else { \
+ objResultPtr = TCONST((condition) > 0); \
+ } \
+ NEXT_INST_V((pcAdjustment), (cleanup), 1); \
+ } while (0)
+#endif
+
/*
* Macros used to cache often-referenced Tcl evaluation stack information
* in local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO()
@@ -354,6 +421,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
@@ -375,6 +444,8 @@ VarHashCreateVar(
printf a; \
break; \
}
+# define TRACE_ERROR(interp) \
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
# define TRACE_WITH_OBJ(a, objPtr) \
while (traceInstructions) { \
fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \
@@ -391,6 +462,7 @@ VarHashCreateVar(
#else /* !TCL_COMPILE_DEBUG */
# define TRACE(a)
# define TRACE_APPEND(a)
+# define TRACE_ERROR(interp)
# define TRACE_WITH_OBJ(a, objPtr)
# define O2S(objPtr)
#endif /* TCL_COMPILE_DEBUG */
@@ -431,7 +503,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, \
@@ -445,9 +517,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, \
@@ -465,9 +537,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
@@ -491,13 +563,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) : \
@@ -505,7 +577,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
@@ -715,20 +787,21 @@ 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);
static Tcl_Obj ** StackReallocWords(Tcl_Interp *interp, int numWords);
static Tcl_NRPostProc CopyCallback;
static Tcl_NRPostProc ExprObjCallback;
-
+static Tcl_NRPostProc FinalizeOONext;
+static Tcl_NRPostProc FinalizeOONextFilter;
static Tcl_NRPostProc TEBCresume;
/*
@@ -879,7 +952,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) {
@@ -998,13 +1071,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;
@@ -1017,7 +1090,7 @@ OFFSET(
*/
#define MEMSTART(markerPtr) \
- ((markerPtr) + OFFSET(markerPtr))
+ ((markerPtr) + wordSkip(markerPtr))
/*
*----------------------------------------------------------------------
@@ -1062,7 +1135,7 @@ GrowEvaluationStack(
} else {
#ifndef PURIFY
Tcl_Obj **tmpMarkerPtr = esPtr->tosPtr + 1;
- int offset = OFFSET(tmpMarkerPtr);
+ int offset = wordSkip(tmpMarkerPtr);
if (needed + offset < 0) {
/*
@@ -1100,8 +1173,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) {
@@ -1113,7 +1186,7 @@ GrowEvaluationStack(
DeleteExecStack(esPtr);
esPtr = oldPtr;
} else {
- currElems = esPtr->endPtr - &esPtr->stackWords[-1];
+ currElems = esPtr->endPtr - STACK_BASE(esPtr);
}
/*
@@ -1267,10 +1340,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;
@@ -1420,17 +1493,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);
}
@@ -1441,14 +1509,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;
}
@@ -1491,7 +1560,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)
@@ -1531,7 +1600,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++;
@@ -1603,10 +1672,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);
@@ -1664,7 +1732,7 @@ TclCompileObj(
* here.
*/
- codePtr = objPtr->internalRep.otherValuePtr;
+ codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != namespacePtr)
@@ -1792,7 +1860,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++;
@@ -1866,7 +1934,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;
@@ -1899,7 +1967,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;
@@ -1929,6 +1997,41 @@ TclIncrObj(
/*
*----------------------------------------------------------------------
*
+ * ArgumentBCEnter --
+ *
+ * This is a helper for TclNRExecuteByteCode/TEBCresume that encapsulates
+ * a code sequence that is fairly common in the code but *not* commonly
+ * called.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * May register information about the bytecode in the command frame.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ArgumentBCEnter(
+ Tcl_Interp *interp,
+ ByteCode *codePtr,
+ TEBCdata *tdPtr,
+ const unsigned char *pc,
+ int objc,
+ Tcl_Obj **objv)
+{
+ int cmd;
+
+ if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
+ TclArgumentBCEnter(interp, objv, objc, codePtr, &tdPtr->cmdFrame, cmd,
+ pc - codePtr->codeStart);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclNRExecuteByteCode --
*
* This procedure executes the instructions of a ByteCode structure. It
@@ -1961,10 +2064,6 @@ TclNRExecuteByteCode(
* sizeof(void *);
int numWords = (size + sizeof(Tcl_Obj *) - 1) / sizeof(Tcl_Obj *);
- if (iPtr->execEnvPtr->rewind) {
- return TCL_ERROR;
- }
-
codePtr->refCount++;
/*
@@ -1983,11 +2082,8 @@ TclNRExecuteByteCode(
esPtr->tosPtr = initTosPtr;
TD->codePtr = codePtr;
- TD->pc = codePtr->codeStart;
TD->catchTop = initCatchTop;
- TD->cleanup = 0;
TD->auxObjList = NULL;
- TD->checkInterp = 0;
/*
* TIP #280: Initialize the frame. Do not push it yet: it will be pushed
@@ -1997,7 +2093,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;
@@ -2005,8 +2100,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++;
@@ -2016,8 +2112,8 @@ TclNRExecuteByteCode(
* Push the callback for bytecode execution
*/
- TclNRAddCallback(interp, TEBCresume, TD, /*resume*/ INT2PTR(0),
- NULL, NULL);
+ TclNRAddCallback(interp, TEBCresume, TD, /* pc */ NULL,
+ /* cleanup */ INT2PTR(0), NULL);
return TCL_OK;
}
@@ -2073,9 +2169,6 @@ TEBCresume(
#define auxObjList (TD->auxObjList)
#define catchTop (TD->catchTop)
#define codePtr (TD->codePtr)
-#define checkInterp (TD->checkInterp)
- /* Indicates when a check of interp readyness is
- * necessary. Set by CACHE_STACK_INFO() */
/*
* Globals: variables that store state, must remain valid at all times.
@@ -2083,7 +2176,8 @@ TEBCresume(
Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation
* stack. */
- const unsigned char *pc; /* The current program counter. */
+ const unsigned char *pc = data[1];
+ /* The current program counter. */
unsigned char inst; /* The currently running instruction */
/*
@@ -2091,8 +2185,10 @@ TEBCresume(
* executing an instruction.
*/
- int cleanup = 0;
+ int cleanup = PTR2INT(data[2]);
Tcl_Obj *objResultPtr;
+ int checkInterp; /* Indicates when a check of interp readyness
+ * is necessary. Set by CACHE_STACK_INFO() */
/*
* Locals - variables that are used within opcodes or bounded sections of
@@ -2110,88 +2206,84 @@ TEBCresume(
#endif
#ifdef TCL_COMPILE_DEBUG
+ int starting = 1;
traceInstructions = (tclTraceExec == 3);
#endif
TEBC_DATA_DIG();
#ifdef TCL_COMPILE_DEBUG
- if (!data[1] && (tclTraceExec >= 2)) {
+ if (!pc && (tclTraceExec >= 2)) {
PrintByteCodeInfo(codePtr);
fprintf(stdout, " Starting stack top=%d\n", (int) CURR_DEPTH);
fflush(stdout);
}
#endif
- if (data[1] /* resume from invocation */) {
+ if (!pc) {
+ /* bytecode is starting from scratch */
+ checkInterp = 0;
+ pc = codePtr->codeStart;
+ goto cleanup0;
+ } else {
+ /* resume from invocation */
+ CACHE_STACK_INFO();
if (iPtr->execEnvPtr->rewind) {
result = TCL_ERROR;
+ goto abnormalReturn;
}
+
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);
+ TclArgumentBCRelease(interp, bcFramePtr);
}
if (codePtr->flags & TCL_BYTECODE_RECOMPILE) {
iPtr->flags |= ERR_ALREADY_LOGGED;
codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;
}
- 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.
- */
-
- 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
- * avoid any side effects caused by the resetting of errorInfo and
- * errorCode [Bug 804681], which are not needed here. We chose
- * instead to manipulate the interp's object result directly.
- *
- * Note that the result object is now in objResultPtr, it keeps
- * the refCount it had in its role of iPtr->objResultPtr.
- */
-
- TclNewObj(objPtr);
- Tcl_IncrRefCount(objPtr);
- iPtr->objResultPtr = objPtr;
- NEXT_INST_V(0, cleanup, -1);
+ if (result != TCL_OK) {
+ pc--;
+ goto processExceptionReturn;
}
/*
- * Result not TCL_OK: fall through
+ * Push the call's object result and continue execution with the next
+ * instruction.
*/
- }
- if (iPtr->execEnvPtr->rewind) {
- result = TCL_ERROR;
- goto abnormalReturn;
- }
-
- if (result != TCL_OK) {
- pc--;
- goto processExceptionReturn;
- }
+ TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
+ objc, cmdNameBuf), Tcl_GetObjResult(interp));
- /*
- * Loop executing instructions until a "done" instruction, a TCL_RETURN,
- * or some error.
- */
+ /*
+ * Reset the interp's result to avoid possible duplications of large
+ * objects [Bug 781585]. We do not call Tcl_ResetResult to avoid any
+ * side effects caused by the resetting of errorInfo and errorCode
+ * [Bug 804681], which are not needed here. We chose instead to
+ * manipulate the interp's object result directly.
+ *
+ * Note that the result object is now in objResultPtr, it keeps the
+ * refCount it had in its role of iPtr->objResultPtr.
+ */
- goto cleanup0;
+ 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);
+ }
/*
* Targets for standard instruction endings; unrolled for speed in the
@@ -2317,7 +2409,7 @@ TEBCresume(
goto instLoadScalar1;
} else if (inst == INST_PUSH1) {
PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]);
- TRACE_WITH_OBJ(("%u => ", TclGetInt1AtPtr(pc+1)), OBJ_AT_TOS);
+ TRACE_WITH_OBJ(("%u => ", TclGetUInt1AtPtr(pc+1)), OBJ_AT_TOS);
inst = *(pc += 2);
goto peepholeStart;
} else if (inst == INST_START_CMD) {
@@ -2328,13 +2420,22 @@ TEBCresume(
iPtr->cmdCount += TclGetUInt4AtPtr(pc+5);
if (checkInterp) {
checkInterp = 0;
- if ((codePtr->compileEpoch != iPtr->compileEpoch)
- || (codePtr->nsEpoch != iPtr->varFramePtr->nsPtr->resolverEpoch)) {
+ 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) {
@@ -2350,7 +2451,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);
}
@@ -2359,6 +2460,7 @@ TEBCresume(
iPtr->flags &= ~ERR_ALREADY_LOGGED;
}
cleanup = 2;
+ TRACE_APPEND(("\n"));
goto processExceptionReturn;
}
@@ -2366,36 +2468,119 @@ 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: {
- CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+ {
+ CoroutineData *corPtr;
+ int yieldParameter;
+ case INST_YIELD:
+ corPtr = iPtr->execEnvPtr->corPtr;
TRACE(("%.30s => ", O2S(OBJ_AT_TOS)));
if (!corPtr) {
TRACE_APPEND(("ERROR: yield outside coroutine\n"));
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"yield can only be called in a coroutine", -1));
+ DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
NULL);
+ CACHE_STACK_INFO();
goto gotError;
}
#ifdef TCL_COMPILE_DEBUG
- TRACE_WITH_OBJ(("yield, result="), iPtr->objResultPtr);
- if (traceInstructions) {
- fprintf(stdout, "\n");
+ if (tclTraceExec >= 2) {
+ if (traceInstructions) {
+ TRACE_APPEND(("YIELD...\n"));
+ } else {
+ fprintf(stdout, "%d: (%u) yielding value \"%.30s\"\n",
+ iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
+ Tcl_GetString(OBJ_AT_TOS));
+ }
+ fflush(stdout);
}
#endif
+ yieldParameter = 0;
+ Tcl_SetObjResult(interp, OBJ_AT_TOS);
+ goto doYield;
+
+ case INST_YIELD_TO_INVOKE:
+ corPtr = iPtr->execEnvPtr->corPtr;
+ valuePtr = OBJ_AT_TOS;
+ if (!corPtr) {
+ TRACE(("[%.30s] => ERROR: yield outside coroutine\n",
+ O2S(valuePtr)));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "yieldto can only be called in a coroutine", -1));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
+ NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+ if (((Namespace *)TclGetCurrentNamespace(interp))->flags & NS_DYING) {
+ TRACE(("[%.30s] => ERROR: yield in deleted\n",
+ O2S(valuePtr)));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "yieldto called in deleted namespace", -1));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
+ NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+
+#ifdef TCL_COMPILE_DEBUG
+ if (tclTraceExec >= 2) {
+ if (traceInstructions) {
+ TRACE(("[%.30s] => YIELD...\n", O2S(valuePtr)));
+ } else {
+ /* FIXME: What is the right thing to trace? */
+ fprintf(stdout, "%d: (%u) yielding to [%.30s]\n",
+ iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
+ Tcl_GetString(valuePtr));
+ }
+ fflush(stdout);
+ }
+#endif
+
+ /*
+ * Install a tailcall record in the caller and continue with the
+ * yield. The yield is switched into multi-return mode (via the
+ * 'yieldParameter').
+ */
+
+ Tcl_IncrRefCount(valuePtr);
+ iPtr->execEnvPtr = corPtr->callerEEPtr;
+ TclSetTailcall(interp, valuePtr);
+ iPtr->execEnvPtr = corPtr->eePtr;
+ yieldParameter = (PTR2INT(NULL)+1); /*==CORO_ACTIVATE_YIELDM*/
+
+ doYield:
/* TIP #280: Record the last piece of info needed by
* 'TclGetSrcInfoForPc', and push the frame.
*/
@@ -2404,18 +2589,14 @@ TEBCresume(
iPtr->cmdFramePtr = bcFramePtr;
if (iPtr->flags & INTERP_DEBUG_FRAME) {
- TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
- codePtr, bcFramePtr, pc - codePtr->codeStart);
+ ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
}
pc++;
cleanup = 1;
TEBC_YIELD();
-
- Tcl_SetObjResult(interp, OBJ_AT_TOS);
TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
- INT2PTR(0), NULL, NULL);
-
+ INT2PTR(yieldParameter), NULL, NULL);
return TCL_OK;
}
@@ -2428,11 +2609,14 @@ TEBCresume(
TRACE(("%d => ERROR: tailcall in non-proc context\n", opnd));
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"tailcall can only be called from a proc or lambda", -1));
+ DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
+ CACHE_STACK_INFO();
goto gotError;
}
#ifdef TCL_COMPILE_DEBUG
+ /* FIXME: What is the right thing to trace? */
{
register int i;
@@ -2498,9 +2682,6 @@ TEBCresume(
TclDecrRefCount(objPtr);
NEXT_INST_F(1, 0, 0);
- case INST_NOP:
- NEXT_INST_F(1, 0, 0);
-
case INST_DUP:
objResultPtr = OBJ_AT_TOS;
TRACE_WITH_OBJ(("=> "), objResultPtr);
@@ -2509,7 +2690,7 @@ TEBCresume(
case INST_OVER:
opnd = TclGetUInt4AtPtr(pc+1);
objResultPtr = OBJ_AT_DEPTH(opnd);
- TRACE_WITH_OBJ(("=> "), objResultPtr);
+ TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
NEXT_INST_F(5, 0, 1);
case INST_REVERSE: {
@@ -2524,10 +2705,11 @@ TEBCresume(
*b = tmpPtr;
a++; b--;
}
+ TRACE(("%u => OK\n", opnd));
NEXT_INST_F(5, 0, 0);
}
- case INST_CONCAT1: {
+ case INST_STR_CONCAT1: {
int appendLen = 0;
char *bytes, *p;
Tcl_Obj **currPtr;
@@ -2607,7 +2789,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);
@@ -2643,7 +2825,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);
@@ -2676,6 +2858,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
@@ -2692,9 +2885,28 @@ TEBCresume(
TclNewObj(objPtr);
objPtr->internalRep.ptrAndLongRep.value = CURR_DEPTH;
+ objPtr->length = 0;
PUSH_TAUX_OBJ(objPtr);
+ TRACE(("=> mark depth as %d\n", (int) CURR_DEPTH));
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
+ TRACE(("=> drop %d items\n", objc));
+ NEXT_INST_V(1, objc, 0);
+
case INST_EXPAND_STKTOP: {
int i;
ptrdiff_t moved;
@@ -2706,9 +2918,9 @@ TEBCresume(
*/
objPtr = OBJ_AT_TOS;
+ TRACE(("\"%.30s\" => ", O2S(objPtr)));
if (TclListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
- TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(objPtr)),
- Tcl_GetObjResult(interp));
+ TRACE_ERROR(interp);
goto gotError;
}
(void) POP_OBJECT();
@@ -2720,22 +2932,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;
+ }
}
/*
@@ -2747,6 +2964,7 @@ TEBCresume(
PUSH_OBJECT(objv[i]);
}
+ TRACE_APPEND(("OK\n"));
Tcl_DecrRefCount(objPtr);
NEXT_INST_F(5, 0, 0);
}
@@ -2839,8 +3057,7 @@ TEBCresume(
iPtr->cmdFramePtr = bcFramePtr;
if (iPtr->flags & INTERP_DEBUG_FRAME) {
- TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
- codePtr, bcFramePtr, pc - codePtr->codeStart);
+ ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
}
DECACHE_STACK_INFO();
@@ -2848,7 +3065,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:
@@ -2985,8 +3202,7 @@ 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);
+ ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
}
iPtr->ensembleRewrite.sourceObjs = objv;
iPtr->ensembleRewrite.numRemovedObjs = opnd;
@@ -3085,7 +3301,7 @@ TEBCresume(
varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr, opnd);
if (varPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
cleanup = 1;
@@ -3111,7 +3327,7 @@ TEBCresume(
TCL_LEAVE_ERR_MSG, "read", /*createPart1*/0, /*createPart2*/1,
&arrayPtr);
if (!varPtr) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -3138,7 +3354,7 @@ TEBCresume(
part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd);
CACHE_STACK_INFO();
if (!objResultPtr) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
@@ -3287,7 +3503,7 @@ TEBCresume(
varPtr = TclObjLookupVarEx(interp, objPtr,part2Ptr, TCL_LEAVE_ERR_MSG,
"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
if (!varPtr) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
cleanup = ((part2Ptr == NULL)? 2 : 3);
@@ -3337,7 +3553,7 @@ TEBCresume(
varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr, opnd);
if (!varPtr) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
goto doCallPtrSetVar;
@@ -3385,7 +3601,7 @@ TEBCresume(
part1Ptr, part2Ptr, valuePtr, storeFlags, opnd);
CACHE_STACK_INFO();
if (!objResultPtr) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
#ifndef TCL_COMPILE_DEBUG
@@ -3411,7 +3627,7 @@ TEBCresume(
{
Tcl_Obj *incrPtr;
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
Tcl_WideInt w;
#endif
long increment;
@@ -3460,9 +3676,11 @@ 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);
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ DECACHE_STACK_INFO();
+ Tcl_AddErrorInfo(interp,
+ "\n (reading value of variable to increment)");
+ CACHE_STACK_INFO();
+ TRACE_ERROR(interp);
Tcl_DecrRefCount(incrPtr);
goto gotError;
}
@@ -3488,7 +3706,7 @@ TEBCresume(
varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
TCL_LEAVE_ERR_MSG, "read", 1, 1, arrayPtr, opnd);
if (!varPtr) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
Tcl_DecrRefCount(incrPtr);
goto gotError;
}
@@ -3533,7 +3751,7 @@ TEBCresume(
}
goto doneIncr;
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
w = (Tcl_WideInt)augend;
TRACE(("%u %ld => ", opnd, increment));
@@ -3555,7 +3773,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;
@@ -3600,8 +3818,7 @@ TEBCresume(
TclNewLongObj(incrPtr, increment);
if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) {
Tcl_DecrRefCount(incrPtr);
- TRACE_APPEND(("ERROR: %.30s\n",
- O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
Tcl_DecrRefCount(incrPtr);
@@ -3623,7 +3840,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)) {
@@ -3638,8 +3855,7 @@ TEBCresume(
}
if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) {
Tcl_DecrRefCount(incrPtr);
- TRACE_APPEND(("ERROR: %.30s\n",
- O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
Tcl_DecrRefCount(incrPtr);
@@ -3650,8 +3866,7 @@ TEBCresume(
CACHE_STACK_INFO();
Tcl_DecrRefCount(incrPtr);
if (objResultPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n",
- O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
}
@@ -3672,6 +3887,8 @@ TEBCresume(
*/
case INST_EXIST_SCALAR:
+ cleanup = 0;
+ pcAdjustment = 5;
opnd = TclGetUInt4AtPtr(pc+1);
varPtr = LOCAL(opnd);
while (TclIsVarLink(varPtr)) {
@@ -3688,16 +3905,11 @@ TEBCresume(
varPtr = NULL;
}
}
-
- /*
- * Tricky! Arrays always exist.
- */
-
- objResultPtr = TCONST(!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1);
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_F(5, 0, 1);
+ goto afterExistsPeephole;
case INST_EXIST_ARRAY:
+ cleanup = 1;
+ pcAdjustment = 5;
opnd = TclGetUInt4AtPtr(pc+1);
part2Ptr = OBJ_AT_TOS;
arrayPtr = LOCAL(opnd);
@@ -3708,7 +3920,7 @@ TEBCresume(
if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)) {
varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
if (!varPtr || !ReadTraced(varPtr)) {
- goto doneExistArray;
+ goto afterExistsPeephole;
}
}
varPtr = TclLookupArrayElement(interp, NULL, part2Ptr, 0, "access",
@@ -3725,13 +3937,11 @@ TEBCresume(
varPtr = NULL;
}
}
- doneExistArray:
- objResultPtr = TCONST(!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1);
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_F(5, 1, 1);
+ goto afterExistsPeephole;
case INST_EXIST_ARRAY_STK:
cleanup = 2;
+ pcAdjustment = 1;
part2Ptr = OBJ_AT_TOS; /* element name */
part1Ptr = OBJ_UNDER_TOS; /* array name */
TRACE(("\"%.30s(%.30s)\" => ", O2S(part1Ptr), O2S(part2Ptr)));
@@ -3739,6 +3949,7 @@ TEBCresume(
case INST_EXIST_STK:
cleanup = 1;
+ pcAdjustment = 1;
part2Ptr = NULL;
part1Ptr = OBJ_AT_TOS; /* variable name */
TRACE(("\"%.30s\" => ", O2S(part1Ptr)));
@@ -3758,9 +3969,17 @@ TEBCresume(
varPtr = NULL;
}
}
- objResultPtr = TCONST(!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1);
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_V(1, cleanup, 1);
+
+ /*
+ * Peep-hole optimisation: if you're about to jump, do jump from here.
+ */
+
+ afterExistsPeephole: {
+ int found = (varPtr && !TclIsVarUndefined(varPtr));
+
+ TRACE_APPEND(("%d\n", found ? 1 : 0));
+ JUMP_PEEPHOLE_V(found, pcAdjustment, cleanup);
+ }
/*
* End of INST_EXIST instructions.
@@ -3778,7 +3997,7 @@ TEBCresume(
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
- TRACE(("%s %u\n", (flags?"normal":"noerr"), opnd));
+ TRACE(("%s %u => ", (flags ? "normal" : "noerr"), opnd));
if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) {
/*
* No errors, no traces, no searches: just make the variable cease
@@ -3791,6 +4010,7 @@ TEBCresume(
goto slowUnsetScalar;
}
varPtr->value.objPtr = NULL;
+ TRACE_APPEND(("OK\n"));
NEXT_INST_F(6, 0, 0);
}
@@ -3811,7 +4031,7 @@ TEBCresume(
while (TclIsVarLink(arrayPtr)) {
arrayPtr = arrayPtr->value.linkPtr;
}
- TRACE(("%s %u \"%.30s\"\n",
+ TRACE(("%s %u \"%.30s\" => ",
(flags ? "normal" : "noerr"), opnd, O2S(part2Ptr)));
if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)) {
varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
@@ -3827,12 +4047,14 @@ TEBCresume(
goto slowUnsetArray;
}
varPtr->value.objPtr = NULL;
+ TRACE_APPEND(("OK\n"));
NEXT_INST_F(6, 1, 0);
} else if (!varPtr && !(flags & TCL_LEAVE_ERR_MSG)) {
/*
* Don't need to do anything here.
*/
+ TRACE_APPEND(("OK\n"));
NEXT_INST_F(6, 1, 0);
}
}
@@ -3856,7 +4078,7 @@ TEBCresume(
cleanup = 2;
part2Ptr = OBJ_AT_TOS; /* element name */
part1Ptr = OBJ_UNDER_TOS; /* array name */
- TRACE(("%s \"%.30s(%.30s)\"\n", (flags?"normal":"noerr"),
+ TRACE(("%s \"%.30s(%.30s)\" => ", (flags ? "normal" : "noerr"),
O2S(part1Ptr), O2S(part2Ptr)));
goto doUnsetStk;
@@ -3865,7 +4087,8 @@ TEBCresume(
cleanup = 1;
part2Ptr = NULL;
part1Ptr = OBJ_AT_TOS; /* variable name */
- TRACE(("%s \"%.30s\"\n", (flags?"normal":"noerr"), O2S(part1Ptr)));
+ TRACE(("%s \"%.30s\" => ", (flags ? "normal" : "noerr"),
+ O2S(part1Ptr)));
doUnsetStk:
DECACHE_STACK_INFO();
@@ -3874,11 +4097,12 @@ TEBCresume(
goto errorInUnset;
}
CACHE_STACK_INFO();
+ TRACE_APPEND(("OK\n"));
NEXT_INST_V(2, cleanup, 0);
errorInUnset:
CACHE_STACK_INFO();
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
/*
@@ -3887,7 +4111,7 @@ TEBCresume(
case INST_DICT_DONE:
opnd = TclGetUInt4AtPtr(pc+1);
- TRACE(("%u\n", opnd));
+ TRACE(("%u => OK\n", opnd));
varPtr = LOCAL(opnd);
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
@@ -3940,8 +4164,7 @@ TEBCresume(
TCL_GLOBAL_ONLY|TCL_TRACE_ARRAY), 1, opnd);
CACHE_STACK_INFO();
if (result == TCL_ERROR) {
- TRACE_APPEND(("ERROR: %.30s\n",
- O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
}
@@ -3974,7 +4197,7 @@ TEBCresume(
varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, TCL_LEAVE_ERR_MSG,
"set", /*createPart1*/1, /*createPart2*/0, &arrayPtr);
if (varPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
doArrayMake:
@@ -3986,9 +4209,10 @@ TEBCresume(
TclObjVarErrMsg(interp, part1Ptr, NULL, "array set",
"variable isn't array", opnd);
+ DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
- TRACE_APPEND(("ERROR: bad array ref: %.30s\n",
- O2S(Tcl_GetObjResult(interp))));
+ CACHE_STACK_INFO();
+ TRACE_ERROR(interp);
goto gotError;
}
TclSetVarArray(varPtr);
@@ -4016,9 +4240,11 @@ TEBCresume(
Namespace *savedNsPtr;
case INST_UPVAR:
- TRACE_WITH_OBJ(("upvar "), OBJ_UNDER_TOS);
+ TRACE(("%d %.30s %.30s => ", TclGetInt4AtPtr(pc+1),
+ O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
if (TclObjGetFrame(interp, OBJ_UNDER_TOS, &framePtr) == -1) {
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -4033,13 +4259,16 @@ TEBCresume(
/*createPart2*/ 1, &varPtr);
iPtr->varFramePtr = savedFramePtr;
if (!otherPtr) {
+ TRACE_ERROR(interp);
goto gotError;
}
goto doLinkVars;
case INST_NSUPVAR:
- TRACE_WITH_OBJ(("nsupvar "), OBJ_UNDER_TOS);
+ TRACE(("%d %.30s %.30s => ", TclGetInt4AtPtr(pc+1),
+ O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
if (TclGetNamespaceFromObj(interp, OBJ_UNDER_TOS, &nsPtr) != TCL_OK) {
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -4054,16 +4283,18 @@ TEBCresume(
/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
iPtr->varFramePtr->nsPtr = savedNsPtr;
if (!otherPtr) {
+ TRACE_ERROR(interp);
goto gotError;
}
goto doLinkVars;
case INST_VARIABLE:
- TRACE(("variable "));
+ TRACE(("%d, %.30s => ", TclGetInt4AtPtr(pc+1), O2S(OBJ_AT_TOS)));
otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
if (!otherPtr) {
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -4081,7 +4312,7 @@ TEBCresume(
* if there are no errors; otherwise, let it handle the case.
*/
- opnd = TclGetInt4AtPtr(pc+1);;
+ opnd = TclGetInt4AtPtr(pc+1);
varPtr = LOCAL(opnd);
if ((varPtr != otherPtr) && !TclIsVarTraced(varPtr)
&& (TclIsVarUndefined(varPtr) || TclIsVarLink(varPtr))) {
@@ -4093,6 +4324,7 @@ TEBCresume(
Var *linkPtr = varPtr->value.linkPtr;
if (linkPtr == otherPtr) {
+ TRACE_APPEND(("already linked\n"));
NEXT_INST_F(5, 1, 0);
}
if (TclIsVarInHash(linkPtr)) {
@@ -4109,6 +4341,7 @@ TEBCresume(
}
} else if (TclPtrObjMakeUpvar(interp, otherPtr, NULL, 0,
opnd) != TCL_OK) {
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -4117,6 +4350,7 @@ TEBCresume(
* variables - and [variable] did not push it at all.
*/
+ TRACE_APPEND(("link made\n"));
NEXT_INST_F(5, 1, 0);
}
@@ -4163,32 +4397,30 @@ TEBCresume(
doCondJump:
valuePtr = OBJ_AT_TOS;
+ TRACE(("%d => ", jmpOffset[
+ (*pc==INST_JUMP_FALSE1 || *pc==INST_JUMP_FALSE4) ? 0 : 1]));
/* TODO - check claim that taking address of b harms performance */
/* TODO - consider optimization search for constants */
if (TclGetBooleanFromObj(interp, valuePtr, &b) != TCL_OK) {
- TRACE_WITH_OBJ(("%d => ERROR: ", jmpOffset[
- ((*pc == INST_JUMP_FALSE1) || (*pc == INST_JUMP_FALSE4))
- ? 0 : 1]), Tcl_GetObjResult(interp));
+ TRACE_ERROR(interp);
goto gotError;
}
#ifdef TCL_COMPILE_DEBUG
if (b) {
if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
- TRACE(("%d => %.20s true, new pc %u\n", jmpOffset[1],
- O2S(valuePtr),
+ TRACE_APPEND(("%.20s true, new pc %u\n", O2S(valuePtr),
(unsigned)(pc + jmpOffset[1] - codePtr->codeStart)));
} else {
- TRACE(("%d => %.20s true\n", jmpOffset[0], O2S(valuePtr)));
+ TRACE_APPEND(("%.20s true\n", O2S(valuePtr)));
}
} else {
if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
- TRACE(("%d => %.20s false\n", jmpOffset[0], O2S(valuePtr)));
+ TRACE_APPEND(("%.20s false\n", O2S(valuePtr)));
} else {
- TRACE(("%d => %.20s false, new pc %u\n", jmpOffset[0],
- O2S(valuePtr),
- (unsigned)(pc + jmpOffset[1] - codePtr->codeStart)));
+ TRACE_APPEND(("%.20s false, new pc %u\n", O2S(valuePtr),
+ (unsigned)(pc + jmpOffset[0] - codePtr->codeStart)));
}
}
#endif
@@ -4206,7 +4438,7 @@ TEBCresume(
opnd = TclGetInt4AtPtr(pc+1);
jtPtr = (JumptableInfo *) codePtr->auxDataArrayPtr[opnd].clientData;
- TRACE(("%d => %.20s ", opnd, O2S(OBJ_AT_TOS)));
+ TRACE(("%d \"%.20s\" => ", opnd, O2S(OBJ_AT_TOS)));
hPtr = Tcl_FindHashEntry(&jtPtr->hashTable, TclGetString(OBJ_AT_TOS));
if (hPtr != NULL) {
int jumpOffset = PTR2INT(Tcl_GetHashValue(hPtr));
@@ -4301,13 +4533,11 @@ TEBCresume(
register CallFrame *framePtr = iPtr->varFramePtr;
register CallFrame *rootFramePtr = iPtr->rootFramePtr;
- valuePtr = OBJ_AT_TOS;
- if (TclGetIntFromObj(interp, valuePtr, &level) != TCL_OK) {
- TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
- Tcl_GetObjResult(interp));
+ TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
+ if (TclGetIntFromObj(interp, OBJ_AT_TOS, &level) != TCL_OK) {
+ TRACE_ERROR(interp);
goto gotError;
}
- TRACE(("%d => ", level));
if (level <= 0) {
level += framePtr->level;
}
@@ -4316,38 +4546,76 @@ TEBCresume(
/* Empty loop body */
}
if (framePtr == rootFramePtr) {
- Tcl_AppendResult(interp, "bad level \"", TclGetString(valuePtr),
- "\"", NULL);
- TRACE_APPEND(("ERROR: bad level\n"));
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad level \"%s\"", TclGetString(OBJ_AT_TOS)));
+ TRACE_ERROR(interp);
+ DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL",
- TclGetString(valuePtr), NULL);
+ TclGetString(OBJ_AT_TOS), NULL);
+ CACHE_STACK_INFO();
goto gotError;
}
objResultPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv);
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)));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
+ TclGetString(OBJ_AT_TOS), NULL);
+ CACHE_STACK_INFO();
+ 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);
}
- case INST_TCLOO_SELF: {
- CallFrame *framePtr = iPtr->varFramePtr;
+
+ /*
+ * -----------------------------------------------------------------
+ * Start of TclOO support instructions.
+ */
+
+ {
+ Object *oPtr;
+ CallFrame *framePtr;
CallContext *contextPtr;
+ int skip, newDepth;
+ case INST_TCLOO_SELF:
+ framePtr = iPtr->varFramePtr;
if (framePtr == NULL ||
!(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
TRACE(("=> ERROR: no TclOO call context\n"));
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"self may only be called from inside a method",
-1));
+ DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+ CACHE_STACK_INFO();
goto gotError;
}
contextPtr = framePtr->clientData;
@@ -4359,9 +4627,212 @@ TEBCresume(
objResultPtr = TclOOObjectName(interp, contextPtr->oPtr);
TRACE_WITH_OBJ(("=> "), objResultPtr);
NEXT_INST_F(1, 0, 1);
- }
- {
- Object *oPtr;
+
+ case INST_TCLOO_NEXT_CLASS:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ framePtr = iPtr->varFramePtr;
+ valuePtr = OBJ_AT_DEPTH(opnd - 2);
+ objv = &OBJ_AT_DEPTH(opnd - 1);
+ skip = 2;
+ TRACE(("%d => ", opnd));
+ if (framePtr == NULL ||
+ !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
+ TRACE_APPEND(("ERROR: no TclOO call context\n"));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "nextto may only be called from inside a method",
+ -1));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+ contextPtr = framePtr->clientData;
+
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, valuePtr);
+ if (oPtr == NULL) {
+ TRACE_APPEND(("ERROR: \"%.30s\" not object\n", O2S(valuePtr)));
+ goto gotError;
+ } else {
+ Class *classPtr = oPtr->classPtr;
+ struct MInvoke *miPtr;
+ int i;
+ const char *methodType;
+
+ if (classPtr == NULL) {
+ TRACE_APPEND(("ERROR: \"%.30s\" not class\n", O2S(valuePtr)));
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" is not a class", TclGetString(valuePtr)));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+
+ for (i=contextPtr->index+1 ; i<contextPtr->callPtr->numChain ; i++) {
+ miPtr = contextPtr->callPtr->chain + i;
+ if (!miPtr->isFilter &&
+ miPtr->mPtr->declaringClassPtr == classPtr) {
+ newDepth = i;
+#ifdef TCL_COMPILE_DEBUG
+ if (tclTraceExec >= 2) {
+ if (traceInstructions) {
+ strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
+ } else {
+ fprintf(stdout, "%d: (%u) invoking ",
+ iPtr->numLevels,
+ (unsigned)(pc - codePtr->codeStart));
+ }
+ for (i = 0; i < opnd; i++) {
+ TclPrintObject(stdout, objv[i], 15);
+ fprintf(stdout, " ");
+ }
+ fprintf(stdout, "\n");
+ fflush(stdout);
+ }
+#endif /*TCL_COMPILE_DEBUG*/
+ goto doInvokeNext;
+ }
+ }
+
+ if (contextPtr->callPtr->flags & CONSTRUCTOR) {
+ methodType = "constructor";
+ } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
+ methodType = "destructor";
+ } else {
+ methodType = "method";
+ }
+
+ TRACE_APPEND(("ERROR: \"%.30s\" not on reachable chain\n",
+ O2S(valuePtr)));
+ for (i=contextPtr->index ; i>=0 ; i--) {
+ miPtr = contextPtr->callPtr->chain + i;
+ if (miPtr->isFilter
+ || miPtr->mPtr->declaringClassPtr != classPtr) {
+ continue;
+ }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s implementation by \"%s\" not reachable from here",
+ methodType, TclGetString(valuePtr)));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE",
+ NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s has no non-filter implementation by \"%s\"",
+ methodType, TclGetString(valuePtr)));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+
+ case INST_TCLOO_NEXT:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ objv = &OBJ_AT_DEPTH(opnd - 1);
+ framePtr = iPtr->varFramePtr;
+ skip = 1;
+ TRACE(("%d => ", opnd));
+ if (framePtr == NULL ||
+ !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
+ TRACE_APPEND(("ERROR: no TclOO call context\n"));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "next may only be called from inside a method",
+ -1));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+ }
+ contextPtr = framePtr->clientData;
+
+ newDepth = contextPtr->index + 1;
+ if (newDepth >= contextPtr->callPtr->numChain) {
+ /*
+ * We're at the end of the chain; generate an error message unless
+ * the interpreter is being torn down, in which case we might be
+ * getting here because of methods/destructors doing a [next] (or
+ * equivalent) unexpectedly.
+ */
+
+ const char *methodType;
+
+ if (contextPtr->callPtr->flags & CONSTRUCTOR) {
+ methodType = "constructor";
+ } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
+ methodType = "destructor";
+ } else {
+ methodType = "method";
+ }
+
+ TRACE_APPEND(("ERROR: no TclOO next impl\n"));
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no next %s implementation", methodType));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
+ CACHE_STACK_INFO();
+ goto gotError;
+#ifdef TCL_COMPILE_DEBUG
+ } else if (tclTraceExec >= 2) {
+ int i;
+
+ if (traceInstructions) {
+ strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
+ } else {
+ fprintf(stdout, "%d: (%u) invoking ",
+ iPtr->numLevels, (unsigned)(pc - codePtr->codeStart));
+ }
+ for (i = 0; i < opnd; i++) {
+ TclPrintObject(stdout, objv[i], 15);
+ fprintf(stdout, " ");
+ }
+ fprintf(stdout, "\n");
+ fflush(stdout);
+#endif /*TCL_COMPILE_DEBUG*/
+ }
+
+ doInvokeNext:
+ bcFramePtr->data.tebc.pc = (char *) pc;
+ iPtr->cmdFramePtr = bcFramePtr;
+
+ if (iPtr->flags & INTERP_DEBUG_FRAME) {
+ ArgumentBCEnter(interp, codePtr, TD, pc, opnd, objv);
+ }
+
+ pcAdjustment = 2;
+ cleanup = opnd;
+ DECACHE_STACK_INFO();
+ iPtr->varFramePtr = framePtr->callerVarPtr;
+ pc += pcAdjustment;
+ TEBC_YIELD();
+
+ oPtr = contextPtr->oPtr;
+ if (oPtr->flags & FILTER_HANDLING) {
+ TclNRAddCallback(interp, FinalizeOONextFilter,
+ framePtr, contextPtr, INT2PTR(contextPtr->index),
+ INT2PTR(contextPtr->skip));
+ } else {
+ TclNRAddCallback(interp, FinalizeOONext,
+ framePtr, contextPtr, INT2PTR(contextPtr->index),
+ INT2PTR(contextPtr->skip));
+ }
+ contextPtr->skip = skip;
+ contextPtr->index = newDepth;
+ if (contextPtr->callPtr->chain[newDepth].isFilter
+ || contextPtr->callPtr->flags & FILTER_HANDLING) {
+ oPtr->flags |= FILTER_HANDLING;
+ } else {
+ oPtr->flags &= ~FILTER_HANDLING;
+ }
+
+ {
+ register Method *const mPtr =
+ contextPtr->callPtr->chain[newDepth].mPtr;
+
+ return mPtr->typePtr->callProc(mPtr->clientData, interp,
+ (Tcl_ObjectContext) contextPtr, opnd, objv);
+ }
case INST_TCLOO_IS_OBJECT:
oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS);
@@ -4395,6 +4866,7 @@ TEBCresume(
}
/*
+ * End of TclOO support instructions.
* -----------------------------------------------------------------
* Start of INST_LIST and related instructions.
*/
@@ -4416,19 +4888,19 @@ TEBCresume(
NEXT_INST_V(5, opnd, 1);
case INST_LIST_LENGTH:
- valuePtr = OBJ_AT_TOS;
- if (TclListObjLength(interp, valuePtr, &length) != TCL_OK) {
- TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
- Tcl_GetObjResult(interp));
+ TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
+ if (TclListObjLength(interp, OBJ_AT_TOS, &length) != TCL_OK) {
+ TRACE_ERROR(interp);
goto gotError;
}
TclNewIntObj(objResultPtr, length);
- TRACE(("%.20s => %d\n", O2S(valuePtr), length));
+ TRACE_APPEND(("%d\n", length));
NEXT_INST_F(1, 1, 1);
case INST_LIST_INDEX: /* lindex with objc == 3 */
value2Ptr = OBJ_AT_TOS;
valuePtr = OBJ_UNDER_TOS;
+ TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
/*
* Extract the desired list element.
@@ -4446,8 +4918,7 @@ TEBCresume(
objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
if (!objResultPtr) {
- TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ", O2S(valuePtr),
- O2S(value2Ptr)), Tcl_GetObjResult(interp));
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -4455,8 +4926,7 @@ TEBCresume(
* Stash the list element on the stack.
*/
- TRACE(("%.20s %.20s => %s\n",
- O2S(valuePtr), O2S(value2Ptr), O2S(objResultPtr)));
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, -1); /* Already has the correct refCount */
case INST_LIST_INDEX_IMM: /* lindex with objc==3 and index in bytecode
@@ -4468,6 +4938,7 @@ TEBCresume(
valuePtr = OBJ_AT_TOS;
opnd = TclGetInt4AtPtr(pc+1);
+ TRACE(("\%.30s\" %d => ", O2S(valuePtr), opnd));
/*
* Get the contents of the list, making sure that it really is a list
@@ -4475,8 +4946,7 @@ TEBCresume(
*/
if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
- TRACE_WITH_OBJ(("\"%.30s\" %d => ERROR: ", O2S(valuePtr), opnd),
- Tcl_GetObjResult(interp));
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -4499,8 +4969,7 @@ TEBCresume(
TclNewObj(objResultPtr);
}
- TRACE_WITH_OBJ(("\"%.30s\" %d => ", O2S(valuePtr), opnd),
- objResultPtr);
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_F(pcAdjustment, 1, 1);
case INST_LIST_INDEX_MULTI: /* 'lindex' with multiple index args */
@@ -4515,10 +4984,11 @@ TEBCresume(
* Do the 'lindex' operation.
*/
+ TRACE(("%d => ", opnd));
objResultPtr = TclLindexFlat(interp, OBJ_AT_DEPTH(numIndices),
numIndices, &OBJ_AT_DEPTH(numIndices - 1));
if (!objResultPtr) {
- TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -4526,7 +4996,7 @@ TEBCresume(
* Set result.
*/
- TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_V(5, opnd, -1);
case INST_LSET_FLAT:
@@ -4536,6 +5006,7 @@ TEBCresume(
opnd = TclGetUInt4AtPtr(pc + 1);
numIndices = opnd - 2;
+ TRACE(("%d => ", opnd));
/*
* Get the old value of variable, and remove the stack ref. This is
@@ -4554,7 +5025,7 @@ TEBCresume(
objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
&OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
if (!objResultPtr) {
- TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -4562,7 +5033,7 @@ TEBCresume(
* Set result.
*/
- TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_V(5, numIndices+1, -1);
case INST_LSET_LIST: /* 'lset' with 4 args */
@@ -4582,6 +5053,8 @@ TEBCresume(
valuePtr = OBJ_AT_TOS;
value2Ptr = OBJ_UNDER_TOS;
+ TRACE(("\"%.30s\" \"%.30s\" \"%.30s\" => ",
+ O2S(value2Ptr), O2S(valuePtr), O2S(objPtr)));
/*
* Compute the new variable value.
@@ -4589,8 +5062,7 @@ TEBCresume(
objResultPtr = TclLsetList(interp, objPtr, value2Ptr, valuePtr);
if (!objResultPtr) {
- TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(value2Ptr)),
- Tcl_GetObjResult(interp));
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -4598,7 +5070,7 @@ TEBCresume(
* Set result.
*/
- TRACE(("=> %s\n", O2S(objResultPtr)));
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, -1);
case INST_LIST_RANGE_IMM: /* lrange with objc==4 and both indices in
@@ -4611,6 +5083,8 @@ TEBCresume(
valuePtr = OBJ_AT_TOS;
fromIdx = TclGetInt4AtPtr(pc+1);
toIdx = TclGetInt4AtPtr(pc+5);
+ TRACE(("\"%.30s\" %d %d => ", O2S(valuePtr), TclGetInt4AtPtr(pc+1),
+ TclGetInt4AtPtr(pc+5)));
/*
* Get the contents of the list, making sure that it really is a list
@@ -4618,8 +5092,7 @@ TEBCresume(
*/
if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
- TRACE_WITH_OBJ(("\"%.30s\" %d %d => ERROR: ", O2S(valuePtr),
- fromIdx, toIdx), Tcl_GetObjResult(interp));
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -4676,9 +5149,7 @@ TEBCresume(
List *listPtr = valuePtr->internalRep.twoPtrValue.ptr1;
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;
@@ -4693,8 +5164,7 @@ TEBCresume(
TclNewObj(objResultPtr);
}
- TRACE_WITH_OBJ(("\"%.30s\" %d %d => ", O2S(valuePtr),
- TclGetInt4AtPtr(pc+1), TclGetInt4AtPtr(pc+5)), objResultPtr);
+ TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
NEXT_INST_F(9, 1, 1);
case INST_LIST_IN:
@@ -4703,9 +5173,9 @@ TEBCresume(
valuePtr = OBJ_UNDER_TOS;
s1 = TclGetStringFromObj(valuePtr, &s1len);
+ TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) {
- TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ERROR: ", O2S(valuePtr),
- O2S(value2Ptr)), Tcl_GetObjResult(interp));
+ TRACE_ERROR(interp);
goto gotError;
}
match = 0;
@@ -4736,7 +5206,7 @@ TEBCresume(
match = !match;
}
- TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));
+ TRACE_APPEND(("%d\n", match));
/*
* Peep-hole optimisation: if you're about to jump, do jump from here.
@@ -4744,21 +5214,30 @@ TEBCresume(
* for branching.
*/
- pc++;
-#ifndef TCL_COMPILE_DEBUG
- switch (*pc) {
- case INST_JUMP_FALSE1:
- NEXT_INST_F((match ? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE1:
- NEXT_INST_F((match ? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
- case INST_JUMP_FALSE4:
- NEXT_INST_F((match ? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE4:
- NEXT_INST_F((match ? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
+ JUMP_PEEPHOLE_F(match, 1, 2);
+
+ 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_ERROR(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_ERROR(interp);
+ goto gotError;
+ }
+ TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
+ NEXT_INST_F(1, 1, 0);
}
-#endif
- objResultPtr = TCONST(match);
- NEXT_INST_F(0, 2, 1);
/*
* End of INST_LIST and related instructions.
@@ -4888,25 +5367,74 @@ TEBCresume(
break;
}
}
- if (match < 0) {
- TclNewIntObj(objResultPtr, -1);
- } else {
- objResultPtr = TCONST(match > 0);
- }
- TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr),
- O2S(objResultPtr)));
- NEXT_INST_F(1, 2, 1);
+
+ TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr),
+ (match < 0 ? -1 : match > 0 ? 1 : 0)));
+ JUMP_PEEPHOLE_F(match, 1, 2);
case INST_STR_LEN:
valuePtr = OBJ_AT_TOS;
length = Tcl_GetCharLength(valuePtr);
TclNewIntObj(objResultPtr, length);
- TRACE(("%.20s => %d\n", O2S(valuePtr), length));
+ TRACE(("\"%.20s\" => %d\n", O2S(valuePtr), length));
NEXT_INST_F(1, 1, 1);
+ case INST_STR_UPPER:
+ valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.20s\" => ", 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(("\"%.20s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 1, 1);
+ } else {
+ length = Tcl_UtfToUpper(TclGetString(valuePtr));
+ Tcl_SetObjLength(valuePtr, length);
+ TclFreeIntRep(valuePtr);
+ TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
+ NEXT_INST_F(1, 0, 0);
+ }
+ case INST_STR_LOWER:
+ valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.20s\" => ", 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(("\"%.20s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 1, 1);
+ } else {
+ length = Tcl_UtfToLower(TclGetString(valuePtr));
+ Tcl_SetObjLength(valuePtr, length);
+ TclFreeIntRep(valuePtr);
+ TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
+ NEXT_INST_F(1, 0, 0);
+ }
+ case INST_STR_TITLE:
+ valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.20s\" => ", 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(("\"%.20s\"\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 1, 1);
+ } else {
+ length = Tcl_UtfToTitle(TclGetString(valuePtr));
+ Tcl_SetObjLength(valuePtr, length);
+ TclFreeIntRep(valuePtr);
+ TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
+ NEXT_INST_F(1, 0, 0);
+ }
+
case INST_STR_INDEX:
value2Ptr = OBJ_AT_TOS;
valuePtr = OBJ_UNDER_TOS;
+ TRACE(("\"%.20s\" %.20s => ", O2S(valuePtr), O2S(value2Ptr)));
/*
* Get char length to calulate what 'end' means.
@@ -4914,6 +5442,7 @@ TEBCresume(
length = Tcl_GetCharLength(valuePtr);
if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -4939,18 +5468,18 @@ TEBCresume(
objResultPtr = Tcl_NewStringObj(buf, length);
}
- TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr),
- O2S(objResultPtr)));
+ TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
case INST_STR_RANGE:
- TRACE(("\"%.20s\" %s %s =>",
+ TRACE(("\"%.20s\" %.20s %.20s =>",
O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
length = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1;
if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length,
&fromIdx) != TCL_OK
|| TclGetIntForIndexM(interp, OBJ_AT_TOS, length,
&toIdx) != TCL_OK) {
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -5010,33 +5539,216 @@ 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);
+ TRACE_ERROR(interp);
+ 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 {
+ /*
+ * Be careful with splicing the stack in this case; we have a
+ * refCount:1 object in value3Ptr and we want to append to it and
+ * make it be the refCount:1 object at the top of the stack
+ * afterwards. [Bug 82e7f67325]
+ */
+
+ if (toIdx < length) {
+ Tcl_AppendUnicodeToObj(value3Ptr, ustring1 + toIdx + 1,
+ length - toIdx);
+ }
+ TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
+ TclDecrRefCount(valuePtr);
+ OBJ_AT_TOS = value3Ptr; /* Tricky! */
+ NEXT_INST_F(1, 0, 0);
+ }
+ 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. */
value2Ptr = OBJ_AT_DEPTH(2); /* "Source" string. */
if (value3Ptr == value2Ptr) {
objResultPtr = valuePtr;
- NEXT_INST_V(1, 3, 1);
+ goto doneStringMap;
} else if (valuePtr == value2Ptr) {
objResultPtr = value3Ptr;
- NEXT_INST_V(1, 3, 1);
+ goto doneStringMap;
}
ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
if (length == 0) {
objResultPtr = valuePtr;
- NEXT_INST_V(1, 3, 1);
+ goto doneStringMap;
}
ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
if (length2 > length || length2 == 0) {
objResultPtr = valuePtr;
- NEXT_INST_V(1, 3, 1);
+ goto doneStringMap;
} else if (length2 == length) {
if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length)) {
objResultPtr = valuePtr;
} else {
objResultPtr = value3Ptr;
}
- NEXT_INST_V(1, 3, 1);
+ goto doneStringMap;
}
ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3);
@@ -5065,6 +5777,7 @@ TEBCresume(
Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p);
}
+ doneStringMap:
TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr);
NEXT_INST_V(1, 3, 1);
@@ -5087,7 +5800,6 @@ TEBCresume(
TRACE(("%.20s %.20s => %d\n",
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
-
TclNewIntObj(objResultPtr, match);
NEXT_INST_F(1, 2, 1);
@@ -5111,6 +5823,25 @@ TEBCresume(
TclNewIntObj(objResultPtr, match);
NEXT_INST_F(1, 2, 1);
+
+ case INST_STR_CLASS:
+ opnd = TclGetInt1AtPtr(pc+1);
+ valuePtr = OBJ_AT_TOS;
+ TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name,
+ O2S(valuePtr)));
+ ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
+ match = 1;
+ if (length > 0) {
+ end = ustring1 + length;
+ for (p=ustring1 ; p<end ; p++) {
+ if (!tclStringClassTable[opnd].comparator(*p)) {
+ match = 0;
+ break;
+ }
+ }
+ }
+ TRACE_APPEND(("%d\n", match));
+ JUMP_PEEPHOLE_F(match, 2, 1);
}
case INST_STR_MATCH:
@@ -5153,26 +5884,77 @@ TEBCresume(
* Peep-hole optimisation: if you're about to jump, do jump from here.
*/
- pc += 2;
-#ifndef TCL_COMPILE_DEBUG
- switch (*pc) {
- case INST_JUMP_FALSE1:
- NEXT_INST_F((match? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE1:
- NEXT_INST_F((match? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
- case INST_JUMP_FALSE4:
- NEXT_INST_F((match? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE4:
- NEXT_INST_F((match? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
+ JUMP_PEEPHOLE_F(match, 2, 2);
+
+ {
+ const char *string1, *string2;
+ int trim1, trim2;
+
+ 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);
+ trim2 = 0;
+ goto createTrimmedString;
+ 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);
+ trim1 = 0;
+ goto createTrimmedString;
+ 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;
+ }
+ createTrimmedString:
+ /*
+ * Careful here; trim set often contains non-ASCII characters so we
+ * take care when printing. [Bug 971cb4f1db]
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+ if (traceInstructions) {
+ TRACE(("\"%.30s\" ", O2S(valuePtr)));
+ TclPrintObject(stdout, value2Ptr, 30);
+ printf(" => ");
}
#endif
- objResultPtr = TCONST(match);
- NEXT_INST_F(0, 2, 1);
+ if (trim1 == 0 && trim2 == 0) {
+#ifdef TCL_COMPILE_DEBUG
+ if (traceInstructions) {
+ TclPrintObject(stdout, valuePtr, 30);
+ printf("\n");
+ }
+#endif
+ NEXT_INST_F(1, 1, 0);
+ } else {
+ objResultPtr = Tcl_NewStringObj(string1+trim1, length-trim1-trim2);
+#ifdef TCL_COMPILE_DEBUG
+ if (traceInstructions) {
+ TclPrintObject(stdout, objResultPtr, 30);
+ printf("\n");
+ }
+#endif
+ NEXT_INST_F(1, 2, 1);
+ }
+ }
case INST_REGEXP:
cflags = TclGetInt1AtPtr(pc+1); /* RE compile flages like NOCASE */
valuePtr = OBJ_AT_TOS; /* String */
value2Ptr = OBJ_UNDER_TOS; /* Pattern */
+ TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
/*
* Compile and match the regular expression.
@@ -5183,44 +5965,24 @@ TEBCresume(
Tcl_GetRegExpFromObj(interp, value2Ptr, cflags);
if (regExpr == NULL) {
- goto regexpFailure;
+ TRACE_ERROR(interp);
+ goto gotError;
}
-
match = Tcl_RegExpExecObj(interp, regExpr, valuePtr, 0, 0, 0);
-
if (match < 0) {
- regexpFailure:
-#ifdef TCL_COMPILE_DEBUG
- objResultPtr = Tcl_GetObjResult(interp);
- TRACE_WITH_OBJ(("%.20s %.20s => ERROR: ",
- O2S(valuePtr), O2S(value2Ptr)), objResultPtr);
-#endif
+ TRACE_ERROR(interp);
goto gotError;
}
}
- TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));
+ TRACE_APPEND(("%d\n", match));
/*
* Peep-hole optimisation: if you're about to jump, do jump from here.
* Adjustment is 2 due to the nocase byte.
*/
- pc += 2;
-#ifndef TCL_COMPILE_DEBUG
- switch (*pc) {
- case INST_JUMP_FALSE1:
- NEXT_INST_F((match? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE1:
- NEXT_INST_F((match? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
- case INST_JUMP_FALSE4:
- NEXT_INST_F((match? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE4:
- NEXT_INST_F((match? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
- }
-#endif
- objResultPtr = TCONST(match);
- NEXT_INST_F(0, 2, 1);
+ JUMP_PEEPHOLE_F(match, 2, 2);
}
/*
@@ -5234,6 +5996,39 @@ TEBCresume(
int type1, type2;
long l1, l2, lResult;
+ case INST_NUM_TYPE:
+ if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
+ type1 = 0;
+ } else if (type1 == TCL_NUMBER_LONG) {
+ /* value is between LONG_MIN and LONG_MAX */
+ /* [string is integer] is -UINT_MAX to UINT_MAX range */
+ int i;
+
+ if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) != TCL_OK) {
+ type1 = TCL_NUMBER_WIDE;
+ }
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (type1 == TCL_NUMBER_WIDE) {
+ /* value is between WIDE_MIN and WIDE_MAX */
+ /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
+ int i;
+ if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) {
+ type1 = TCL_NUMBER_LONG;
+ }
+#endif
+ } else if (type1 == TCL_NUMBER_BIG) {
+ /* value is an integer outside the WIDE_MIN to WIDE_MAX range */
+ /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
+ Tcl_WideInt w;
+
+ if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
+ type1 = TCL_NUMBER_WIDE;
+ }
+ }
+ TclNewIntObj(objResultPtr, type1);
+ TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
+ NEXT_INST_F(1, 1, 1);
+
case INST_EQ:
case INST_NEQ:
case INST_LT:
@@ -5318,21 +6113,9 @@ TEBCresume(
*/
foundResult:
- pc++;
-#ifndef TCL_COMPILE_DEBUG
- switch (*pc) {
- case INST_JUMP_FALSE1:
- NEXT_INST_F((iResult? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE1:
- NEXT_INST_F((iResult? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
- case INST_JUMP_FALSE4:
- NEXT_INST_F((iResult? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE4:
- NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
- }
-#endif
- objResultPtr = TCONST(iResult);
- NEXT_INST_F(0, 2, 1);
+ TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr),
+ iResult));
+ JUMP_PEEPHOLE_F(iResult, 1, 2);
}
case INST_MOD:
@@ -5419,13 +6202,13 @@ TEBCresume(
if (l2 < 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"negative shift argument", -1));
-#if 0
+#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"domain error: argument not in valid range",
NULL);
CACHE_STACK_INFO();
-#endif
+#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
} else if (l1 == 0) {
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
@@ -5467,13 +6250,13 @@ TEBCresume(
if (l2 < 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"negative shift argument", -1));
-#if 0
+#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"domain error: argument not in valid range",
NULL);
CACHE_STACK_INFO();
-#endif
+#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
} else if (l1 == 0) {
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
@@ -5490,12 +6273,12 @@ TEBCresume(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"integer value too large to represent", -1));
-#if 0
+#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
"integer value too large to represent", NULL);
CACHE_STACK_INFO();
-#endif
+#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
} else {
int shift = (int) l2;
@@ -5553,8 +6336,7 @@ TEBCresume(
TRACE_APPEND(("DIVIDE BY ZERO\n"));
goto divideByZero;
} else if (objResultPtr == GENERAL_ARITHMETIC_ERROR) {
- TRACE_APPEND(("ERROR: %s\n",
- TclGetString(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
} else if (objResultPtr == NULL) {
TRACE_APPEND(("%s\n", O2S(valuePtr)));
@@ -5631,7 +6413,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.
*/
@@ -5646,7 +6428,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
@@ -5726,8 +6508,7 @@ TEBCresume(
TRACE_APPEND(("EXPONENT OF ZERO\n"));
goto exponOfZero;
} else if (objResultPtr == GENERAL_ARITHMETIC_ERROR) {
- TRACE_APPEND(("ERROR: %s\n",
- TclGetString(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
} else if (objResultPtr == NULL) {
TRACE_APPEND(("%s\n", O2S(valuePtr)));
@@ -5745,7 +6526,7 @@ TEBCresume(
/* TODO - check claim that taking address of b harms performance */
/* TODO - consider optimization search for constants */
if (TclGetBooleanFromObj(NULL, valuePtr, &b) != TCL_OK) {
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", O2S(valuePtr),
+ TRACE(("\"%.20s\" => ERROR: illegal type %s\n", O2S(valuePtr),
(valuePtr->typePtr? valuePtr->typePtr->name : "null")));
DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
@@ -5754,18 +6535,20 @@ TEBCresume(
}
/* TODO: Consider peephole opt. */
objResultPtr = TCONST(!b);
+ TRACE_WITH_OBJ(("%s => ", O2S(valuePtr)), objResultPtr);
NEXT_INST_F(1, 1, 1);
}
case INST_BITNOT:
valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.20s\" => ", O2S(valuePtr)));
if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
|| (type1==TCL_NUMBER_NAN) || (type1==TCL_NUMBER_DOUBLE)) {
/*
* ... ~$NonInteger => raise an error.
*/
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+ TRACE_APPEND(("ERROR: illegal type %s\n",
(valuePtr->typePtr? valuePtr->typePtr->name : "null")));
DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
@@ -5776,23 +6559,28 @@ TEBCresume(
l1 = *((const long *) ptr1);
if (Tcl_IsShared(valuePtr)) {
TclNewLongObj(objResultPtr, ~l1);
+ TRACE_APPEND(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
}
TclSetLongObj(valuePtr, ~l1);
+ TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
if (objResultPtr != NULL) {
+ TRACE_APPEND(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
} else {
+ TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
case INST_UMINUS:
valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.20s\" => ", O2S(valuePtr)));
if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
|| IsErroringNaNType(type1)) {
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+ TRACE_APPEND(("ERROR: illegal type %s \n",
(valuePtr->typePtr? valuePtr->typePtr->name : "null")));
DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
@@ -5802,23 +6590,28 @@ TEBCresume(
switch (type1) {
case TCL_NUMBER_NAN:
/* -NaN => NaN */
+ TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
case TCL_NUMBER_LONG:
l1 = *((const long *) ptr1);
if (l1 != LONG_MIN) {
if (Tcl_IsShared(valuePtr)) {
TclNewLongObj(objResultPtr, -l1);
+ TRACE_APPEND(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
}
TclSetLongObj(valuePtr, -l1);
+ TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
/* FALLTHROUGH */
}
objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
if (objResultPtr != NULL) {
+ TRACE_APPEND(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
} else {
+ TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
@@ -5831,6 +6624,7 @@ TEBCresume(
*/
valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.20s\" => ", O2S(valuePtr)));
if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
if (*pc == INST_UPLUS) {
@@ -5838,7 +6632,7 @@ TEBCresume(
* ... +$NonNumeric => raise an error.
*/
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+ TRACE_APPEND(("ERROR: illegal type %s\n",
(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
@@ -5847,7 +6641,7 @@ TEBCresume(
}
/* ... TryConvertToNumeric($NonNumeric) is acceptable */
- TRACE(("\"%.20s\" => not numeric\n", O2S(valuePtr)));
+ TRACE_APPEND(("not numeric\n"));
NEXT_INST_F(1, 0, 0);
}
if (IsErroringNaNType(type1)) {
@@ -5856,7 +6650,7 @@ TEBCresume(
* ... +$NonNumeric => raise an error.
*/
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+ TRACE_APPEND(("ERROR: illegal type %s\n",
(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
@@ -5866,8 +6660,7 @@ TEBCresume(
* Numeric conversion of NaN -> error.
*/
- TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
- O2S(objResultPtr)));
+ TRACE_APPEND(("ERROR: IEEE floating pt error\n"));
DECACHE_STACK_INFO();
TclExprFloatError(interp, *((const double *) ptr1));
CACHE_STACK_INFO();
@@ -5885,7 +6678,7 @@ TEBCresume(
*/
if (valuePtr->bytes == NULL) {
- TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr)));
+ TRACE_APPEND(("numeric, same Tcl_Obj\n"));
NEXT_INST_F(1, 0, 0);
}
if (Tcl_IsShared(valuePtr)) {
@@ -5900,11 +6693,11 @@ TEBCresume(
valuePtr->bytes = NULL;
objResultPtr = Tcl_DuplicateObj(valuePtr);
valuePtr->bytes = savedString;
- TRACE(("\"%.20s\" => numeric, new Tcl_Obj\n", O2S(valuePtr)));
+ TRACE_APPEND(("numeric, new Tcl_Obj\n"));
NEXT_INST_F(1, 1, 1);
}
TclInvalidateStringRep(valuePtr);
- TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr)));
+ TRACE_APPEND(("numeric, same Tcl_Obj\n"));
NEXT_INST_F(1, 0, 0);
}
@@ -5913,6 +6706,17 @@ TEBCresume(
* -----------------------------------------------------------------
*/
+ case INST_TRY_CVT_TO_BOOLEAN:
+ valuePtr = OBJ_AT_TOS;
+ if (valuePtr->typePtr == &tclBooleanType) {
+ objResultPtr = TCONST(1);
+ } else {
+ int result = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
+ objResultPtr = TCONST(result);
+ }
+ TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr);
+ NEXT_INST_F(1, 0, 1);
+
case INST_BREAK:
/*
DECACHE_STACK_INFO();
@@ -5921,6 +6725,7 @@ TEBCresume(
*/
result = TCL_BREAK;
cleanup = 0;
+ TRACE(("=> BREAK!\n"));
goto processExceptionReturn;
case INST_CONTINUE:
@@ -5931,6 +6736,7 @@ TEBCresume(
*/
result = TCL_CONTINUE;
cleanup = 0;
+ TRACE(("=> CONTINUE!\n"));
goto processExceptionReturn;
{
@@ -5942,7 +6748,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.
@@ -5975,13 +6781,14 @@ 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.
*/
opnd = TclGetUInt4AtPtr(pc+1);
+ TRACE(("%u => ", opnd));
infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
numLists = infoPtr->numLists;
@@ -6008,8 +6815,8 @@ TEBCresume(
listVarPtr = LOCAL(listTmpIndex);
listPtr = listVarPtr->value.objPtr;
if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
- TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ",
- opnd, i, O2S(listPtr)), Tcl_GetObjResult(interp));
+ TRACE_APPEND(("ERROR converting list %ld, \"%.30s\": %s\n",
+ i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
goto gotError;
}
if (listLen > iterNum * numVars) {
@@ -6064,9 +6871,9 @@ TEBCresume(
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));
+ TRACE_APPEND((
+ "ERROR init. index temp %d: %s\n",
+ varIndex, O2S(Tcl_GetObjResult(interp))));
TclDecrRefCount(listPtr);
goto gotError;
}
@@ -6078,8 +6885,8 @@ TEBCresume(
listTmpIndex++;
}
}
- TRACE(("%u => %d lists, iter %d, %s loop\n", opnd, numLists,
- iterNum, (continueLoop? "continue" : "exit")));
+ TRACE_APPEND(("%d lists, iter %d, %s loop\n",
+ numLists, iterNum, (continueLoop? "continue" : "exit")));
/*
* Run-time peep-hole optimisation: the compiler ALWAYS follows
@@ -6093,6 +6900,200 @@ 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;
+ TRACE(("%u => ", opnd));
+
+ /*
+ * 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_APPEND(("ERROR converting list %ld, \"%s\": %s",
+ i, O2S(listPtr), O2S(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 */
+ TRACE_APPEND(("jump to loop step\n"));
+
+ /*
+ * 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;
+ TRACE(("=> "));
+
+ 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_APPEND(("ERROR init. index temp %d: %.30s",
+ varIndex, O2S(Tcl_GetObjResult(interp))));
+ goto gotError;
+ }
+ CACHE_STACK_INFO();
+ }
+ valIndex++;
+ }
+ listTmpDepth--;
+ }
+ TRACE_APPEND(("jump to loop start\n"));
+ /* loopCtTemp being 'misused' for storing the jump size */
+ NEXT_INST_F(infoPtr->loopCtTemp, 0, 0);
+ }
+
+ TRACE_APPEND(("loop has no more iterations\n"));
+#ifdef TCL_COMPILE_DEBUG
+ NEXT_INST_F(1, 0, 0);
+#else
+ /*
+ * FALL THROUGH
+ */
+ pc++;
+#endif
+
+ case INST_FOREACH_END:
+ /* THIS INSTRUCTION IS ONLY CALLED AS A BREAK TARGET */
+ tmpPtr = OBJ_AT_TOS;
+ infoPtr = tmpPtr->internalRep.otherValuePtr;
+ numLists = infoPtr->numLists;
+ TRACE(("=> loop terminated\n"));
+ 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;
+ TRACE_APPEND(("=> appending to list at depth %d\n", 3 + numLists));
+
+ objPtr = OBJ_AT_DEPTH(3 + numLists);
+ Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS);
+ NEXT_INST_F(1, 1, 0);
}
case INST_BEGIN_CATCH4:
@@ -6154,7 +7155,8 @@ TEBCresume(
if (code < TCL_ERROR || code > TCL_CONTINUE) {
code = TCL_CONTINUE + 1;
}
- NEXT_INST_F(2*code -1, 1, 0);
+ TRACE(("\"%s\" => jump offset %d\n", O2S(OBJ_AT_TOS), 2*code-1));
+ NEXT_INST_F(2*code-1, 1, 0);
}
/*
@@ -6171,10 +7173,10 @@ TEBCresume(
case INST_DICT_VERIFY:
dictPtr = OBJ_AT_TOS;
- TRACE(("=> "));
+ TRACE(("\"%.30s\" => ", O2S(dictPtr)));
if (Tcl_DictObjSize(interp, dictPtr, &done) != TCL_OK) {
- TRACE_APPEND(("ERROR verifying dictionary nature of \"%s\": %s\n",
- O2S(OBJ_AT_DEPTH(opnd)), O2S(Tcl_GetObjResult(interp))));
+ TRACE_APPEND(("ERROR verifying dictionary nature of \"%.30s\": %s\n",
+ O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
goto gotError;
}
TRACE_APPEND(("OK\n"));
@@ -6183,6 +7185,7 @@ TEBCresume(
case INST_DICT_GET:
case INST_DICT_EXISTS: {
register Tcl_Interp *interp2 = interp;
+ register int found;
opnd = TclGetUInt4AtPtr(pc+1);
TRACE(("%u => ", opnd));
@@ -6195,10 +7198,11 @@ TEBCresume(
&OBJ_AT_DEPTH(opnd-1), DICT_PATH_READ);
if (dictPtr == NULL) {
if (*pc == INST_DICT_EXISTS) {
- goto dictNotExists;
+ found = 0;
+ goto afterDictExists;
}
TRACE_WITH_OBJ((
- "ERROR tracing dictionary path into \"%s\": ",
+ "ERROR tracing dictionary path into \"%.30s\": ",
O2S(OBJ_AT_DEPTH(opnd))),
Tcl_GetObjResult(interp));
goto gotError;
@@ -6207,34 +7211,40 @@ TEBCresume(
if (Tcl_DictObjGet(interp2, dictPtr, OBJ_AT_TOS,
&objResultPtr) == TCL_OK) {
if (*pc == INST_DICT_EXISTS) {
- objResultPtr = TCONST(objResultPtr ? 1 : 0);
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_V(5, opnd+1, 1);
+ found = (objResultPtr ? 1 : 0);
+ goto afterDictExists;
}
- if (objResultPtr) {
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_V(5, opnd+1, 1);
+ if (!objResultPtr) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "key \"%s\" not known in dictionary",
+ TclGetString(OBJ_AT_TOS)));
+ DECACHE_STACK_INFO();
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
+ TclGetString(OBJ_AT_TOS), NULL);
+ CACHE_STACK_INFO();
+ TRACE_ERROR(interp);
+ goto gotError;
}
- DECACHE_STACK_INFO();
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "key \"%s\" not known in dictionary",
- TclGetString(OBJ_AT_TOS)));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
- TclGetString(OBJ_AT_TOS), NULL);
- CACHE_STACK_INFO();
- TRACE_WITH_OBJ(("%u => ERROR ", opnd), Tcl_GetObjResult(interp));
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_V(5, opnd+1, 1);
+ } else if (*pc != INST_DICT_EXISTS) {
+ TRACE_APPEND(("ERROR reading leaf dictionary key \"%.30s\": %s",
+ O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
+ goto gotError;
} else {
- if (*pc == INST_DICT_EXISTS) {
- dictNotExists:
- objResultPtr = TCONST(0);
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_V(5, opnd+1, 1);
- }
- TRACE_WITH_OBJ((
- "%u => ERROR reading leaf dictionary key \"%s\": ",
- opnd, O2S(dictPtr)), Tcl_GetObjResult(interp));
+ found = 0;
}
- goto gotError;
+ afterDictExists:
+ TRACE_APPEND(("%d\n", found));
+
+ /*
+ * The INST_DICT_EXISTS instruction is usually followed by a
+ * conditional jump, so we can take advantage of this to do some
+ * peephole optimization (note that we're careful to not close out
+ * someone doing something else).
+ */
+
+ JUMP_PEEPHOLE_V(found, 5, opnd+1);
}
case INST_DICT_SET:
@@ -6308,8 +7318,8 @@ TEBCresume(
if (allocateDict) {
TclDecrRefCount(dictPtr);
}
- TRACE_WITH_OBJ(("%u %u => ERROR updating dictionary: ",
- opnd, opnd2), Tcl_GetObjResult(interp));
+ TRACE_APPEND(("ERROR updating dictionary: %s\n",
+ O2S(Tcl_GetObjResult(interp))));
goto checkForCatch;
}
@@ -6331,8 +7341,7 @@ TEBCresume(
CACHE_STACK_INFO();
TclDecrRefCount(dictPtr);
if (objResultPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n",
- O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
}
@@ -6341,7 +7350,7 @@ TEBCresume(
NEXT_INST_V(10, cleanup, 0);
}
#endif
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_V(9, cleanup, 1);
case INST_DICT_APPEND:
@@ -6374,6 +7383,7 @@ TEBCresume(
if (allocateDict) {
TclDecrRefCount(dictPtr);
}
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -6422,6 +7432,7 @@ TEBCresume(
if (allocateDict) {
TclDecrRefCount(dictPtr);
}
+ TRACE_ERROR(interp);
goto gotError;
}
Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, valuePtr);
@@ -6431,6 +7442,7 @@ TEBCresume(
if (allocateDict) {
TclDecrRefCount(dictPtr);
}
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -6467,8 +7479,7 @@ TEBCresume(
CACHE_STACK_INFO();
TclDecrRefCount(dictPtr);
if (objResultPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n",
- O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
}
@@ -6488,6 +7499,7 @@ TEBCresume(
if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr,
&valuePtr, &done) != TCL_OK) {
ckfree(searchPtr);
+ TRACE_ERROR(interp);
goto gotError;
}
TclNewObj(statePtr);
@@ -6523,8 +7535,9 @@ TEBCresume(
PUSH_OBJECT(valuePtr);
PUSH_OBJECT(keyPtr);
}
+ TRACE_APPEND(("\"%.30s\" \"%.30s\" %d\n",
+ O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done));
-#ifndef TCL_COMPILE_DEBUG
/*
* The INST_DICT_FIRST and INST_DICT_NEXT instructsions are always
* followed by a conditional jump, so we can take advantage of this to
@@ -6532,37 +7545,17 @@ TEBCresume(
* out someone doing something else).
*/
- pc += 5;
- switch (*pc) {
- case INST_JUMP_FALSE1:
- NEXT_INST_F((done ? 2 : TclGetInt1AtPtr(pc+1)), 0, 0);
- case INST_JUMP_FALSE4:
- NEXT_INST_F((done ? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
- case INST_JUMP_TRUE1:
- NEXT_INST_F((done ? TclGetInt1AtPtr(pc+1) : 2), 0, 0);
- case INST_JUMP_TRUE4:
- NEXT_INST_F((done ? TclGetInt4AtPtr(pc+1) : 5), 0, 0);
- default:
- pc -= 5;
- /* fall through to non-debug handling */
- }
-#endif
-
- TRACE_APPEND(("\"%.30s\" \"%.30s\" %d",
- O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done));
- objResultPtr = TCONST(done);
- /* TODO: consider opt like INST_FOREACH_STEP4 */
- NEXT_INST_F(5, 0, 1);
+ JUMP_PEEPHOLE_F(done, 5, 0);
case INST_DICT_UPDATE_START:
opnd = TclGetUInt4AtPtr(pc+1);
opnd2 = TclGetUInt4AtPtr(pc+5);
+ TRACE(("%u => ", opnd));
varPtr = LOCAL(opnd);
duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData;
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
- TRACE(("%u => ", opnd));
if (TclIsVarDirectReadable(varPtr)) {
dictPtr = varPtr->value.objPtr;
} else {
@@ -6571,11 +7564,13 @@ TEBCresume(
TCL_LEAVE_ERR_MSG, opnd);
CACHE_STACK_INFO();
if (dictPtr == NULL) {
+ TRACE_ERROR(interp);
goto gotError;
}
}
if (TclListObjGetElements(interp, OBJ_AT_TOS, &length,
&keyPtrPtr) != TCL_OK) {
+ TRACE_ERROR(interp);
goto gotError;
}
if (length != duiPtr->length) {
@@ -6584,6 +7579,7 @@ TEBCresume(
for (i=0 ; i<length ; i++) {
if (Tcl_DictObjGet(interp, dictPtr, keyPtrPtr[i],
&valuePtr) != TCL_OK) {
+ TRACE_ERROR(interp);
goto gotError;
}
varPtr = LOCAL(duiPtr->varIndices[i]);
@@ -6599,21 +7595,23 @@ TEBCresume(
valuePtr, TCL_LEAVE_ERR_MSG,
duiPtr->varIndices[i]) == NULL) {
CACHE_STACK_INFO();
+ TRACE_ERROR(interp);
goto gotError;
}
CACHE_STACK_INFO();
}
+ TRACE_APPEND(("OK\n"));
NEXT_INST_F(9, 0, 0);
case INST_DICT_UPDATE_END:
opnd = TclGetUInt4AtPtr(pc+1);
opnd2 = TclGetUInt4AtPtr(pc+5);
+ TRACE(("%u => ", opnd));
varPtr = LOCAL(opnd);
duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData;
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
- TRACE(("%u => ", opnd));
if (TclIsVarDirectReadable(varPtr)) {
dictPtr = varPtr->value.objPtr;
} else {
@@ -6622,11 +7620,13 @@ TEBCresume(
CACHE_STACK_INFO();
}
if (dictPtr == NULL) {
+ TRACE_APPEND(("storage was unset\n"));
NEXT_INST_F(9, 1, 0);
}
if (Tcl_DictObjSize(interp, dictPtr, &length) != TCL_OK
|| TclListObjGetElements(interp, OBJ_AT_TOS, &length,
&keyPtrPtr) != TCL_OK) {
+ TRACE_ERROR(interp);
goto gotError;
}
allocdict = Tcl_IsShared(dictPtr);
@@ -6672,26 +7672,27 @@ TEBCresume(
if (allocdict) {
TclDecrRefCount(dictPtr);
}
+ TRACE_ERROR(interp);
goto gotError;
}
}
+ TRACE_APPEND(("written back\n"));
NEXT_INST_F(9, 1, 0);
case INST_DICT_EXPAND:
dictPtr = OBJ_UNDER_TOS;
listPtr = OBJ_AT_TOS;
+ TRACE(("\"%.30s\" \"%.30s\" =>", O2S(dictPtr), O2S(listPtr)));
if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
- TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ",
- O2S(dictPtr), O2S(listPtr)), Tcl_GetObjResult(interp));
+ TRACE_ERROR(interp);
goto gotError;
}
objResultPtr = TclDictWithInit(interp, dictPtr, objc, objv);
if (objResultPtr == NULL) {
- TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ",
- O2S(dictPtr), O2S(listPtr)), Tcl_GetObjResult(interp));
+ TRACE_ERROR(interp);
goto gotError;
}
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
case INST_DICT_RECOMBINE_STK:
@@ -6701,14 +7702,14 @@ TEBCresume(
TRACE(("\"%.30s\" \"%.30s\" \"%.30s\" => ",
O2S(varNamePtr), O2S(valuePtr), O2S(keysPtr)));
if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
TclDecrRefCount(keysPtr);
goto gotError;
}
varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL,
TCL_LEAVE_ERR_MSG, "set", 1, 1, &arrayPtr);
if (varPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
TclDecrRefCount(keysPtr);
goto gotError;
}
@@ -6718,7 +7719,7 @@ TEBCresume(
CACHE_STACK_INFO();
TclDecrRefCount(keysPtr);
if (result != TCL_OK) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
TRACE_APPEND(("OK\n"));
@@ -6732,7 +7733,7 @@ TEBCresume(
TRACE(("%u <- \"%.30s\" \"%.30s\" => ", opnd, O2S(valuePtr),
O2S(keysPtr)));
if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
while (TclIsVarLink(varPtr)) {
@@ -6743,7 +7744,7 @@ TEBCresume(
objc, objv, keysPtr);
CACHE_STACK_INFO();
if (result != TCL_OK) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
TRACE_APPEND(("OK\n"));
@@ -6778,7 +7779,7 @@ TEBCresume(
*/
processExceptionReturn:
-#if TCL_COMPILE_DEBUG
+#ifdef TCL_COMPILE_DEBUG
switch (*pc) {
case INST_INVOKE_STK1:
opnd = TclGetUInt1AtPtr(pc+1);
@@ -6835,14 +7836,14 @@ 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)) {
- TRACE_APPEND(("OTHER RETURN CODE %d, result= \"%s\"\n ",
+ TRACE_APPEND(("OTHER RETURN CODE %d, result=\"%.30s\"\n ",
result, O2S(objPtr)));
} else {
- TRACE_APPEND(("%s, result= \"%s\"\n",
+ TRACE_APPEND(("%s, result=\"%.30s\"\n",
StringForResultCode(result), O2S(objPtr)));
}
}
@@ -6855,8 +7856,8 @@ TEBCresume(
*/
divideByZero:
- DECACHE_STACK_INFO();
Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1));
+ DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);
CACHE_STACK_INFO();
goto gotError;
@@ -6867,9 +7868,9 @@ TEBCresume(
*/
exponOfZero:
- DECACHE_STACK_INFO();
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"exponentiation of zero by negative power", -1));
+ DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"exponentiation of zero by negative power", NULL);
CACHE_STACK_INFO();
@@ -6897,7 +7898,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);
@@ -7079,12 +8080,11 @@ TEBCresume(
}
codePtr->flags |= TCL_BYTECODE_RECOMPILE;
- bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL);
+ bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL, NULL);
opnd = TclGetUInt4AtPtr(pc+1);
pc += (opnd-1);
PUSH_OBJECT(Tcl_NewStringObj(bytes, length));
goto instEvalStk;
- NEXT_INST_F(9, 0, 0);
}
}
@@ -7096,6 +8096,58 @@ TEBCresume(
#undef auxObjList
#undef catchTop
#undef TCONST
+
+static int
+FinalizeOONext(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ CallContext *contextPtr = data[1];
+
+ /*
+ * Reset the variable lookup frame.
+ */
+
+ iPtr->varFramePtr = data[0];
+
+ /*
+ * Restore the call chain context index as we've finished the inner invoke
+ * and want to operate in the outer context again.
+ */
+
+ contextPtr->index = PTR2INT(data[2]);
+ contextPtr->skip = PTR2INT(data[3]);
+ contextPtr->oPtr->flags &= ~FILTER_HANDLING;
+ return result;
+}
+
+static int
+FinalizeOONextFilter(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ CallContext *contextPtr = data[1];
+
+ /*
+ * Reset the variable lookup frame.
+ */
+
+ iPtr->varFramePtr = data[0];
+
+ /*
+ * Restore the call chain context index as we've finished the inner invoke
+ * and want to operate in the outer context again.
+ */
+
+ contextPtr->index = PTR2INT(data[2]);
+ contextPtr->skip = PTR2INT(data[3]);
+ contextPtr->oPtr->flags |= FILTER_HANDLING;
+ return result;
+}
/*
*----------------------------------------------------------------------
@@ -7192,7 +8244,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) {
@@ -7267,7 +8319,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;
@@ -7351,7 +8403,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;
@@ -7372,7 +8424,7 @@ ExecuteExtendedBinaryMathOp(
}
shift = (int)(*(const long *)ptr2);
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
/*
* Handle shifts within the native wide range.
*/
@@ -7555,7 +8607,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);
@@ -7633,7 +8685,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);
@@ -7825,7 +8877,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
@@ -8028,7 +9080,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
{
@@ -8044,7 +9096,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
{
@@ -8170,7 +9222,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);
@@ -8192,7 +9244,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) {
@@ -8244,7 +9296,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
@@ -8259,7 +9311,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;
@@ -8311,7 +9363,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) {
@@ -8372,7 +9424,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;
@@ -8416,7 +9468,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:
@@ -8573,7 +9625,7 @@ ValidatePcAndStackTop(
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 0, max %i)",
stackTop, relativePc, stackUpperBound);
@@ -8623,10 +9675,12 @@ IllegalExprOperandType(
ClientData ptr;
int type;
const unsigned char opcode = *pc;
- const char *description, *operator = operatorStrings[opcode - INST_LOR];
+ const char *description, *operator = "unknown";
if (opcode == INST_EXPON) {
operator = "**";
+ } else if (opcode <= INST_STR_NEQ) {
+ operator = operatorStrings[opcode - INST_LOR];
}
if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {
@@ -8657,7 +9711,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
@@ -8678,16 +9732,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
@@ -8696,13 +9760,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.
@@ -8719,7 +9786,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++) {
@@ -8759,9 +9826,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;
@@ -8771,6 +9841,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;
@@ -8838,6 +9909,7 @@ GetSrcInfoForPc(
bestDist = dist;
bestSrcOffset = srcOffset;
bestSrcLength = srcLen;
+ bestCmdIdx = i;
}
}
}
@@ -8867,6 +9939,10 @@ GetSrcInfoForPc(
*lengthPtr = bestSrcLength;
}
+ if (cmdIdxPtr != NULL) {
+ *cmdIdxPtr = bestCmdIdx;
+ }
+
return (codePtr->source + bestSrcOffset);
}
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index adf60d9..6452fff 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -10,7 +10,6 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#include <sys/stat.h>
#include "tclInt.h"
#include "tclFileSystem.h"
@@ -518,7 +517,7 @@ CopyRenameOneFile(
* 16 bits and we get collisions. See bug #2015723.
*/
-#if !defined(WIN32) && !defined(__CYGWIN__)
+#if !defined(_WIN32) && !defined(__CYGWIN__)
if ((sourceStatBuf.st_ino != 0) && (targetStatBuf.st_ino != 0)) {
if ((sourceStatBuf.st_ino == targetStatBuf.st_ino) &&
(sourceStatBuf.st_dev == targetStatBuf.st_dev)) {
@@ -735,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/tclFileName.c b/generic/tclFileName.c
index 193ca4e..5d4702b 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -11,7 +11,6 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#include <sys/stat.h>
#include "tclInt.h"
#include "tclRegexp.h"
#include "tclFileSystem.h" /* For TclGetPathType() */
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..58c7b3c 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,15 +146,28 @@ 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:
*/
static ChannelBuffer * AllocChannelBuffer(int length);
+static void PreserveChannelBuffer(ChannelBuffer *bufPtr);
+static void ReleaseChannelBuffer(ChannelBuffer *bufPtr);
+static int IsShared(ChannelBuffer *bufPtr);
static void ChannelTimerProc(ClientData clientData);
static int CheckChannelErrors(ChannelState *statePtr,
int direction);
-static int CheckFlush(Channel *chanPtr, ChannelBuffer *bufPtr,
- int newlineFlag);
static int CheckForDeadChannel(Tcl_Interp *interp,
ChannelState *statePtr);
static void CheckForStdChannelsBeingClosed(Tcl_Channel chan);
@@ -80,15 +195,14 @@ static void DiscardInputQueued(ChannelState *statePtr,
int discardSavedBuffers);
static void DiscardOutputQueued(ChannelState *chanPtr);
static int DoRead(Channel *chanPtr, char *srcPtr, int slen, int allowShortReads);
-static int DoWrite(Channel *chanPtr, const char *src, int srcLen);
static int DoReadChars(Channel *chan, Tcl_Obj *objPtr, int toRead,
int appendFlag);
-static int DoWriteChars(Channel *chan, const char *src, int len);
static int FilterInputBytes(Channel *chanPtr,
GetsState *statePtr);
static int FlushChannel(Tcl_Interp *interp, Channel *chanPtr,
int calledFromAsyncFlush);
static int TclGetsObjBinary(Tcl_Channel chan, Tcl_Obj *objPtr);
+static Tcl_Encoding GetBinaryEncoding();
static void FreeBinaryEncoding(ClientData clientData);
static Tcl_HashTable * GetChannelTable(Tcl_Interp *interp);
static int GetInput(Channel *chanPtr);
@@ -108,18 +222,19 @@ static int SetBlockMode(Tcl_Interp *interp, Channel *chanPtr,
static void StopCopy(CopyState *csPtr);
static int TranslateInputEOL(ChannelState *statePtr, char *dst,
const char *src, int *dstLenPtr, int *srcLenPtr);
-static int TranslateOutputEOL(ChannelState *statePtr, char *dst,
- const char *src, int *dstLenPtr, int *srcLenPtr);
static void UpdateInterest(Channel *chanPtr);
-static int WriteBytes(Channel *chanPtr, const char *src,
- int srcLen);
-static int WriteChars(Channel *chanPtr, const char *src,
- int srcLen);
+static int Write(Channel *chanPtr, const char *src,
+ int srcLen, Tcl_Encoding encoding);
static Tcl_Obj * FixLevelCode(Tcl_Obj *msg);
static void SpliceChannel(Tcl_Channel chan);
static void CutChannel(Tcl_Channel chan);
static int WillRead(Channel *chanPtr);
+#define WriteChars(chanPtr, src, srcLen) \
+ Write(chanPtr, src, srcLen, chanPtr->state->encoding)
+#define WriteBytes(chanPtr, src, srcLen) \
+ Write(chanPtr, src, srcLen, tclIdentityEncoding)
+
/*
* Simplifying helper macros. All may use their argument(s) multiple times.
* The ANSI C "prototypes" for the macros are listed below, together with a
@@ -209,23 +324,22 @@ static int WillRead(Channel *chanPtr);
static void DupChannelIntRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static int SetChannelFromAny(Tcl_Interp *interp,
Tcl_Obj *objPtr);
-static void UpdateStringOfChannel(Tcl_Obj *objPtr);
static void FreeChannelIntRep(Tcl_Obj *objPtr);
-static const Tcl_ObjType tclChannelType = {
+static const Tcl_ObjType chanObjType = {
"channel", /* name for this type */
FreeChannelIntRep, /* freeIntRepProc */
DupChannelIntRep, /* dupIntRepProc */
- NULL, /* updateStringProc UpdateStringOfChannel */
+ NULL, /* updateStringProc */
NULL /* setFromAnyProc SetChannelFromAny */
};
#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)
+ ((Tcl_Interp *) (objPtr)->internalRep.twoPtrValue.ptr2)
#define SET_CHANNELINTERP(objPtr, storePtr) \
((objPtr)->internalRep.twoPtrValue.ptr2 = (void *) (storePtr))
@@ -276,6 +390,7 @@ ChanRead(
int *errnoPtr)
{
if (WillRead(chanPtr) < 0) {
+ *errnoPtr = Tcl_GetErrno();
return -1;
}
@@ -695,6 +810,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;
@@ -1465,11 +1582,7 @@ Tcl_CreateChannel(
statePtr->timer = NULL;
statePtr->csPtrR = NULL;
statePtr->csPtrW = NULL;
-
statePtr->outputStage = NULL;
- if ((statePtr->encoding != NULL) && GotFlag(statePtr, TCL_WRITABLE)) {
- statePtr->outputStage = ckalloc(statePtr->bufSize + 2);
- }
/*
* As we are creating the channel, it is obviously the top for now.
@@ -1634,6 +1747,10 @@ Tcl_StackChannel(
statePtr->csPtrR = NULL;
statePtr->csPtrW = NULL;
+ /*
+ * TODO: Examine what can go wrong if Tcl_Flush() call disturbs
+ * the stacking state of this channel during its operations.
+ */
if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {
statePtr->csPtrR = csPtrR;
statePtr->csPtrW = csPtrW;
@@ -1763,6 +1880,13 @@ Tcl_UnstackChannel(
* into the old structure.
*/
+ /*
+ * TODO: Figure out how to handle the situation where the chan
+ * operations called below by this unstacking operation cause
+ * another unstacking recursively. In that case the downChanPtr
+ * value we're holding on to will not be the right thing.
+ */
+
Channel *downChanPtr = chanPtr->downChanPtr;
/*
@@ -1867,7 +1991,7 @@ Tcl_UnstackChannel(
*/
Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
- UpdateInterest(downChanPtr);
+ UpdateInterest(statePtr->topChanPtr);
if (result != 0) {
Tcl_SetErrno(result);
@@ -2179,8 +2303,33 @@ AllocChannelBuffer(
bufPtr->nextRemoved = BUFFER_PADDING;
bufPtr->bufLength = length + BUFFER_PADDING;
bufPtr->nextPtr = NULL;
+ bufPtr->refCount = 1;
return bufPtr;
}
+
+static void
+PreserveChannelBuffer(
+ ChannelBuffer *bufPtr)
+{
+ bufPtr->refCount++;
+}
+
+static void
+ReleaseChannelBuffer(
+ ChannelBuffer *bufPtr)
+{
+ if (--bufPtr->refCount) {
+ return;
+ }
+ ckfree(bufPtr);
+}
+
+static int
+IsShared(
+ ChannelBuffer *bufPtr)
+{
+ return bufPtr->refCount > 1;
+}
/*
*----------------------------------------------------------------------
@@ -2211,9 +2360,12 @@ RecycleBuffer(
/*
* Do we have to free the buffer to the OS?
*/
+ if (IsShared(bufPtr)) {
+ mustDiscard = 1;
+ }
if (mustDiscard) {
- ckfree(bufPtr);
+ ReleaseChannelBuffer(bufPtr);
return;
}
@@ -2224,7 +2376,7 @@ RecycleBuffer(
*/
if ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize) {
- ckfree(bufPtr);
+ ReleaseChannelBuffer(bufPtr);
return;
}
@@ -2259,7 +2411,7 @@ RecycleBuffer(
* If we reached this code we return the buffer to the OS.
*/
- ckfree(bufPtr);
+ ReleaseChannelBuffer(bufPtr);
return;
keepBuffer:
@@ -2435,6 +2587,7 @@ FlushChannel(
* Produce the output on the channel.
*/
+ PreserveChannelBuffer(bufPtr);
toWrite = BytesLeft(bufPtr);
if (toWrite == 0) {
written = 0;
@@ -2558,6 +2711,7 @@ FlushChannel(
}
RecycleBuffer(statePtr, bufPtr, 0);
}
+ ReleaseChannelBuffer(bufPtr);
} /* Closes "while (1)". */
/*
@@ -2659,7 +2813,7 @@ CloseChannel(
*/
if (statePtr->curOutPtr != NULL) {
- ckfree(statePtr->curOutPtr);
+ ReleaseChannelBuffer(statePtr->curOutPtr);
statePtr->curOutPtr = NULL;
}
@@ -2722,10 +2876,6 @@ CloseChannel(
}
Tcl_FreeEncoding(statePtr->encoding);
- if (statePtr->outputStage != NULL) {
- ckfree(statePtr->outputStage);
- statePtr->outputStage = NULL;
- }
}
/*
@@ -3075,7 +3225,8 @@ Tcl_Close(
stickyError = 0;
- if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
+ if ((statePtr->encoding != NULL)
+ && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)
&& (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
statePtr->outputEncodingFlags |= TCL_ENCODING_END;
if (WriteChars(chanPtr, "", 0) < 0) {
@@ -3165,7 +3316,17 @@ Tcl_Close(
Tcl_SetObjResult(interp,
Tcl_NewStringObj(Tcl_PosixError(interp), -1));
}
- flushcode = -1;
+ return TCL_ERROR;
+ }
+ /*
+ * Bug 97069ea11a: set error message if a flush code is set and no error
+ * message set up to now.
+ */
+ if (flushcode != 0 && interp != NULL
+ && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp)) ) {
+ Tcl_SetErrno(flushcode);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(Tcl_PosixError(interp), -1));
}
if ((flushcode != 0) || (result != 0)) {
return TCL_ERROR;
@@ -3662,7 +3823,7 @@ Tcl_Write(
if (srcLen < 0) {
srcLen = strlen(src);
}
- return DoWrite(chanPtr, src, srcLen);
+ return WriteBytes(chanPtr, src, srcLen);
}
/*
@@ -3753,82 +3914,40 @@ Tcl_WriteChars(
int len) /* Length of string in bytes, or < 0 for
* strlen(). */
{
- ChannelState *statePtr; /* State info for channel */
-
- statePtr = ((Channel *) chan)->state;
+ Channel *chanPtr = (Channel *) chan;
+ ChannelState *statePtr = chanPtr->state; /* State info for channel */
+ int result;
+ Tcl_Obj *objPtr;
if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
return -1;
}
- return DoWriteChars((Channel *) chan, src, len);
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * DoWriteChars --
- *
- * Takes a sequence of UTF-8 characters and converts them for output
- * using the channel's current encoding, may queue the buffer for output
- * if it gets full, and also remembers whether the current buffer is
- * ready e.g. if it contains a newline and we are in line buffering mode.
- * Compensates stacking, i.e. will redirect the data from the specified
- * channel to the topmost channel in a stack.
- *
- * Results:
- * The number of bytes written or -1 in case of error. If -1,
- * Tcl_GetErrno will return the error code.
- *
- * Side effects:
- * May buffer up output and may cause output to be produced on the
- * channel.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-DoWriteChars(
- Channel *chanPtr, /* The channel to buffer output for. */
- const char *src, /* UTF-8 characters to queue in output
- * buffer. */
- int len) /* Length of string in bytes, or < 0 for
- * strlen(). */
-{
- /*
- * Always use the topmost channel of the stack
- */
-
- ChannelState *statePtr; /* State info for channel */
-
- statePtr = chanPtr->state;
chanPtr = statePtr->topChanPtr;
if (len < 0) {
len = strlen(src);
}
- if (statePtr->encoding == NULL) {
- /*
- * Inefficient way to convert UTF-8 to byte-array, but the code
- * parallels the way it is done for objects.
- * Special case for 1-byte (used by eg [puts] for the \n) could
- * be extended to more efficient translation of the src string.
- */
-
- int result;
+ if (statePtr->encoding) {
+ return WriteChars(chanPtr, src, len);
+ }
- if ((len == 1) && (UCHAR(*src) < 0xC0)) {
- result = WriteBytes(chanPtr, src, len);
- } else {
- Tcl_Obj *objPtr = Tcl_NewStringObj(src, len);
+ /*
+ * Inefficient way to convert UTF-8 to byte-array, but the code
+ * parallels the way it is done for objects. Special case for 1-byte
+ * (used by eg [puts] for the \n) could be extended to more efficient
+ * translation of the src string.
+ */
- src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
- result = WriteBytes(chanPtr, src, len);
- TclDecrRefCount(objPtr);
- }
- return result;
+ if ((len == 1) && (UCHAR(*src) < 0xC0)) {
+ return WriteBytes(chanPtr, src, len);
}
- return WriteChars(chanPtr, src, len);
+
+ objPtr = Tcl_NewStringObj(src, len);
+ src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
+ result = WriteBytes(chanPtr, src, len);
+ TclDecrRefCount(objPtr);
+ return result;
}
/*
@@ -3904,6 +4023,11 @@ static int
WillRead(
Channel *chanPtr)
{
+ if (chanPtr->typePtr == NULL) {
+ /* Prevent read attempts on a closed channel */
+ Tcl_SetErrno(EINVAL);
+ return -1;
+ }
if ((chanPtr->typePtr->seekProc != NULL)
&& (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
if ((chanPtr->state->curOutPtr != NULL)
@@ -3920,110 +4044,9 @@ WillRead(
/*
*----------------------------------------------------------------------
*
- * WriteBytes --
- *
- * Write a sequence of bytes into an output buffer, may queue the buffer
- * for output if it gets full, and also remembers whether the current
- * buffer is ready e.g. if it contains a newline and we are in line
- * buffering mode.
- *
- * Results:
- * The number of bytes written or -1 in case of error. If -1,
- * Tcl_GetErrno will return the error code.
- *
- * Side effects:
- * May buffer up output and may cause output to be produced on the
- * channel.
+ * Write --
*
- *----------------------------------------------------------------------
- */
-
-static int
-WriteBytes(
- Channel *chanPtr, /* The channel to buffer output for. */
- const char *src, /* Bytes to write. */
- int srcLen) /* Number of bytes to write. */
-{
- ChannelState *statePtr = chanPtr->state;
- /* State info for channel */
- ChannelBuffer *bufPtr;
- char *dst;
- int dstMax, sawLF, savedLF, total, dstLen, toWrite, translate;
-
- if (srcLen) {
- WillWrite(chanPtr);
- }
-
- total = 0;
- sawLF = 0;
- savedLF = 0;
- translate = GotFlag(statePtr, CHANNEL_LINEBUFFERED)
- || (statePtr->outputTranslation != TCL_TRANSLATE_LF);
-
- /*
- * Loop over all bytes in src, storing them in output buffer with proper
- * EOL translation.
- */
-
- while (srcLen + savedLF > 0) {
- bufPtr = statePtr->curOutPtr;
- if (bufPtr == NULL) {
- bufPtr = AllocChannelBuffer(statePtr->bufSize);
- statePtr->curOutPtr = bufPtr;
- }
- dst = InsertPoint(bufPtr);
- dstMax = SpaceLeft(bufPtr);
- dstLen = dstMax;
-
- toWrite = dstLen;
- if (toWrite > srcLen) {
- toWrite = srcLen;
- }
-
- if (translate) {
- if (savedLF) {
- /*
- * A '\n' was left over from last call to TranslateOutputEOL()
- * and we need to store it in this buffer. If the channel is
- * line-based, we will need to flush it.
- */
-
- *dst++ = '\n';
- dstLen--;
- sawLF++;
- }
- if (TranslateOutputEOL(statePtr, dst, src, &dstLen, &toWrite)) {
- sawLF++;
- }
- dstLen += savedLF;
- savedLF = 0;
- if (dstLen > dstMax) {
- savedLF = 1;
- dstLen = dstMax;
- }
- } else {
- memcpy(dst, src, toWrite);
- dstLen = toWrite;
- }
-
- bufPtr->nextAdded += dstLen;
- if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
- return -1;
- }
- total += dstLen;
- src += toWrite;
- srcLen -= toWrite;
- sawLF = 0;
- }
- return total;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * WriteChars --
- *
- * Convert UTF-8 bytes to the channel's external encoding and write the
+ * Convert srcLen bytes starting at src according to encoding and write
* produced bytes into an output buffer, may queue the buffer for output
* if it gets full, and also remembers whether the current buffer is
* ready e.g. if it contains a newline and we are in line buffering mode.
@@ -4040,381 +4063,166 @@ WriteBytes(
*/
static int
-WriteChars(
+Write(
Channel *chanPtr, /* The channel to buffer output for. */
const char *src, /* UTF-8 string to write. */
- int srcLen) /* Length of UTF-8 string in bytes. */
+ int srcLen, /* Length of UTF-8 string in bytes. */
+ Tcl_Encoding encoding)
{
ChannelState *statePtr = chanPtr->state;
/* State info for channel */
- ChannelBuffer *bufPtr;
- char *dst, *stage;
- int saved, savedLF, sawLF, total, dstLen, stageMax, dstWrote;
- int stageLen, toWrite, stageRead, endEncoding, result;
- int consumedSomething, translate;
- Tcl_Encoding encoding;
- char safe[BUFFER_PADDING];
+ char *nextNewLine = NULL;
+ int endEncoding, saved = 0, total = 0, flushed = 0, needNlFlush = 0;
if (srcLen) {
WillWrite(chanPtr);
}
- total = 0;
- sawLF = 0;
- savedLF = 0;
- saved = 0;
- encoding = statePtr->encoding;
-
/*
* Write the terminated escape sequence even if srcLen is 0.
*/
endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);
- translate = GotFlag(statePtr, CHANNEL_LINEBUFFERED)
- || (statePtr->outputTranslation != TCL_TRANSLATE_LF);
-
- /*
- * Loop over all UTF-8 characters in src, storing them in staging buffer
- * with proper EOL translation.
- */
+ if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)
+ || (statePtr->outputTranslation != TCL_TRANSLATE_LF)) {
+ nextNewLine = memchr(src, '\n', srcLen);
+ }
- consumedSomething = 1;
- while (consumedSomething && (srcLen + savedLF + endEncoding > 0)) {
- consumedSomething = 0;
- stage = statePtr->outputStage;
- stageMax = statePtr->bufSize;
- stageLen = stageMax;
+ while (srcLen + saved + endEncoding > 0) {
+ ChannelBuffer *bufPtr;
+ char *dst, safe[BUFFER_PADDING];
+ int result, srcRead, dstLen, dstWrote, srcLimit = srcLen;
- toWrite = stageLen;
- if (toWrite > srcLen) {
- toWrite = srcLen;
+ if (nextNewLine) {
+ srcLimit = nextNewLine - src;
}
-
- if (translate) {
- if (savedLF) {
- /*
- * A '\n' was left over from last call to TranslateOutputEOL()
- * and we need to store it in the staging buffer. If the
- * channel is line-based, we will need to flush the output
- * buffer (after translating the staging buffer).
- */
-
- *stage++ = '\n';
- stageLen--;
- sawLF++;
- }
- if (TranslateOutputEOL(statePtr, stage, src, &stageLen,
- &toWrite)) {
- sawLF++;
- }
-
- stage -= savedLF;
- stageLen += savedLF;
- savedLF = 0;
-
- if (stageLen > stageMax) {
- savedLF = 1;
- stageLen = stageMax;
- }
- } else {
- memcpy(stage, src, toWrite);
- stageLen = toWrite;
+
+ /* Get space to write into */
+ bufPtr = statePtr->curOutPtr;
+ if (bufPtr == NULL) {
+ bufPtr = AllocChannelBuffer(statePtr->bufSize);
+ statePtr->curOutPtr = bufPtr;
}
- src += toWrite;
- srcLen -= toWrite;
-
- /*
- * Loop over all UTF-8 characters in staging buffer, converting them
- * to external encoding, storing them in output buffer.
- */
-
- while (stageLen + saved + endEncoding > 0) {
- bufPtr = statePtr->curOutPtr;
- if (bufPtr == NULL) {
- bufPtr = AllocChannelBuffer(statePtr->bufSize);
- statePtr->curOutPtr = bufPtr;
- }
- dst = InsertPoint(bufPtr);
- dstLen = SpaceLeft(bufPtr);
-
- if (saved != 0) {
- /*
- * Here's some translated bytes left over from the last buffer
- * that we need to stick at the beginning of this buffer.
- */
-
- memcpy(dst, safe, (size_t) saved);
- bufPtr->nextAdded += saved;
- dst += saved;
- dstLen -= saved;
- saved = 0;
- }
-
- result = Tcl_UtfToExternal(NULL, encoding, stage, stageLen,
- statePtr->outputEncodingFlags,
- &statePtr->outputEncodingState, dst,
- dstLen + BUFFER_PADDING, &stageRead, &dstWrote, NULL);
-
+ if (saved) {
/*
- * Fix for SF #506297, reported by Martin Forssen
- * <ruric@users.sourceforge.net>.
- *
- * The encoding chosen in the script exposing the bug writes out
- * three intro characters when TCL_ENCODING_START is set, but does
- * not consume any input as TCL_ENCODING_END is cleared. As some
- * output was generated the enclosing loop calls UtfToExternal
- * again, again with START set. Three more characters in the out
- * and still no use of input ... To break this infinite loop we
- * remove TCL_ENCODING_START from the set of flags after the first
- * call (no condition is required, the later calls remove an unset
- * flag, which is a no-op). This causes the subsequent calls to
- * UtfToExternal to consume and convert the actual input.
+ * Here's some translated bytes left over from the last buffer
+ * that we need to stick at the beginning of this buffer.
*/
- statePtr->outputEncodingFlags &= ~TCL_ENCODING_START;
+ memcpy(InsertPoint(bufPtr), safe, (size_t) saved);
+ bufPtr->nextAdded += saved;
+ saved = 0;
+ }
+ PreserveChannelBuffer(bufPtr);
+ dst = InsertPoint(bufPtr);
+ dstLen = SpaceLeft(bufPtr);
+
+ result = Tcl_UtfToExternal(NULL, encoding, src, srcLimit,
+ statePtr->outputEncodingFlags,
+ &statePtr->outputEncodingState, dst,
+ dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL);
+
+ /* See chan-io-1.[89]. Tcl Bug 506297. */
+ statePtr->outputEncodingFlags &= ~TCL_ENCODING_START;
+
+ if ((result != TCL_OK) && (srcRead + dstWrote == 0)) {
+ /* We're reading from invalid/incomplete UTF-8 */
+ ReleaseChannelBuffer(bufPtr);
+ if (total == 0) {
+ Tcl_SetErrno(EINVAL);
+ return -1;
+ }
+ break;
+ }
- /*
- * The following code must be executed only when result is not 0.
- */
+ bufPtr->nextAdded += dstWrote;
+ src += srcRead;
+ srcLen -= srcRead;
+ total += dstWrote;
+ dst += dstWrote;
+ dstLen -= dstWrote;
- if ((result != 0) && (stageRead + dstWrote == 0)) {
- /*
- * We have an incomplete UTF-8 character at the end of the
- * staging buffer. It will get moved to the beginning of the
- * staging buffer followed by more bytes from src.
- */
+ if (src == nextNewLine && dstLen > 0) {
+ static char crln[3] = "\r\n";
+ char *nl = NULL;
+ int nlLen = 0;
- src -= stageLen;
- srcLen += stageLen;
- stageLen = 0;
- savedLF = 0;
+ switch (statePtr->outputTranslation) {
+ case TCL_TRANSLATE_LF:
+ nl = crln + 1;
+ nlLen = 1;
+ break;
+ case TCL_TRANSLATE_CR:
+ nl = crln;
+ nlLen = 1;
+ break;
+ case TCL_TRANSLATE_CRLF:
+ nl = crln;
+ nlLen = 2;
+ break;
+ default:
+ Tcl_Panic("unknown output translation requested");
break;
}
- bufPtr->nextAdded += dstWrote;
- if (IsBufferOverflowing(bufPtr)) {
- /*
- * When translating from UTF-8 to external encoding, we
- * allowed the translation to produce a character that crossed
- * the end of the output buffer, so that we would get a
- * completely full buffer before flushing it. The extra bytes
- * will be moved to the beginning of the next buffer.
- */
+
+ result |= Tcl_UtfToExternal(NULL, encoding, nl, nlLen,
+ statePtr->outputEncodingFlags,
+ &statePtr->outputEncodingState, dst,
+ dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL);
- saved = -SpaceLeft(bufPtr);
- memcpy(safe, dst + dstLen, (size_t) saved);
- bufPtr->nextAdded = bufPtr->bufLength;
- }
- if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
- return -1;
+ if (srcRead != nlLen) {
+ Tcl_Panic("Can This Happen?");
}
+ bufPtr->nextAdded += dstWrote;
+ src++;
+ srcLen--;
total += dstWrote;
- stage += stageRead;
- stageLen -= stageRead;
- sawLF = 0;
-
- consumedSomething = 1;
+ dst += dstWrote;
+ dstLen -= dstWrote;
+ nextNewLine = memchr(src, '\n', srcLen);
+ needNlFlush = 1;
+ }
+ if (IsBufferOverflowing(bufPtr)) {
/*
- * If all translated characters are written to the buffer,
- * endEncoding is set to 0 because the escape sequence may be
- * output.
+ * When translating from UTF-8 to external encoding, we
+ * allowed the translation to produce a character that crossed
+ * the end of the output buffer, so that we would get a
+ * completely full buffer before flushing it. The extra bytes
+ * will be moved to the beginning of the next buffer.
*/
- if ((stageLen + saved == 0) && (result == 0)) {
- endEncoding = 0;
- }
+ saved = -SpaceLeft(bufPtr);
+ memcpy(safe, dst + dstLen, (size_t) saved);
+ bufPtr->nextAdded = bufPtr->bufLength;
}
- }
-
- /*
- * If nothing was written and it happened because there was no progress in
- * the UTF conversion, we throw an error.
- */
- if (!consumedSomething && (total == 0)) {
- Tcl_SetErrno(EINVAL);
- return -1;
- }
- return total;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TranslateOutputEOL --
- *
- * Helper function for WriteBytes() and WriteChars(). Converts the '\n'
- * characters in the source buffer into the appropriate EOL form
- * specified by the output translation mode.
- *
- * EOL translation stops either when the source buffer is empty or the
- * output buffer is full.
- *
- * When converting to CRLF mode and there is only 1 byte left in the
- * output buffer, this routine stores the '\r' in the last byte and then
- * stores the '\n' in the byte just past the end of the buffer. The
- * caller is responsible for passing in a buffer that is large enough to
- * hold the extra byte.
- *
- * Results:
- * The return value is 1 if a '\n' was translated from the source buffer,
- * or 0 otherwise -- this can be used by the caller to decide to flush a
- * line-based channel even though the channel buffer is not full.
- *
- * *dstLenPtr is filled with how many bytes of the output buffer were
- * used. As mentioned above, this can be one more that the output
- * buffer's specified length if a CRLF was stored.
- *
- * *srcLenPtr is filled with how many bytes of the source buffer were
- * consumed.
- *
- * Side effects:
- * It may be obvious, but bears mentioning that when converting in CRLF
- * mode (which requires two bytes of storage in the output buffer), the
- * number of bytes consumed from the source buffer will be less than the
- * number of bytes stored in the output buffer.
- *
- *---------------------------------------------------------------------------
- */
-
-static int
-TranslateOutputEOL(
- ChannelState *statePtr, /* Channel being read, for translation and
- * buffering modes. */
- char *dst, /* Output buffer filled with UTF-8 chars by
- * applying appropriate EOL translation to
- * source characters. */
- const char *src, /* Source UTF-8 characters. */
- int *dstLenPtr, /* On entry, the maximum length of output
- * buffer in bytes. On exit, the number of
- * bytes actually used in output buffer. */
- int *srcLenPtr) /* On entry, the length of source buffer. On
- * exit, the number of bytes read from the
- * source buffer. */
-{
- char *dstEnd;
- int srcLen, newlineFound;
-
- newlineFound = 0;
- srcLen = *srcLenPtr;
-
- switch (statePtr->outputTranslation) {
- case TCL_TRANSLATE_LF:
- for (dstEnd = dst + srcLen; dst < dstEnd; ) {
- if (*src == '\n') {
- newlineFound = 1;
- }
- *dst++ = *src++;
- }
- *dstLenPtr = srcLen;
- break;
- case TCL_TRANSLATE_CR:
- for (dstEnd = dst + srcLen; dst < dstEnd;) {
- if (*src == '\n') {
- *dst++ = '\r';
- newlineFound = 1;
- src++;
- } else {
- *dst++ = *src++;
- }
- }
- *dstLenPtr = srcLen;
- break;
- case TCL_TRANSLATE_CRLF: {
- /*
- * Since this causes the number of bytes to grow, we start off trying
- * to put 'srcLen' bytes into the output buffer, but allow it to store
- * more bytes, as long as there's still source bytes and room in the
- * output buffer.
- */
-
- char *dstStart, *dstMax;
- const char *srcStart;
-
- dstStart = dst;
- dstMax = dst + *dstLenPtr;
-
- srcStart = src;
-
- if (srcLen < *dstLenPtr) {
- dstEnd = dst + srcLen;
- } else {
- dstEnd = dst + *dstLenPtr;
- }
- while (dst < dstEnd) {
- if (*src == '\n') {
- if (dstEnd < dstMax) {
- dstEnd++;
- }
- *dst++ = '\r';
- newlineFound = 1;
- }
- *dst++ = *src++;
+ if ((srcLen + saved == 0) && (result == TCL_OK)) {
+ endEncoding = 0;
}
- *srcLenPtr = src - srcStart;
- *dstLenPtr = dst - dstStart;
- break;
- }
- default:
- break;
- }
- return newlineFound;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * CheckFlush --
- *
- * Helper function for WriteBytes() and WriteChars(). If the channel
- * buffer is ready to be flushed, flush it.
- *
- * Results:
- * The return value is -1 if there was a problem flushing the channel
- * buffer, or 0 otherwise.
- *
- * Side effects:
- * The buffer will be recycled if it is flushed.
- *
- *---------------------------------------------------------------------------
- */
-static int
-CheckFlush(
- Channel *chanPtr, /* Channel being read, for buffering mode. */
- ChannelBuffer *bufPtr, /* Channel buffer to possibly flush. */
- int newlineFlag) /* Non-zero if a the channel buffer contains a
- * newline. */
-{
- ChannelState *statePtr = chanPtr->state;
- /* State info for channel */
-
- /*
- * The current buffer is ready for output:
- * 1. if it is full.
- * 2. if it contains a newline and this channel is line-buffered.
- * 3. if it contains any output and this channel is unbuffered.
- */
-
- if (!GotFlag(statePtr, BUFFER_READY)) {
if (IsBufferFull(bufPtr)) {
- SetFlag(statePtr, BUFFER_READY);
- } else if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)) {
- if (newlineFlag != 0) {
- SetFlag(statePtr, BUFFER_READY);
+ if (FlushChannel(NULL, chanPtr, 0) != 0) {
+ return -1;
+ }
+ flushed += statePtr->bufSize;
+ if (saved == 0 || src[-1] != '\n') {
+ needNlFlush = 0;
}
- } else if (GotFlag(statePtr, CHANNEL_UNBUFFERED)) {
- SetFlag(statePtr, BUFFER_READY);
}
+ ReleaseChannelBuffer(bufPtr);
}
- if (GotFlag(statePtr, BUFFER_READY)) {
+ if ((flushed < total) && (GotFlag(statePtr, CHANNEL_UNBUFFERED) ||
+ (needNlFlush && GotFlag(statePtr, CHANNEL_LINEBUFFERED)))) {
+ SetFlag(statePtr, BUFFER_READY);
if (FlushChannel(NULL, chanPtr, 0) != 0) {
return -1;
}
}
- return 0;
+
+ return total;
}
/*
@@ -4517,6 +4325,7 @@ Tcl_GetsObj(
*/
chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
bufPtr = statePtr->inQueueHead;
encoding = statePtr->encoding;
@@ -4540,16 +4349,7 @@ Tcl_GetsObj(
*/
if (encoding == NULL) {
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- if (tsdPtr->binaryEncoding == NULL) {
- tsdPtr->binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
- Tcl_CreateThreadExitHandler(FreeBinaryEncoding, NULL);
- }
- encoding = tsdPtr->binaryEncoding;
- if (encoding == NULL) {
- Tcl_Panic("attempted gets on binary channel where no iso8859-1 encoding available");
- }
+ encoding = GetBinaryEncoding();
}
/*
@@ -4759,7 +4559,11 @@ Tcl_GetsObj(
* self-modifying reflected transforms.
*/
- chanPtr = statePtr->topChanPtr;
+ if (chanPtr != statePtr->topChanPtr) {
+ Tcl_Release(chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
+ }
bufPtr = gs.bufPtr;
if (bufPtr == NULL) {
@@ -4793,16 +4597,18 @@ Tcl_GetsObj(
* Regenerate the top channel, in case it was changed due to
* self-modifying reflected transforms.
*/
-
- chanPtr = statePtr->topChanPtr;
-
+ if (chanPtr != statePtr->topChanPtr) {
+ Tcl_Release(chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
+ }
bufPtr = statePtr->inQueueHead;
- if (bufPtr == NULL) {
- Tcl_Panic("Tcl_GetsObj: restore reached with bufPtr==NULL");
+ if (bufPtr != NULL) {
+ bufPtr->nextRemoved = oldRemoved;
+ bufPtr = bufPtr->nextPtr;
}
- bufPtr->nextRemoved = oldRemoved;
- for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
+ for ( ; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
bufPtr->nextRemoved = BUFFER_PADDING;
}
CommonGetsCleanup(chanPtr);
@@ -4835,10 +4641,13 @@ Tcl_GetsObj(
* Regenerate the top channel, in case it was changed due to
* self-modifying reflected transforms.
*/
-
- chanPtr = statePtr->topChanPtr;
-
+ if (chanPtr != statePtr->topChanPtr) {
+ Tcl_Release(chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
+ }
UpdateInterest(chanPtr);
+ Tcl_Release(chanPtr);
return copiedTotal;
}
@@ -4884,6 +4693,7 @@ TclGetsObjBinary(
*/
chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
bufPtr = statePtr->inQueueHead;
@@ -4941,6 +4751,9 @@ TclGetsObjBinary(
goto restore;
}
bufPtr = statePtr->inQueueTail;
+ if (bufPtr == NULL) {
+ goto restore;
+ }
}
dst = (unsigned char *) RemovePoint(bufPtr);
@@ -5053,12 +4866,12 @@ TclGetsObjBinary(
restore:
bufPtr = statePtr->inQueueHead;
- if (bufPtr == NULL) {
- Tcl_Panic("TclGetsObjBinary: restore reached with bufPtr==NULL");
+ if (bufPtr) {
+ bufPtr->nextRemoved = oldRemoved;
+ bufPtr = bufPtr->nextPtr;
}
- bufPtr->nextRemoved = oldRemoved;
- for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
+ for ( ; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
bufPtr->nextRemoved = BUFFER_PADDING;
}
CommonGetsCleanup(chanPtr);
@@ -5087,6 +4900,7 @@ TclGetsObjBinary(
done:
UpdateInterest(chanPtr);
+ Tcl_Release(chanPtr);
return copiedTotal;
}
@@ -5115,6 +4929,21 @@ FreeBinaryEncoding(
tsdPtr->binaryEncoding = NULL;
}
}
+
+static Tcl_Encoding
+GetBinaryEncoding()
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (tsdPtr->binaryEncoding == NULL) {
+ tsdPtr->binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
+ Tcl_CreateThreadExitHandler(FreeBinaryEncoding, NULL);
+ }
+ if (tsdPtr->binaryEncoding == NULL) {
+ Tcl_Panic("binary encoding is not available");
+ }
+ return tsdPtr->binaryEncoding;
+}
/*
*---------------------------------------------------------------------------
@@ -5197,6 +5026,11 @@ FilterInputBytes(
}
bufPtr = statePtr->inQueueTail;
gsPtr->bufPtr = bufPtr;
+ if (bufPtr == NULL) {
+ gsPtr->charsWrote = 0;
+ gsPtr->rawRead = 0;
+ return -1;
+ }
}
/*
@@ -5544,6 +5378,7 @@ Tcl_ReadRaw(
* requests more bytes.
*/
+ Tcl_Preserve(chanPtr);
for (copied = 0; copied < bytesToRead; copied += copiedNow) {
copiedNow = CopyBuffer(chanPtr, bufPtr + copied,
bytesToRead - copied);
@@ -5626,7 +5461,7 @@ Tcl_ReadRaw(
* over EAGAIN/WOULDBLOCK handling.
*/
- return copied;
+ goto done;
}
SetFlag(statePtr, CHANNEL_BLOCKED);
@@ -5634,14 +5469,17 @@ Tcl_ReadRaw(
}
Tcl_SetErrno(result);
- return -1;
+ copied = -1;
+ goto done;
}
- return copied + nread;
+ copied += nread;
+ goto done;
}
}
done:
+ Tcl_Release(chanPtr);
return copied;
}
@@ -5749,6 +5587,7 @@ DoReadChars(
chanPtr = statePtr->topChanPtr;
encoding = statePtr->encoding;
factor = UTF_EXPANSION_FACTOR;
+ Tcl_Preserve(chanPtr);
if (appendFlag == 0) {
if (encoding == NULL) {
@@ -5810,6 +5649,11 @@ DoReadChars(
ResetFlag(statePtr, CHANNEL_BLOCKED);
}
result = GetInput(chanPtr);
+ if (chanPtr != statePtr->topChanPtr) {
+ Tcl_Release(chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
+ }
if (result != 0) {
if (result == EAGAIN) {
break;
@@ -5840,10 +5684,13 @@ DoReadChars(
* Regenerate the top channel, in case it was changed due to
* self-modifying reflected transforms.
*/
-
- chanPtr = statePtr->topChanPtr;
-
+ if (chanPtr != statePtr->topChanPtr) {
+ Tcl_Release(chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
+ }
UpdateInterest(chanPtr);
+ Tcl_Release(chanPtr);
return copied;
}
@@ -6599,7 +6446,7 @@ DiscardInputQueued(
*/
if (discardSavedBuffers && statePtr->saveInBufPtr != NULL) {
- ckfree(statePtr->saveInBufPtr);
+ ReleaseChannelBuffer(statePtr->saveInBufPtr);
statePtr->saveInBufPtr = NULL;
}
}
@@ -6692,7 +6539,7 @@ GetInput(
if ((bufPtr != NULL)
&& (bufPtr->bufLength - BUFFER_PADDING < statePtr->bufSize)) {
- ckfree(bufPtr);
+ ReleaseChannelBuffer(bufPtr);
bufPtr = NULL;
}
@@ -6754,10 +6601,12 @@ GetInput(
} else
#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
{
+ PreserveChannelBuffer(bufPtr);
nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead, &result);
}
if (nread > 0) {
+ result = 0;
bufPtr->nextAdded += nread;
/*
@@ -6781,6 +6630,7 @@ GetInput(
}
#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
} else if (nread == 0) {
+ result = 0;
SetFlag(statePtr, CHANNEL_EOF);
statePtr->inputEncodingFlags |= TCL_ENCODING_END;
} else if (nread < 0) {
@@ -6789,9 +6639,9 @@ GetInput(
result = EAGAIN;
}
Tcl_SetErrno(result);
- return result;
}
- return 0;
+ ReleaseChannelBuffer(bufPtr);
+ return result;
}
/*
@@ -7478,14 +7328,6 @@ Tcl_SetChannelBufferSize(
statePtr = ((Channel *) chan)->state;
statePtr->bufSize = sz;
-
- if (statePtr->outputStage != NULL) {
- ckfree(statePtr->outputStage);
- statePtr->outputStage = NULL;
- }
- if ((statePtr->encoding != NULL) && GotFlag(statePtr, TCL_WRITABLE)) {
- statePtr->outputStage = ckalloc(statePtr->bufSize + 2);
- }
}
/*
@@ -7937,7 +7779,8 @@ Tcl_SetChannelOption(
* iso2022, the terminated escape sequence must write to the buffer.
*/
- if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
+ if ((statePtr->encoding != NULL)
+ && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)
&& (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
statePtr->outputEncodingFlags |= TCL_ENCODING_END;
WriteChars(chanPtr, "", 0);
@@ -8126,17 +7969,6 @@ Tcl_SetChannelOption(
statePtr->inQueueTail = NULL;
}
- /*
- * If encoding or bufsize changes, need to update output staging buffer.
- */
-
- if (statePtr->outputStage != NULL) {
- ckfree(statePtr->outputStage);
- statePtr->outputStage = NULL;
- }
- if ((statePtr->encoding != NULL) && GotFlag(statePtr, TCL_WRITABLE)) {
- statePtr->outputStage = ckalloc(statePtr->bufSize + 2);
- }
return TCL_OK;
}
@@ -8371,6 +8203,11 @@ UpdateInterest(
/* State info for channel */
int mask = statePtr->interestMask;
+ if (chanPtr->typePtr == NULL) {
+ /* Do not update interest on a closed channel */
+ return;
+ }
+
/*
* If there are flushed buffers waiting to be written, then we need to
* watch for the channel to become writable.
@@ -9283,9 +9120,9 @@ CopyData(
}
if (outBinary || sameEncoding) {
- sizeb = DoWrite(outStatePtr->topChanPtr, buffer, sizeb);
+ sizeb = WriteBytes(outStatePtr->topChanPtr, buffer, sizeb);
} else {
- sizeb = DoWriteChars(outStatePtr->topChanPtr, buffer, sizeb);
+ sizeb = WriteChars(outStatePtr->topChanPtr, buffer, sizeb);
}
/*
@@ -9474,6 +9311,7 @@ DoRead(
* operation.
*/
+ Tcl_Preserve(chanPtr);
if (!GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
ResetFlag(statePtr, CHANNEL_EOF);
}
@@ -9514,6 +9352,7 @@ DoRead(
done:
UpdateInterest(chanPtr);
+ Tcl_Release(chanPtr);
return copied;
}
@@ -9837,162 +9676,6 @@ CopyBuffer(
/*
*----------------------------------------------------------------------
*
- * DoWrite --
- *
- * Puts a sequence of characters into an output buffer, may queue the
- * buffer for output if it gets full, and also remembers whether the
- * current buffer is ready e.g. if it contains a newline and we are in
- * line buffering mode.
- *
- * Results:
- * The number of bytes written or -1 in case of error. If -1,
- * Tcl_GetErrno will return the error code.
- *
- * Side effects:
- * May buffer up output and may cause output to be produced on the
- * channel.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-DoWrite(
- Channel *chanPtr, /* The channel to buffer output for. */
- const char *src, /* Data to write. */
- int srcLen) /* Number of bytes to write. */
-{
- ChannelState *statePtr = chanPtr->state;
- /* State info for channel */
- ChannelBuffer *outBufPtr; /* Current output buffer. */
- int foundNewline; /* Did we find a newline in output? */
- char *dPtr;
- const char *sPtr; /* Search variables for newline. */
- int crsent; /* In CRLF eol translation mode, remember the
- * fact that a CR was output to the channel
- * without its following NL. */
- int i; /* Loop index for newline search. */
- int destCopied; /* How many bytes were used in this
- * destination buffer to hold the output? */
- int totalDestCopied; /* How many bytes total were copied to the
- * channel buffer? */
- int srcCopied; /* How many bytes were copied from the source
- * string? */
- char *destPtr; /* Where in line to copy to? */
-
- /*
- * If we are in network (or windows) translation mode, record the fact
- * that we have not yet sent a CR to the channel.
- */
-
- crsent = 0;
-
- /*
- * Loop filling buffers and flushing them until all output has been
- * consumed.
- */
-
- srcCopied = 0;
- totalDestCopied = 0;
-
- while (srcLen > 0) {
- /*
- * Make sure there is a current output buffer to accept output.
- */
-
- if (statePtr->curOutPtr == NULL) {
- statePtr->curOutPtr = AllocChannelBuffer(statePtr->bufSize);
- }
-
- outBufPtr = statePtr->curOutPtr;
-
- destCopied = SpaceLeft(outBufPtr);
- if (destCopied > srcLen) {
- destCopied = srcLen;
- }
-
- destPtr = InsertPoint(outBufPtr);
- switch (statePtr->outputTranslation) {
- case TCL_TRANSLATE_LF:
- srcCopied = destCopied;
- memcpy(destPtr, src, (size_t) destCopied);
- break;
- case TCL_TRANSLATE_CR:
- srcCopied = destCopied;
- memcpy(destPtr, src, (size_t) destCopied);
- for (dPtr = destPtr; dPtr < destPtr + destCopied; dPtr++) {
- if (*dPtr == '\n') {
- *dPtr = '\r';
- }
- }
- break;
- case TCL_TRANSLATE_CRLF:
- for (srcCopied = 0, dPtr = destPtr, sPtr = src;
- dPtr < destPtr + destCopied;
- dPtr++, sPtr++, srcCopied++) {
- if (*sPtr == '\n') {
- if (crsent) {
- *dPtr = '\n';
- crsent = 0;
- } else {
- *dPtr = '\r';
- crsent = 1;
- sPtr--, srcCopied--;
- }
- } else {
- *dPtr = *sPtr;
- }
- }
- break;
- case TCL_TRANSLATE_AUTO:
- Tcl_Panic("Tcl_Write: AUTO output translation mode not supported");
- default:
- Tcl_Panic("Tcl_Write: unknown output translation mode");
- }
-
- /*
- * The current buffer is ready for output if it is full, or if it
- * contains a newline and this channel is line-buffered, or if it
- * contains any output and this channel is unbuffered.
- */
-
- outBufPtr->nextAdded += destCopied;
- if (!GotFlag(statePtr, BUFFER_READY)) {
- if (IsBufferFull(outBufPtr)) {
- SetFlag(statePtr, BUFFER_READY);
- } else if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)) {
- for (sPtr = src, i = 0, foundNewline = 0;
- (i < srcCopied) && (!foundNewline);
- i++, sPtr++) {
- if (*sPtr == '\n') {
- foundNewline = 1;
- break;
- }
- }
- if (foundNewline) {
- SetFlag(statePtr, BUFFER_READY);
- }
- } else if (GotFlag(statePtr, CHANNEL_UNBUFFERED)) {
- SetFlag(statePtr, BUFFER_READY);
- }
- }
-
- totalDestCopied += srcCopied;
- src += srcCopied;
- srcLen -= srcCopied;
-
- if (GotFlag(statePtr, BUFFER_READY)) {
- if (FlushChannel(NULL, chanPtr, 0) != 0) {
- return -1;
- }
- }
- } /* Closes "while" */
-
- return totalDestCopied;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* CopyEventProc --
*
* This routine is invoked as a channel event handler for the background
@@ -10107,12 +9790,15 @@ StackSetBlockMode(
{
int result = 0;
Tcl_DriverBlockModeProc *blockModeProc;
+ ChannelState *statePtr = chanPtr->state;
/*
* Start at the top of the channel stack
+ * TODO: Examine what can go wrong when blockModeProc calls
+ * disturb the stacking state of the channel.
*/
- chanPtr = chanPtr->state->topChanPtr;
+ chanPtr = statePtr->topChanPtr;
while (chanPtr != NULL) {
blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
if (blockModeProc != NULL) {
@@ -11215,12 +10901,11 @@ DupChannelIntRep(
* currently have an internal rep.*/
{
ChannelState *statePtr = GET_CHANNELSTATE(srcPtr);
- Interp *interpPtr = GET_CHANNELINTERP(srcPtr);
SET_CHANNELSTATE(copyPtr, statePtr);
- SET_CHANNELINTERP(copyPtr, interpPtr);
+ SET_CHANNELINTERP(copyPtr, GET_CHANNELINTERP(srcPtr));
Tcl_Preserve(statePtr);
- copyPtr->typePtr = &tclChannelType;
+ copyPtr->typePtr = srcPtr->typePtr;
}
/*
@@ -11246,43 +10931,29 @@ SetChannelFromAny(
register Tcl_Obj *objPtr) /* The object to convert. */
{
ChannelState *statePtr;
- Interp *interpPtr;
if (interp == NULL) {
return TCL_ERROR;
}
- if (objPtr->typePtr == &tclChannelType) {
+ if (objPtr->typePtr == &chanObjType) {
/*
* The channel is valid until any call to DetachChannel occurs.
* Ensure consistency checks are done.
*/
statePtr = GET_CHANNELSTATE(objPtr);
- interpPtr = GET_CHANNELINTERP(objPtr);
if (GotFlag(statePtr, CHANNEL_TAINTED|CHANNEL_CLOSED)) {
ResetFlag(statePtr, CHANNEL_TAINTED);
Tcl_Release(statePtr);
- UpdateStringOfChannel(objPtr);
objPtr->typePtr = NULL;
- } else if (interpPtr != (Interp*) interp) {
+ } else if (interp != GET_CHANNELINTERP(objPtr)) {
Tcl_Release(statePtr);
- UpdateStringOfChannel(objPtr);
objPtr->typePtr = NULL;
}
}
- if (objPtr->typePtr != &tclChannelType) {
- Tcl_Channel chan;
-
- /*
- * We need a valid string with which to check for a valid channel, but
- * make sure not to free internal rep until validated. [Bug 1847044]
- */
-
- if ((objPtr->typePtr != NULL) && (objPtr->bytes == NULL)) {
- objPtr->typePtr->updateStringProc(objPtr);
- }
+ if (objPtr->typePtr != &chanObjType) {
+ Tcl_Channel chan = Tcl_GetChannel(interp, TclGetString(objPtr), NULL);
- chan = Tcl_GetChannel(interp, objPtr->bytes, NULL);
if (chan == NULL) {
return TCL_ERROR;
}
@@ -11292,7 +10963,7 @@ SetChannelFromAny(
Tcl_Preserve(statePtr);
SET_CHANNELSTATE(objPtr, statePtr);
SET_CHANNELINTERP(objPtr, interp);
- objPtr->typePtr = &tclChannelType;
+ objPtr->typePtr = &chanObjType;
}
return TCL_OK;
}
@@ -11300,45 +10971,6 @@ SetChannelFromAny(
/*
*----------------------------------------------------------------------
*
- * UpdateStringOfChannel --
- *
- * Update the string representation for an object whose internal
- * representation is "Channel".
- *
- * Results:
- * None.
- *
- * Side effects:
- * The object's string may be set by converting its Unicode represention
- * to UTF format.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-UpdateStringOfChannel(
- Tcl_Obj *objPtr) /* Object with string rep to update. */
-{
- if (objPtr->bytes == NULL) {
- ChannelState *statePtr = GET_CHANNELSTATE(objPtr);
- const char *name = statePtr->channelName;
-
- if (name) {
- size_t len = strlen(name);
-
- objPtr->bytes = ckalloc(len + 1);
- objPtr->length = len;
- memcpy(objPtr->bytes, name, len);
- } else {
- objPtr->bytes = tclEmptyStringRep;
- objPtr->length = 0;
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
* FreeChannelIntRep --
*
* Release statePtr storage.
diff --git a/generic/tclIO.h b/generic/tclIO.h
index 1e89878..1e02749 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -30,32 +30,13 @@
#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.
*/
typedef struct ChannelBuffer {
+ int refCount; /* Current uses count */
int nextAdded; /* The next position into which a character
* will be put in the buffer. */
int nextRemoved; /* Position of next byte to be removed from
@@ -86,19 +67,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 +163,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 +186,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 +313,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 1673bce..14910d7 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -181,6 +181,7 @@ Tcl_PutsObjCmd(
return TCL_ERROR;
}
+ Tcl_Preserve(chan);
result = Tcl_WriteObj(chan, string);
if (result < 0) {
goto error;
@@ -191,6 +192,7 @@ Tcl_PutsObjCmd(
goto error;
}
}
+ Tcl_Release(chan);
return TCL_OK;
/*
@@ -205,6 +207,7 @@ Tcl_PutsObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf("error writing \"%s\": %s",
TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
+ Tcl_Release(chan);
return TCL_ERROR;
}
@@ -252,6 +255,7 @@ Tcl_FlushObjCmd(
return TCL_ERROR;
}
+ Tcl_Preserve(chan);
if (Tcl_Flush(chan) != TCL_OK) {
/*
* TIP #219.
@@ -265,8 +269,10 @@ Tcl_FlushObjCmd(
"error flushing \"%s\": %s",
TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
+ Tcl_Release(chan);
return TCL_ERROR;
}
+ Tcl_Release(chan);
return TCL_OK;
}
@@ -299,6 +305,7 @@ Tcl_GetsObjCmd(
int lineLen; /* Length of line just read. */
int mode; /* Mode in which channel is opened. */
Tcl_Obj *linePtr, *chanObjPtr;
+ int code = TCL_OK;
if ((objc != 2) && (objc != 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
@@ -315,6 +322,7 @@ Tcl_GetsObjCmd(
return TCL_ERROR;
}
+ Tcl_Preserve(chan);
linePtr = Tcl_NewObj();
lineLen = Tcl_GetsObj(chan, linePtr);
if (lineLen < 0) {
@@ -333,7 +341,8 @@ Tcl_GetsObjCmd(
"error reading \"%s\": %s",
TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
- return TCL_ERROR;
+ code = TCL_ERROR;
+ goto done;
}
lineLen = -1;
}
@@ -346,7 +355,9 @@ Tcl_GetsObjCmd(
} else {
Tcl_SetObjResult(interp, linePtr);
}
- return TCL_OK;
+ done:
+ Tcl_Release(chan);
+ return code;
}
/*
@@ -453,6 +464,7 @@ Tcl_ReadObjCmd(
resultPtr = Tcl_NewObj();
Tcl_IncrRefCount(resultPtr);
+ Tcl_Preserve(chan);
charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
if (charactersRead < 0) {
/*
@@ -467,6 +479,7 @@ Tcl_ReadObjCmd(
"error reading \"%s\": %s",
TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
+ Tcl_Release(chan);
Tcl_DecrRefCount(resultPtr);
return TCL_ERROR;
}
@@ -485,6 +498,7 @@ Tcl_ReadObjCmd(
}
}
Tcl_SetObjResult(interp, resultPtr);
+ Tcl_Release(chan);
Tcl_DecrRefCount(resultPtr);
return TCL_OK;
}
@@ -544,6 +558,7 @@ Tcl_SeekObjCmd(
mode = modeArray[optionIndex];
}
+ Tcl_Preserve(chan);
result = Tcl_Seek(chan, offset, mode);
if (result == Tcl_LongAsWide(-1)) {
/*
@@ -558,8 +573,10 @@ Tcl_SeekObjCmd(
"error during seek on \"%s\": %s",
TclGetString(objv[1]), Tcl_PosixError(interp)));
}
+ Tcl_Release(chan);
return TCL_ERROR;
}
+ Tcl_Release(chan);
return TCL_OK;
}
@@ -590,6 +607,7 @@ Tcl_TellObjCmd(
{
Tcl_Channel chan; /* The channel to tell on. */
Tcl_WideInt newLoc;
+ int code;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId");
@@ -605,6 +623,7 @@ Tcl_TellObjCmd(
return TCL_ERROR;
}
+ Tcl_Preserve(chan);
newLoc = Tcl_Tell(chan);
/*
@@ -613,7 +632,10 @@ Tcl_TellObjCmd(
* them into the regular interpreter result.
*/
- if (TclChanCaughtErrorBypass(interp, chan)) {
+
+ code = TclChanCaughtErrorBypass(interp, chan);
+ Tcl_Release(chan);
+ if (code) {
return TCL_ERROR;
}
diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index bfe6a10..29996ea 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -210,7 +210,27 @@ struct TransformChannelData {
* a transformation of incoming data. Also
* serves as buffer of all data not yet
* consumed by the reader. */
+ int refCount;
};
+
+static void
+PreserveData(
+ TransformChannelData *dataPtr)
+{
+ dataPtr->refCount++;
+}
+
+static void
+ReleaseData(
+ TransformChannelData *dataPtr)
+{
+ if (--dataPtr->refCount) {
+ return;
+ }
+ ResultClear(&dataPtr->result);
+ Tcl_DecrRefCount(dataPtr->command);
+ ckfree(dataPtr);
+}
/*
*----------------------------------------------------------------------
@@ -240,6 +260,7 @@ TclChannelTransform(
Channel *chanPtr; /* The actual channel. */
ChannelState *statePtr; /* State info for channel. */
int mode; /* Read/write mode of the channel. */
+ int objc;
TransformChannelData *dataPtr;
Tcl_DString ds;
@@ -247,6 +268,12 @@ TclChannelTransform(
return TCL_ERROR;
}
+ if (TCL_OK != Tcl_ListObjLength(interp, cmdObjPtr, &objc)) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("-command value is not a list", -1));
+ return TCL_ERROR;
+ }
+
chanPtr = (Channel *) chan;
statePtr = chanPtr->state;
chanPtr = statePtr->topChanPtr;
@@ -261,6 +288,7 @@ TclChannelTransform(
dataPtr = ckalloc(sizeof(TransformChannelData));
+ dataPtr->refCount = 1;
Tcl_DStringInit(&ds);
Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
dataPtr->readIsFlushed = 0;
@@ -286,9 +314,7 @@ TclChannelTransform(
if (dataPtr->self == NULL) {
Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp),
"\nfailed to stack channel \"%s\"", Tcl_GetChannelName(chan));
- Tcl_DecrRefCount(dataPtr->command);
- ResultClear(&dataPtr->result);
- ckfree(dataPtr);
+ ReleaseData(dataPtr);
return TCL_ERROR;
}
@@ -296,9 +322,11 @@ TclChannelTransform(
* At last initialize the transformation at the script level.
*/
+ PreserveData(dataPtr);
if ((dataPtr->mode & TCL_WRITABLE) && ExecuteCallback(dataPtr, NULL,
A_CREATE_WRITE, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE) != TCL_OK){
Tcl_UnstackChannel(interp, chan);
+ ReleaseData(dataPtr);
return TCL_ERROR;
}
@@ -307,9 +335,11 @@ TclChannelTransform(
ExecuteCallback(dataPtr, NULL, A_DELETE_WRITE, NULL, 0, TRANSMIT_DONT,
P_NO_PRESERVE);
Tcl_UnstackChannel(interp, chan);
+ ReleaseData(dataPtr);
return TCL_ERROR;
}
+ ReleaseData(dataPtr);
return TCL_OK;
}
@@ -350,7 +380,10 @@ ExecuteCallback(
unsigned char *resBuf;
Tcl_InterpState state = NULL;
int res = TCL_OK;
- Tcl_Obj *command = Tcl_DuplicateObj(dataPtr->command);
+ Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command);
+ Tcl_Interp *eval = dataPtr->interp;
+
+ Tcl_Preserve(eval);
/*
* Step 1, create the complete command to execute. Do this by appending
@@ -361,26 +394,18 @@ ExecuteCallback(
*/
if (preserve == P_PRESERVE) {
- state = Tcl_SaveInterpState(dataPtr->interp, res);
+ state = Tcl_SaveInterpState(eval, res);
}
Tcl_IncrRefCount(command);
- res = Tcl_ListObjAppendElement(dataPtr->interp, command,
- Tcl_NewStringObj((char *) op, -1));
- if (res != TCL_OK) {
- goto cleanup;
- }
+ Tcl_ListObjAppendElement(NULL, command, Tcl_NewStringObj((char *) op, -1));
/*
* Use a byte-array to prevent the misinterpretation of binary data coming
* through as UTF while at the tcl level.
*/
- res = Tcl_ListObjAppendElement(dataPtr->interp, command,
- Tcl_NewByteArrayObj(buf, bufLen));
- if (res != TCL_OK) {
- goto cleanup;
- }
+ Tcl_ListObjAppendElement(NULL, command, Tcl_NewByteArrayObj(buf, bufLen));
/*
* Step 2, execute the command at the global level of the interpreter used
@@ -390,13 +415,14 @@ ExecuteCallback(
* current interpreter. Don't copy if in preservation mode.
*/
- res = Tcl_EvalObjEx(dataPtr->interp, command, TCL_EVAL_GLOBAL);
+ res = Tcl_EvalObjEx(eval, command, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(command);
command = NULL;
- if ((res != TCL_OK) && (interp != NULL) && (dataPtr->interp != interp)
+ if ((res != TCL_OK) && (interp != NULL) && (eval != interp)
&& (preserve == P_NO_PRESERVE)) {
- Tcl_SetObjResult(interp, Tcl_GetObjResult(dataPtr->interp));
+ Tcl_SetObjResult(interp, Tcl_GetObjResult(eval));
+ Tcl_Release(eval);
return res;
}
@@ -411,20 +437,20 @@ ExecuteCallback(
break;
case TRANSMIT_DOWN:
- resObj = Tcl_GetObjResult(dataPtr->interp);
+ resObj = Tcl_GetObjResult(eval);
resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf,
resLen);
break;
case TRANSMIT_SELF:
- resObj = Tcl_GetObjResult(dataPtr->interp);
+ resObj = Tcl_GetObjResult(eval);
resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen);
break;
case TRANSMIT_IBUF:
- resObj = Tcl_GetObjResult(dataPtr->interp);
+ resObj = Tcl_GetObjResult(eval);
resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
ResultAdd(&dataPtr->result, resBuf, resLen);
break;
@@ -434,24 +460,16 @@ ExecuteCallback(
* Interpret result as integer number.
*/
- resObj = Tcl_GetObjResult(dataPtr->interp);
- TclGetIntFromObj(dataPtr->interp, resObj, &dataPtr->maxRead);
+ resObj = Tcl_GetObjResult(eval);
+ TclGetIntFromObj(eval, resObj, &dataPtr->maxRead);
break;
}
- Tcl_ResetResult(dataPtr->interp);
- if (preserve == P_PRESERVE) {
- (void) Tcl_RestoreInterpState(dataPtr->interp, state);
- }
- return res;
-
- cleanup:
+ Tcl_ResetResult(eval);
if (preserve == P_PRESERVE) {
- (void) Tcl_RestoreInterpState(dataPtr->interp, state);
- }
- if (command != NULL) {
- Tcl_DecrRefCount(command);
+ (void) Tcl_RestoreInterpState(eval, state);
}
+ Tcl_Release(eval);
return res;
}
@@ -535,6 +553,7 @@ TransformCloseProc(
* system rely on (f.e. signaling the close to interested parties).
*/
+ PreserveData(dataPtr);
if (dataPtr->mode & TCL_WRITABLE) {
ExecuteCallback(dataPtr, interp, A_FLUSH_WRITE, NULL, 0,
TRANSMIT_DOWN, P_PRESERVE);
@@ -554,14 +573,13 @@ TransformCloseProc(
ExecuteCallback(dataPtr, interp, A_DELETE_READ, NULL, 0,
TRANSMIT_DONT, P_PRESERVE);
}
+ ReleaseData(dataPtr);
/*
* General cleanup.
*/
- ResultClear(&dataPtr->result);
- Tcl_DecrRefCount(dataPtr->command);
- ckfree(dataPtr);
+ ReleaseData(dataPtr);
return TCL_OK;
}
@@ -606,6 +624,7 @@ TransformInputProc(
gotBytes = 0;
downChan = Tcl_GetStackedChannel(dataPtr->self);
+ PreserveData(dataPtr);
while (toRead > 0) {
/*
* Loop until the request is satisfied (or no data is available from
@@ -623,7 +642,7 @@ TransformInputProc(
* break out of the loop and return to the caller.
*/
- return gotBytes;
+ break;
}
/*
@@ -647,7 +666,7 @@ TransformInputProc(
}
} /* else: 'maxRead < 0' == Accept the current value of toRead. */
if (toRead <= 0) {
- return gotBytes;
+ break;
}
/*
@@ -661,13 +680,15 @@ 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)) {
- return gotBytes;
+ if ((error == EAGAIN) && (gotBytes > 0)) {
+ break;
}
- *errorCodePtr = Tcl_GetErrno();
- return -1;
+ *errorCodePtr = error;
+ gotBytes = -1;
+ break;
} else if (read == 0) {
/*
* Check wether we hit on EOF in the underlying channel or not. If
@@ -682,9 +703,9 @@ TransformInputProc(
if (!Tcl_Eof(downChan)) {
if ((gotBytes == 0) && (dataPtr->flags & CHANNEL_ASYNC)) {
*errorCodePtr = EWOULDBLOCK;
- return -1;
+ gotBytes = -1;
}
- return gotBytes;
+ break;
}
if (dataPtr->readIsFlushed) {
@@ -692,7 +713,7 @@ TransformInputProc(
* Already flushed, nothing to do anymore.
*/
- return gotBytes;
+ break;
}
dataPtr->readIsFlushed = 1;
@@ -704,7 +725,7 @@ TransformInputProc(
* We had nothing to flush.
*/
- return gotBytes;
+ break;
}
continue; /* at: while (toRead > 0) */
@@ -718,9 +739,11 @@ TransformInputProc(
if (ExecuteCallback(dataPtr, NULL, A_READ, UCHARP(buf), read,
TRANSMIT_IBUF, P_PRESERVE) != TCL_OK) {
*errorCodePtr = EINVAL;
- return -1;
+ gotBytes = -1;
+ break;
}
} /* while toRead > 0 */
+ ReleaseData(dataPtr);
return gotBytes;
}
@@ -762,11 +785,13 @@ TransformOutputProc(
return 0;
}
+ PreserveData(dataPtr);
if (ExecuteCallback(dataPtr, NULL, A_WRITE, UCHARP(buf), toWrite,
TRANSMIT_DOWN, P_NO_PRESERVE) != TCL_OK) {
*errorCodePtr = EINVAL;
- return -1;
+ toWrite = -1;
}
+ ReleaseData(dataPtr);
return toWrite;
}
@@ -819,6 +844,7 @@ TransformSeekProc(
* request down, unchanged.
*/
+ PreserveData(dataPtr);
if (dataPtr->mode & TCL_WRITABLE) {
ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
P_NO_PRESERVE);
@@ -830,6 +856,7 @@ TransformSeekProc(
ResultClear(&dataPtr->result);
dataPtr->readIsFlushed = 0;
}
+ ReleaseData(dataPtr);
return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, mode,
errorCodePtr);
@@ -890,6 +917,7 @@ TransformWideSeekProc(
* request down, unchanged.
*/
+ PreserveData(dataPtr);
if (dataPtr->mode & TCL_WRITABLE) {
ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
P_NO_PRESERVE);
@@ -901,6 +929,7 @@ TransformWideSeekProc(
ResultClear(&dataPtr->result);
dataPtr->readIsFlushed = 0;
}
+ ReleaseData(dataPtr);
/*
* If we have a wide seek capability, we should stick with that.
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index cb0282a..94428bb 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -99,31 +99,9 @@ typedef struct {
Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */
Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */
#endif
-
- /* See [==] as well.
- * Storage for the command prefix and the additional words required for
- * the invocation of methods in the command handler.
- *
- * argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2]
- * cmd ... pfx | method chan | detail1 detail2
- * ~~~~ CT ~~~ ~~ CT ~~
- *
- * CT = Belongs to the 'Command handler Thread'.
- */
-
- int argc; /* Number of preallocated words - 2 */
- Tcl_Obj **argv; /* Preallocated array for calling the handler.
- * args[0] is placeholder for cmd word.
- * Followed by the arguments in the prefix,
- * plus 4 placeholders for method, channel,
- * and at most two varying (method specific)
- * words. */
- int methods; /* Bitmask of supported methods */
-
- /*
- * NOTE (9): Should we have predefined shared literals for the method
- * names?
- */
+ Tcl_Obj *cmd; /* Callback command prefix */
+ Tcl_Obj *methods; /* Methods to append to command prefix */
+ Tcl_Obj *name; /* Name of the channel as created */
int mode; /* Mask of R/W mode */
int interest; /* Mask of events the channel is interested
@@ -450,9 +428,8 @@ static ReflectedChannel * NewReflectedChannel(Tcl_Interp *interp,
Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj);
static Tcl_Obj * NextHandle(void);
static void FreeReflectedChannel(ReflectedChannel *rcPtr);
-static void FreeReflectedChannelArgs(ReflectedChannel *rcPtr);
static int InvokeTclMethod(ReflectedChannel *rcPtr,
- const char *method, Tcl_Obj *argOneObj,
+ MethodName method, Tcl_Obj *argOneObj,
Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);
static ReflectedChannelMap * GetReflectedChannelMap(Tcl_Interp *interp);
@@ -467,9 +444,7 @@ static int ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj *resObj);
* list-quoting to keep the words of the message together. See also [x].
*/
-static const char *msg_read_unsup = "{read not supported by Tcl driver}";
static const char *msg_read_toomuch = "{read delivered more than requested}";
-static const char *msg_write_unsup = "{write not supported by Tcl driver}";
static const char *msg_write_toomuch = "{write wrote more than requested}";
static const char *msg_write_nothing = "{write wrote nothing}";
static const char *msg_seek_beforestart = "{Tried to seek before origin}";
@@ -583,10 +558,6 @@ TclChanCreateObjCmd(
rcId = NextHandle();
rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId);
- chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr,
- mode);
- rcPtr->chan = chan;
- chanPtr = (Channel *) chan;
/*
* Invoke 'initialize' and validate that the handler is present and ok.
@@ -600,7 +571,7 @@ TclChanCreateObjCmd(
modeObj = DecodeEventMask(mode);
/* assert modeObj.refCount == 1 */
- result = InvokeTclMethod(rcPtr, "initialize", modeObj, NULL, &resObj);
+ result = InvokeTclMethod(rcPtr, METH_INIT, modeObj, NULL, &resObj);
Tcl_DecrRefCount(modeObj);
if (result != TCL_OK) {
@@ -683,7 +654,11 @@ TclChanCreateObjCmd(
* Everything is fine now.
*/
- rcPtr->methods = methods;
+ chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr,
+ mode);
+ rcPtr->chan = chan;
+ Tcl_Preserve(chan);
+ chanPtr = (Channel *) chan;
if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) {
/*
@@ -744,12 +719,10 @@ TclChanCreateObjCmd(
return TCL_OK;
error:
- /*
- * Signal to ReflectClose to not call 'finalize'.
- */
-
- rcPtr->methods = 0;
- Tcl_Close(interp, chan);
+ Tcl_DecrRefCount(rcPtr->name);
+ Tcl_DecrRefCount(rcPtr->methods);
+ Tcl_DecrRefCount(rcPtr->cmd);
+ ckfree((char*) rcPtr);
return TCL_ERROR;
#undef MODE
@@ -1172,6 +1145,7 @@ ReflectClose(
if (result != TCL_OK) {
FreeReceivedError(&p);
}
+ return EOK;
}
#endif
@@ -1180,18 +1154,6 @@ ReflectClose(
}
/*
- * -- No -- ASSERT rcPtr->methods & FLAG(METH_FINAL)
- *
- * A cleaned method mask here implies that the channel creation was
- * aborted, and "finalize" must not be called.
- */
-
- if (rcPtr->methods == 0) {
- Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
- return EOK;
- }
-
- /*
* Are we in the correct thread?
*/
@@ -1208,14 +1170,12 @@ ReflectClose(
Tcl_DeleteEvents(ReflectEventDelete, rcPtr);
- Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
-
if (result != TCL_OK) {
PassReceivedErrorInterp(interp, &p);
}
} else {
#endif
- result = InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj);
+ result = InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj);
if ((result != TCL_OK) && (interp != NULL)) {
Tcl_SetChannelErrorInterp(interp, resObj);
}
@@ -1290,18 +1250,6 @@ ReflectInput(
Tcl_Obj *resObj; /* Result data for 'read' */
/*
- * The following check can be done before thread redirection, because we
- * are reading from an item which is readonly, i.e. will never change
- * during the lifetime of the channel.
- */
-
- if (!(rcPtr->methods & FLAG(METH_READ))) {
- SetChannelErrorStr(rcPtr->chan, msg_read_unsup);
- *errorCodePtr = EINVAL;
- return -1;
- }
-
- /*
* Are we in the correct thread?
*/
@@ -1339,7 +1287,7 @@ ReflectInput(
toReadObj = Tcl_NewIntObj(toRead);
Tcl_IncrRefCount(toReadObj);
- if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK) {
+ if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) {
int code = ErrnoReturn(rcPtr, resObj);
if (code < 0) {
@@ -1405,18 +1353,6 @@ ReflectOutput(
int written;
/*
- * The following check can be done before thread redirection, because we
- * are reading from an item which is readonly, i.e. will never change
- * during the lifetime of the channel.
- */
-
- if (!(rcPtr->methods & FLAG(METH_WRITE))) {
- SetChannelErrorStr(rcPtr->chan, msg_write_unsup);
- *errorCodePtr = EINVAL;
- return -1;
- }
-
- /*
* Are we in the correct thread?
*/
@@ -1454,7 +1390,7 @@ ReflectOutput(
bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
Tcl_IncrRefCount(bufObj);
- if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
+ if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) {
int code = ErrnoReturn(rcPtr, resObj);
if (code < 0) {
@@ -1568,7 +1504,7 @@ ReflectSeekWide(
Tcl_IncrRefCount(offObj);
Tcl_IncrRefCount(baseObj);
- if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj) != TCL_OK) {
+ if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK) {
Tcl_SetChannelError(rcPtr->chan, resObj);
goto invalid;
}
@@ -1639,8 +1575,6 @@ ReflectWatch(
ReflectedChannel *rcPtr = clientData;
Tcl_Obj *maskObj;
- /* ASSERT rcPtr->methods & FLAG(METH_WATCH) */
-
/*
* We restrict the interest to what the channel can support. IOW there
* will never be write events for a channel which is not writable.
@@ -1683,7 +1617,7 @@ ReflectWatch(
maskObj = DecodeEventMask(mask);
/* assert maskObj.refCount == 1 */
- (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL);
+ (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL);
Tcl_DecrRefCount(maskObj);
Tcl_Release(rcPtr);
@@ -1742,7 +1676,7 @@ ReflectBlock(
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL, &resObj)!=TCL_OK) {
+ if (InvokeTclMethod(rcPtr,METH_BLOCKING,blockObj,NULL,&resObj)!=TCL_OK) {
Tcl_SetChannelError(rcPtr->chan, resObj);
errorNum = EINVAL;
} else {
@@ -1854,7 +1788,7 @@ ReflectSetOption(
Tcl_IncrRefCount(optionObj);
Tcl_IncrRefCount(valueObj);
- result = InvokeTclMethod(rcPtr, "configure",optionObj,valueObj, &resObj);
+ result = InvokeTclMethod(rcPtr, METH_CONFIGURE,optionObj,valueObj, &resObj);
if (result != TCL_OK) {
UnmarshallErrorResult(interp, resObj);
}
@@ -1899,7 +1833,7 @@ ReflectGetOption(
Tcl_Obj *resObj; /* Result data for 'configure' */
int listc, result = TCL_OK;
Tcl_Obj **listv;
- const char *method;
+ MethodName method;
/*
* Are we in the correct thread?
@@ -1938,14 +1872,14 @@ ReflectGetOption(
* Retrieve all options.
*/
- method = "cgetall";
+ method = METH_CGETALL;
optionObj = NULL;
} else {
/*
* Retrieve the value of one option.
*/
- method = "cget";
+ method = METH_CGET;
optionObj = Tcl_NewStringObj(optionName, -1);
Tcl_IncrRefCount(optionObj);
}
@@ -2159,16 +2093,13 @@ NewReflectedChannel(
Tcl_Obj *handleObj)
{
ReflectedChannel *rcPtr;
- int i, listc;
- Tcl_Obj **listv;
+ MethodName mn = METH_BLOCKING;
rcPtr = ckalloc(sizeof(ReflectedChannel));
/* rcPtr->chan: Assigned by caller. Dummy data here. */
- /* rcPtr->methods: Assigned by caller. Dummy data here. */
rcPtr->chan = NULL;
- rcPtr->methods = 0;
rcPtr->interp = interp;
rcPtr->dead = 0;
#ifdef TCL_THREADS
@@ -2177,54 +2108,17 @@ NewReflectedChannel(
rcPtr->mode = mode;
rcPtr->interest = 0; /* Initially no interest registered */
- /*
- * Method placeholder.
- */
-
/* ASSERT: cmdpfxObj is a Tcl List */
-
- Tcl_ListObjGetElements(interp, cmdpfxObj, &listc, &listv);
-
- /*
- * See [==] as well.
- * Storage for the command prefix and the additional words required for
- * the invocation of methods in the command handler.
- *
- * listv [0] [listc-1] | [listc] [listc+1] |
- * argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2]
- * cmd ... pfx | method chan | detail1 detail2
- */
-
- rcPtr->argc = listc + 2;
- rcPtr->argv = ckalloc(sizeof(Tcl_Obj *) * (listc+4));
-
- /*
- * Duplicate object references.
- */
-
- for (i=0; i<listc ; i++) {
- Tcl_Obj *word = rcPtr->argv[i] = listv[i];
-
- Tcl_IncrRefCount(word);
- }
-
- i++; /* Skip placeholder for method */
-
- /*
- * [Bug 1667990]: See [x] in FreeReflectedChannel for release
- */
-
- rcPtr->argv[i] = handleObj;
- Tcl_IncrRefCount(handleObj);
-
- /*
- * The next two objects are kept empty, varying arguments.
- */
-
- /*
- * Initialization complete.
- */
-
+ rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
+ Tcl_IncrRefCount(rcPtr->cmd);
+ rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL);
+ while (mn <= METH_WRITE) {
+ Tcl_ListObjAppendElement(NULL, rcPtr->methods,
+ Tcl_NewStringObj(methodNames[mn++], -1));
+ }
+ Tcl_IncrRefCount(rcPtr->methods);
+ rcPtr->name = handleObj;
+ Tcl_IncrRefCount(rcPtr->name);
return rcPtr;
}
@@ -2271,28 +2165,6 @@ NextHandle(void)
}
static void
-FreeReflectedChannelArgs(
- ReflectedChannel *rcPtr)
-{
- int i, n = rcPtr->argc - 2;
-
- if (n < 0) {
- return;
- }
- for (i=0; i<n; i++) {
- Tcl_DecrRefCount(rcPtr->argv[i]);
- }
-
- /*
- * [Bug 1667990]: See [x] in NewReflectedChannel for lock. n+1 = argc-1.
- */
-
- Tcl_DecrRefCount(rcPtr->argv[n+1]);
-
- rcPtr->argc = 1;
-}
-
-static void
FreeReflectedChannel(
ReflectedChannel *rcPtr)
{
@@ -2306,10 +2178,10 @@ FreeReflectedChannel(
ckfree(chanPtr->typePtr);
chanPtr->typePtr = NULL;
}
-
- FreeReflectedChannelArgs(rcPtr);
-
- ckfree(rcPtr->argv);
+ Tcl_Release(chanPtr);
+ Tcl_DecrRefCount(rcPtr->name);
+ Tcl_DecrRefCount(rcPtr->methods);
+ Tcl_DecrRefCount(rcPtr->cmd);
ckfree(rcPtr);
}
@@ -2340,16 +2212,16 @@ FreeReflectedChannel(
static int
InvokeTclMethod(
ReflectedChannel *rcPtr,
- const char *method,
+ MethodName method,
Tcl_Obj *argOneObj, /* NULL'able */
Tcl_Obj *argTwoObj, /* NULL'able */
Tcl_Obj **resultObjPtr) /* NULL'able */
{
- int cmdc; /* #words in constructed command */
Tcl_Obj *methObj = NULL; /* Method name in object form */
Tcl_InterpState sr; /* State of handler interp */
int result; /* Result code of method invokation */
Tcl_Obj *resObj = NULL; /* Result of method invokation. */
+ Tcl_Obj *cmd;
if (rcPtr->dead) {
/*
@@ -2372,19 +2244,15 @@ InvokeTclMethod(
}
/*
- * NOTE (5): Decide impl. issue: Cache objects with method names? Needs
- * TSD data as reflections can be created in many different threads.
- * NO: Caching of command resolutions means storage per channel.
- */
-
- /*
- * Insert method into the pre-allocated area, after the command prefix,
+ * Insert method into the callback command, after the command prefix,
* before the channel id.
*/
- methObj = Tcl_NewStringObj(method, -1);
- Tcl_IncrRefCount(methObj);
- rcPtr->argv[rcPtr->argc - 2] = methObj;
+ cmd = TclListObjCopy(NULL, rcPtr->cmd);
+
+ Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj);
+ Tcl_ListObjAppendElement(NULL, cmd, methObj);
+ Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name);
/*
* Append the additional argument containing method specific details
@@ -2394,13 +2262,10 @@ InvokeTclMethod(
* The objects will survive the Tcl_EvalObjv without change.
*/
- cmdc = rcPtr->argc;
if (argOneObj) {
- rcPtr->argv[cmdc] = argOneObj;
- cmdc++;
+ Tcl_ListObjAppendElement(NULL, cmd, argOneObj);
if (argTwoObj) {
- rcPtr->argv[cmdc] = argTwoObj;
- cmdc++;
+ Tcl_ListObjAppendElement(NULL, cmd, argTwoObj);
}
}
@@ -2409,9 +2274,10 @@ InvokeTclMethod(
* existing state intact.
*/
+ Tcl_IncrRefCount(cmd);
sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
Tcl_Preserve(rcPtr->interp);
- result = Tcl_EvalObjv(rcPtr->interp, cmdc, rcPtr->argv, TCL_EVAL_GLOBAL);
+ result = Tcl_EvalObjEx(rcPtr->interp, cmd, TCL_EVAL_GLOBAL);
/*
* We do not try to extract the result information if the caller has no
@@ -2437,7 +2303,6 @@ InvokeTclMethod(
*/
if (result != TCL_ERROR) {
- Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rcPtr->argv);
int cmdLen;
const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);
@@ -2451,25 +2316,17 @@ InvokeTclMethod(
result = TCL_ERROR;
}
Tcl_AppendObjToErrorInfo(rcPtr->interp, Tcl_ObjPrintf(
- "\n (chan handler subcommand \"%s\")", method));
+ "\n (chan handler subcommand \"%s\")",
+ methodNames[method]));
resObj = MarshallError(rcPtr->interp);
}
Tcl_IncrRefCount(resObj);
}
+ Tcl_DecrRefCount(cmd);
Tcl_RestoreInterpState(rcPtr->interp, sr);
Tcl_Release(rcPtr->interp);
/*
- * Cleanup of the dynamic parts of the command.
- *
- * The detail objects survived the Tcl_EvalObjv without change because of
- * the contract. Therefore there is no need to decrement the refcounts. Only
- * the internal method object has to be disposed of.
- */
-
- Tcl_DecrRefCount(methObj);
-
- /*
* The resObj has a ref count of 1 at this location. This means that the
* caller of InvokeTclMethod has to dispose of it (but only if it was
* returned to it).
@@ -2700,7 +2557,6 @@ DeleteReflectedChannelMap(
}
rcPtr->dead = 1;
- FreeReflectedChannelArgs(rcPtr);
Tcl_DeleteHashEntry(hPtr);
}
#endif
@@ -2840,7 +2696,6 @@ DeleteThreadReflectedChannelMap(
ReflectedChannel *rcPtr = Tcl_GetChannelInstanceData(chan);
rcPtr->dead = 1;
- FreeReflectedChannelArgs(rcPtr);
Tcl_DeleteHashEntry(hPtr);
}
ckfree(rcmPtr);
@@ -3023,12 +2878,12 @@ ForwardProc(
* No parameters/results.
*/
- if (InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj)!=TCL_OK) {
+ if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
}
/*
- * Freeing is done here, in the origin thread, because the argv[]
+ * Freeing is done here, in the origin thread, callback command
* objects belong to this thread. Deallocating them in a different
* thread is not allowed
*
@@ -3047,7 +2902,7 @@ ForwardProc(
Tcl_GetChannelName(rcPtr->chan));
Tcl_DeleteHashEntry(hPtr);
- FreeReflectedChannelArgs(rcPtr);
+ Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
break;
case ForwardedInput: {
@@ -3055,7 +2910,7 @@ ForwardProc(
Tcl_IncrRefCount(toReadObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK){
+ if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){
int code = ErrnoReturn(rcPtr, resObj);
if (code < 0) {
@@ -3095,7 +2950,7 @@ ForwardProc(
Tcl_IncrRefCount(bufObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
+ if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) {
int code = ErrnoReturn(rcPtr, resObj);
if (code < 0) {
@@ -3138,7 +2993,7 @@ ForwardProc(
Tcl_IncrRefCount(baseObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj)!=TCL_OK){
+ if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK){
ForwardSetObjError(paramPtr, resObj);
paramPtr->seek.offset = -1;
} else {
@@ -3174,7 +3029,7 @@ ForwardProc(
/* assert maskObj.refCount == 1 */
Tcl_Preserve(rcPtr);
- (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL);
+ (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL);
Tcl_DecrRefCount(maskObj);
Tcl_Release(rcPtr);
break;
@@ -3185,7 +3040,7 @@ ForwardProc(
Tcl_IncrRefCount(blockObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL,
+ if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL,
&resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
}
@@ -3201,7 +3056,7 @@ ForwardProc(
Tcl_IncrRefCount(optionObj);
Tcl_IncrRefCount(valueObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "configure", optionObj, valueObj,
+ if (InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj,
&resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
}
@@ -3220,7 +3075,7 @@ ForwardProc(
Tcl_IncrRefCount(optionObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj)!=TCL_OK){
+ if (InvokeTclMethod(rcPtr, METH_CGET, optionObj, NULL, &resObj)!=TCL_OK){
ForwardSetObjError(paramPtr, resObj);
} else {
TclDStringAppendObj(paramPtr->getOpt.value, resObj);
@@ -3236,7 +3091,7 @@ ForwardProc(
*/
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "cgetall", NULL, NULL, &resObj) != TCL_OK){
+ if (InvokeTclMethod(rcPtr, METH_CGETALL, NULL, NULL, &resObj) != TCL_OK){
ForwardSetObjError(paramPtr, resObj);
} else {
/*
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index f523e8f..f624cb7 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -18,9 +18,8 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#include <sys/stat.h>
#include "tclInt.h"
-#ifdef __WIN32__
+#ifdef _WIN32
# include "tclWinInt.h"
#endif
#include "tclFileSystem.h"
@@ -793,7 +792,7 @@ TclFinalizeFilesystem(void)
* filesystem is likely to fail.
*/
-#ifdef __WIN32__
+#ifdef _WIN32
TclWinEncodingsCleanup();
#endif
}
@@ -820,7 +819,7 @@ TclResetFilesystem(void)
filesystemList = &nativeFilesystemRecord;
theFilesystemEpoch++;
-#ifdef __WIN32__
+#ifdef _WIN32
/*
* Cleans up the win32 API filesystem proc lookup table. This must happen
* very late in finalization so that deleting of copied dlls can occur.
@@ -3226,6 +3225,9 @@ Tcl_LoadFile(
*/
copyToPtr = TclpTempFileNameForLibrary(interp, pathPtr);
+ if (copyToPtr == NULL) {
+ return TCL_ERROR;
+ }
Tcl_IncrRefCount(copyToPtr);
copyFsPtr = Tcl_FSGetFileSystemForPath(copyToPtr);
@@ -3253,7 +3255,7 @@ Tcl_LoadFile(
return TCL_ERROR;
}
-#ifndef __WIN32__
+#ifndef _WIN32
/*
* Do we need to set appropriate permissions on the file? This may be
* required on some systems. On Unix we could loop over the file
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 512f5ba..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;
}
@@ -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 58dab42..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)
@@ -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 18768d9..7b1f5bf 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
@@ -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,8 @@ typedef struct Command {
#define CMD_IS_DELETED 0x1
#define CMD_TRACE_ACTIVE 0x2
#define CMD_HAS_EXEC_TRACES 0x4
+#define CMD_COMPILES_EXPANDED 0x8
+#define CMD_REDEF_IN_PROGRESS 0x10
/*
*----------------------------------------------------------------
@@ -1847,7 +1810,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 +2172,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,9 +2206,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_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:
@@ -2317,35 +2277,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.
@@ -2709,6 +2640,8 @@ MODULE_SCOPE char *tclMemDumpFileName;
MODULE_SCOPE TclPlatformType tclPlatform;
MODULE_SCOPE Tcl_NotifierProcs tclNotifierHooks;
+MODULE_SCOPE Tcl_Encoding tclIdentityEncoding;
+
/*
* TIP #233 (Virtualized Time)
* Data for the time hooks, if any.
@@ -2735,7 +2668,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;
@@ -2803,6 +2736,7 @@ 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 void TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr);
MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp);
@@ -2894,7 +2828,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,
@@ -2962,6 +2896,7 @@ MODULE_SCOPE void TclFinalizeObjects(void);
MODULE_SCOPE void TclFinalizePreserve(void);
MODULE_SCOPE void TclFinalizeSynchronization(void);
MODULE_SCOPE void TclFinalizeThreadAlloc(void);
+MODULE_SCOPE void TclFinalizeThreadAllocThread(void);
MODULE_SCOPE void TclFinalizeThreadData(void);
MODULE_SCOPE void TclFinalizeThreadObjects(void);
MODULE_SCOPE double TclFloor(const mp_int *a);
@@ -2985,7 +2920,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);
@@ -3134,6 +3070,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);
@@ -3162,6 +3099,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,
@@ -3508,6 +3446,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);
@@ -3607,6 +3548,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);
@@ -3631,6 +3575,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);
@@ -3646,6 +3593,12 @@ MODULE_SCOPE int TclCompileNamespaceWhichCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileNoOp(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileObjectNextCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileObjectNextToCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileObjectSelfCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3673,6 +3626,9 @@ MODULE_SCOPE int TclCompileStringFirstCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileStringIndexCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringIsCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileStringLastCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3688,6 +3644,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);
@@ -3718,6 +3695,9 @@ 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 TclCompileYieldToCmd(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);
@@ -3931,6 +3911,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.
@@ -4088,7 +4070,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)
@@ -4101,7 +4083,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; \
} \
@@ -4129,14 +4111,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)
@@ -4471,7 +4453,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
*----------------------------------------------------------------
*/
-#define TclSetIntObj(objPtr, i) \
+#define TclSetLongObj(objPtr, i) \
do { \
TclInvalidateStringRep(objPtr); \
TclFreeIntRep(objPtr); \
@@ -4479,8 +4461,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
@@ -4490,9 +4472,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); \
@@ -4528,7 +4510,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
*/
#ifndef TCL_MEM_DEBUG
-#define TclNewIntObj(objPtr, i) \
+#define TclNewLongObj(objPtr, i) \
do { \
TclIncrObjsAllocated(); \
TclAllocObjStorage(objPtr); \
@@ -4539,15 +4521,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 { \
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 092225e..f95f999 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -52,6 +52,10 @@
/* !BEGIN!: Do not edit below this line. */
+#ifdef __cplusplus
+extern "C" {
+#endif
+
/*
* Exported function declarations:
*/
@@ -396,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,
@@ -415,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);
@@ -606,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;
@@ -769,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 */
@@ -778,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 */
@@ -862,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
@@ -1135,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 */
@@ -1150,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 \
@@ -1289,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) */
@@ -1297,6 +1313,10 @@ 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)
@@ -1344,4 +1364,7 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclStubsPtr->tcl_GetCommandFullName) /* 517 */
#endif
+#undef TclCopyChannelOld
+#undef TclSockMinimumBuffersOld
+
#endif /* _TCLINTDECLS */
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index dcf1753..ac06787 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -13,7 +13,7 @@
#ifndef _TCLINTPLATDECLS
#define _TCLINTPLATDECLS
-#ifdef __WIN32__
+#ifdef _WIN32
# define Tcl_DirEntry void
# define DIR void
#endif
@@ -37,11 +37,15 @@
/* !BEGIN!: Do not edit below this line. */
+#ifdef __cplusplus
+extern "C" {
+#endif
+
/*
* Exported function declarations:
*/
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
/* 0 */
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
Tcl_Channel chan);
@@ -100,7 +104,7 @@ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
Tcl_Obj *resultingNameObj);
#endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
EXTERN void TclWinConvertError(DWORD errCode);
/* 1 */
@@ -254,7 +258,7 @@ typedef struct TclIntPlatStubs {
int magic;
void *hooks;
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
int (*tclpCloseFile) (TclFile file); /* 1 */
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
@@ -287,7 +291,7 @@ typedef struct TclIntPlatStubs {
int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
void (*tclWinConvertError) (DWORD errCode); /* 0 */
void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */
struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */
@@ -355,10 +359,8 @@ typedef struct TclIntPlatStubs {
#endif /* MACOSX */
} TclIntPlatStubs;
-#ifdef __cplusplus
-extern "C" {
-#endif
extern const TclIntPlatStubs *tclIntPlatStubsPtr;
+
#ifdef __cplusplus
}
#endif
@@ -369,7 +371,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
* Inline function declarations:
*/
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
#define TclGetAndDetachPids \
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
#define TclpCloseFile \
@@ -418,7 +420,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#define TclUnixOpenTemporaryFile \
(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
#define TclWinConvertError \
(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
#define TclWinConvertWSAError \
@@ -545,10 +547,18 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#undef TclpGmtime_unix
#undef TclWinConvertWSAError
#define TclWinConvertWSAError TclWinConvertError
+#undef TclpInetNtoa
+#define TclpInetNtoa inet_ntoa
-#if defined(__WIN32__) || defined(__CYGWIN__)
+#if defined(_WIN32)
# undef TclWinNToHS
+# undef TclWinGetServByName
+# undef TclWinGetSockOpt
+# undef TclWinSetSockOpt
# define TclWinNToHS ntohs
+# define TclWinGetServByName getservbyname
+# define TclWinGetSockOpt getsockopt
+# define TclWinSetSockOpt setsockopt
#else
# undef TclpGetPid
# define TclpGetPid(pid) ((unsigned long) (pid))
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index d5d43ed..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[] = {
@@ -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/tclLoad.c b/generic/tclLoad.c
index 5cacab1..7c70e03 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -830,7 +830,7 @@ Tcl_UnloadObjCmd(
* Unload the shared library from the application memory...
*/
-#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__)
+#if defined(TCL_UNLOAD_DLLS) || defined(_WIN32)
/*
* Some Unix dlls are poorly behaved - registering things like atexit
* calls that can't be unregistered. If you unload such dlls, you get
@@ -1151,7 +1151,7 @@ TclFinalizeLoad(void)
pkgPtr = firstPackagePtr;
firstPackagePtr = pkgPtr->nextPtr;
-#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__)
+#if defined(TCL_UNLOAD_DLLS) || defined(_WIN32)
/*
* Some Unix dlls are poorly behaved - registering things like atexit
* calls that can't be unregistered. If you unload such dlls, you get
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..360f5e9 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -47,7 +47,7 @@
* we have to translate that to strcmp here.
*/
-#ifndef __WIN32__
+#ifndef _WIN32
# define TCHAR char
# define TEXT(arg) arg
# define _tcscmp strcmp
@@ -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 304487b..8f2f10e 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -171,7 +171,7 @@ static const EnsembleImplMap defaultNamespaceMap[] = {
{"forget", NamespaceForgetCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
{"import", NamespaceImportCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
{"inscope", NamespaceInscopeCmd, NULL, NRNamespaceInscopeCmd, NULL, 0},
- {"origin", NamespaceOriginCmd, TclCompileBasic1ArgCmd, 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},
@@ -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) {
@@ -1946,7 +1977,7 @@ InvokeImportedNRCmd(
Command *realCmdPtr = dataPtr->realCmdPtr;
TclSkipTailcall(interp);
- return Tcl_NRCmdSwap(interp, (Tcl_Command) realCmdPtr, objc, objv, 0);
+ 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 d6d2d6a..de00733 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);
}
@@ -437,10 +437,12 @@ InitFoundation(
* ensemble.
*/
- Tcl_CreateObjCommand(interp, "::oo::Helpers::next", TclOONextObjCmd, NULL,
- NULL);
- Tcl_CreateObjCommand(interp, "::oo::Helpers::nextto", TclOONextToObjCmd,
- NULL, NULL);
+ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::next",
+ NULL, TclOONextObjCmd, NULL, NULL);
+ cmdPtr->compileProc = TclCompileObjectNextCmd;
+ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::nextto",
+ NULL, TclOONextToObjCmd, NULL, NULL);
+ cmdPtr->compileProc = TclCompileObjectNextToCmd;
cmdPtr = (Command *) Tcl_CreateObjCommand(interp, "::oo::Helpers::self",
TclOOSelfObjCmd, NULL, NULL);
cmdPtr->compileProc = TclCompileObjectSelfCmd;
@@ -843,7 +845,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..265ba88 100644
--- a/generic/tclOO.decls
+++ b/generic/tclOO.decls
@@ -1,12 +1,24 @@
+# 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
+scspec TCLAPI
declare 0 {
Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
@@ -116,7 +128,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 0676618..0b0516b 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.
@@ -17,16 +17,11 @@
#include "tclOOInt.h"
static inline Tcl_Object *AddConstructionFinalizer(Tcl_Interp *interp);
-static int AfterNRDestructor(ClientData data[],
- Tcl_Interp *interp, int result);
-static int DecrRefsPostClassConstructor(ClientData data[],
- Tcl_Interp *interp, int result);
-static int FinalizeConstruction(ClientData data[],
- Tcl_Interp *interp, int result);
-static int FinalizeEval(ClientData data[],
- Tcl_Interp *interp, int result);
-static int RestoreFrame(ClientData data[],
- Tcl_Interp *interp, int result);
+static Tcl_NRPostProc AfterNRDestructor;
+static Tcl_NRPostProc DecrRefsPostClassConstructor;
+static Tcl_NRPostProc FinalizeConstruction;
+static Tcl_NRPostProc FinalizeEval;
+static Tcl_NRPostProc NextRestoreFrame;
/*
* ----------------------------------------------------------------------
@@ -88,7 +83,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,
@@ -102,6 +97,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];
@@ -115,7 +111,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
@@ -131,9 +127,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;
}
@@ -687,52 +686,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;
@@ -805,7 +803,7 @@ TclOONextObjCmd(
* that this is like [uplevel 1] and not [eval].
*/
- TclNRAddCallback(interp, RestoreFrame, framePtr, NULL, NULL, NULL);
+ TclNRAddCallback(interp, NextRestoreFrame, framePtr, NULL,NULL,NULL);
iPtr->varFramePtr = framePtr->callerVarPtr;
return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1);
}
@@ -823,6 +821,7 @@ TclOONextToObjCmd(
CallContext *contextPtr;
int i;
Tcl_Object object;
+ const char *methodType;
/*
* Start with sanity checks on the calling context to make sure that we
@@ -874,8 +873,8 @@ TclOONextToObjCmd(
* context. Note that this is like [uplevel 1] and not [eval].
*/
- TclNRAddCallback(interp, RestoreFrame, framePtr, contextPtr,
- INT2PTR(contextPtr->index), NULL);
+ TclNRAddCallback(interp, NextRestoreFrame, framePtr,
+ contextPtr, INT2PTR(contextPtr->index), NULL);
contextPtr->index = i-1;
iPtr->varFramePtr = framePtr->callerVarPtr;
return TclNRObjectContextInvokeNext(interp,
@@ -888,24 +887,35 @@ TclOONextToObjCmd(
* is on the chain but unreachable, or not on the chain at all.
*/
+ if (contextPtr->callPtr->flags & CONSTRUCTOR) {
+ methodType = "constructor";
+ } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
+ methodType = "destructor";
+ } else {
+ methodType = "method";
+ }
+
for (i=contextPtr->index ; i>=0 ; i--) {
struct MInvoke *miPtr = contextPtr->callPtr->chain + i;
if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "method implementation by \"%s\" not reachable from here",
- TclGetString(objv[1])));
+ "%s implementation by \"%s\" not reachable from here",
+ methodType, TclGetString(objv[1])));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE",
+ NULL);
return TCL_ERROR;
}
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "method has no non-filter implementation by \"%s\"",
- TclGetString(objv[1])));
+ "%s has no non-filter implementation by \"%s\"",
+ methodType, TclGetString(objv[1])));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", NULL);
return TCL_ERROR;
}
static int
-RestoreFrame(
+NextRestoreFrame(
ClientData data[],
Tcl_Interp *interp,
int result)
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..9fd62ec 100644
--- a/generic/tclOODecls.h
+++ b/generic/tclOODecls.h
@@ -5,99 +5,116 @@
#ifndef _TCLOODECLS
#define _TCLOODECLS
+#ifndef TCLAPI
+# ifdef BUILD_tcl
+# define TCLAPI extern DLLEXPORT
+# else
+# define TCLAPI extern DLLIMPORT
+# endif
+#endif
+
+#ifdef USE_TCL_STUBS
+# undef USE_TCLOO_STUBS
+# define USE_TCLOO_STUBS
+#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,
+TCLAPI 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);
+TCLAPI Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz);
/* 2 */
-TCLOOAPI Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object);
+TCLAPI Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object);
/* 3 */
-TCLOOAPI Tcl_Command Tcl_GetObjectCommand(Tcl_Object object);
+TCLAPI Tcl_Command Tcl_GetObjectCommand(Tcl_Object object);
/* 4 */
-TCLOOAPI Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp,
+TCLAPI Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr);
/* 5 */
-TCLOOAPI Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object);
+TCLAPI Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object);
/* 6 */
-TCLOOAPI Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method);
+TCLAPI Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method);
/* 7 */
-TCLOOAPI Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method);
+TCLAPI Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method);
/* 8 */
-TCLOOAPI int Tcl_MethodIsPublic(Tcl_Method method);
+TCLAPI int Tcl_MethodIsPublic(Tcl_Method method);
/* 9 */
-TCLOOAPI int Tcl_MethodIsType(Tcl_Method method,
+TCLAPI int Tcl_MethodIsType(Tcl_Method method,
const Tcl_MethodType *typePtr,
ClientData *clientDataPtr);
/* 10 */
-TCLOOAPI Tcl_Obj * Tcl_MethodName(Tcl_Method method);
+TCLAPI Tcl_Obj * Tcl_MethodName(Tcl_Method method);
/* 11 */
-TCLOOAPI Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp,
+TCLAPI 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,
+TCLAPI 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,
+TCLAPI 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);
+TCLAPI int Tcl_ObjectDeleted(Tcl_Object object);
/* 15 */
-TCLOOAPI int Tcl_ObjectContextIsFiltering(
+TCLAPI int Tcl_ObjectContextIsFiltering(
Tcl_ObjectContext context);
/* 16 */
-TCLOOAPI Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context);
+TCLAPI Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context);
/* 17 */
-TCLOOAPI Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context);
+TCLAPI Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context);
/* 18 */
-TCLOOAPI int Tcl_ObjectContextSkippedArgs(
+TCLAPI int Tcl_ObjectContextSkippedArgs(
Tcl_ObjectContext context);
/* 19 */
-TCLOOAPI ClientData Tcl_ClassGetMetadata(Tcl_Class clazz,
+TCLAPI ClientData Tcl_ClassGetMetadata(Tcl_Class clazz,
const Tcl_ObjectMetadataType *typePtr);
/* 20 */
-TCLOOAPI void Tcl_ClassSetMetadata(Tcl_Class clazz,
+TCLAPI void Tcl_ClassSetMetadata(Tcl_Class clazz,
const Tcl_ObjectMetadataType *typePtr,
ClientData metadata);
/* 21 */
-TCLOOAPI ClientData Tcl_ObjectGetMetadata(Tcl_Object object,
+TCLAPI ClientData Tcl_ObjectGetMetadata(Tcl_Object object,
const Tcl_ObjectMetadataType *typePtr);
/* 22 */
-TCLOOAPI void Tcl_ObjectSetMetadata(Tcl_Object object,
+TCLAPI void Tcl_ObjectSetMetadata(Tcl_Object object,
const Tcl_ObjectMetadataType *typePtr,
ClientData metadata);
/* 23 */
-TCLOOAPI int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
+TCLAPI int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
Tcl_ObjectContext context, int objc,
Tcl_Obj *const *objv, int skip);
/* 24 */
-TCLOOAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
+TCLAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
Tcl_Object object);
/* 25 */
-TCLOOAPI void Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
+TCLAPI void Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
Tcl_ObjectMapMethodNameProc *mapMethodNameProc);
/* 26 */
-TCLOOAPI void Tcl_ClassSetConstructor(Tcl_Interp *interp,
+TCLAPI void Tcl_ClassSetConstructor(Tcl_Interp *interp,
Tcl_Class clazz, Tcl_Method method);
/* 27 */
-TCLOOAPI void Tcl_ClassSetDestructor(Tcl_Interp *interp,
+TCLAPI void Tcl_ClassSetDestructor(Tcl_Interp *interp,
Tcl_Class clazz, Tcl_Method method);
/* 28 */
-TCLOOAPI Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp,
+TCLAPI 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,5 @@ extern const TclOOStubs *tclOOStubsPtr;
#endif /* defined(USE_TCLOO_STUBS) */
/* !END!: Do not edit above this line. */
+
#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/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..74a8d81 100644
--- a/generic/tclOOIntDecls.h
+++ b/generic/tclOOIntDecls.h
@@ -7,51 +7,55 @@
/* !BEGIN!: Do not edit below this line. */
+#ifdef __cplusplus
+extern "C" {
+#endif
+
/*
* Exported function declarations:
*/
/* 0 */
-TCLOOAPI Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp);
+TCLAPI Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp);
/* 1 */
-TCLOOAPI Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp,
+TCLAPI 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,
+TCLAPI 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,
+TCLAPI 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,
+TCLAPI 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,
+TCLAPI 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);
+TCLAPI int TclOOIsReachable(Class *targetPtr, Class *startPtr);
/* 7 */
-TCLOOAPI Method * TclOONewForwardMethod(Tcl_Interp *interp,
+TCLAPI Method * TclOONewForwardMethod(Tcl_Interp *interp,
Class *clsPtr, int isPublic,
Tcl_Obj *nameObj, Tcl_Obj *prefixObj);
/* 8 */
-TCLOOAPI Method * TclOONewForwardInstanceMethod(Tcl_Interp *interp,
+TCLAPI Method * TclOONewForwardInstanceMethod(Tcl_Interp *interp,
Object *oPtr, int isPublic, Tcl_Obj *nameObj,
Tcl_Obj *prefixObj);
/* 9 */
-TCLOOAPI Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
+TCLAPI Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
Tcl_Object oPtr,
TclOO_PreCallProc *preCallPtr,
TclOO_PostCallProc *postCallPtr,
@@ -60,7 +64,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,
+TCLAPI Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp,
Tcl_Class clsPtr,
TclOO_PreCallProc *preCallPtr,
TclOO_PostCallProc *postCallPtr,
@@ -69,22 +73,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,
+TCLAPI 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,
+TCLAPI void TclOOObjectSetFilters(Object *oPtr, int numFilters,
Tcl_Obj *const *filters);
/* 13 */
-TCLOOAPI void TclOOClassSetFilters(Tcl_Interp *interp,
+TCLAPI void TclOOClassSetFilters(Tcl_Interp *interp,
Class *classPtr, int numFilters,
Tcl_Obj *const *filters);
/* 14 */
-TCLOOAPI void TclOOObjectSetMixins(Object *oPtr, int numMixins,
+TCLAPI void TclOOObjectSetMixins(Object *oPtr, int numMixins,
Class *const *mixins);
/* 15 */
-TCLOOAPI void TclOOClassSetMixins(Tcl_Interp *interp,
+TCLAPI void TclOOClassSetMixins(Tcl_Interp *interp,
Class *classPtr, int numMixins,
Class *const *mixins);
@@ -110,10 +114,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 +162,5 @@ extern const TclOOIntStubs *tclOOIntStubsPtr;
#endif /* defined(USE_TCLOO_STUBS) */
/* !END!: Do not edit above this line. */
+
#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 921aced..a9fa212 100644
--- a/generic/tclOOStubLib.c
+++ b/generic/tclOOStubLib.c
@@ -27,6 +27,8 @@ const TclOOIntStubs *tclOOIntStubsPtr = NULL;
*----------------------------------------------------------------------
*/
+#undef TclOOInitializeStubs
+
MODULE_SCOPE const char *
TclOOInitializeStubs(
Tcl_Interp *interp,
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..fe6063f 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)
/*
@@ -512,7 +512,7 @@ TclFSGetPathType(
if (PATHFLAGS(pathPtr) == 0) {
/* The path is not absolute... */
-#ifdef __WIN32__
+#ifdef _WIN32
/* ... on Windows we must make another call to determine whether
* it's relative or volumerelative [Bug 2571597]. */
return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr,
@@ -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);
@@ -1956,7 +1956,7 @@ Tcl_FSGetNormalizedPath(
/*
* We have a refCount on the cwd.
*/
-#ifdef __WIN32__
+#ifdef _WIN32
} else if (type == TCL_PATH_VOLUME_RELATIVE) {
/*
* Only Windows has volume-relative paths.
@@ -1969,7 +1969,7 @@ Tcl_FSGetNormalizedPath(
return NULL;
}
pureNormalized = 0;
-#endif /* __WIN32__ */
+#endif /* _WIN32 */
}
}
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..abc8ee8 100644
--- a/generic/tclPlatDecls.h
+++ b/generic/tclPlatDecls.h
@@ -42,11 +42,15 @@
/* !BEGIN!: Do not edit below this line. */
+#ifdef __cplusplus
+extern "C" {
+#endif
+
/*
* Exported function declarations:
*/
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len,
Tcl_DString *dsPtr);
@@ -71,7 +75,7 @@ typedef struct TclPlatStubs {
int magic;
void *hooks;
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */
char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */
#endif /* WIN */
@@ -81,10 +85,8 @@ typedef struct TclPlatStubs {
#endif /* MACOSX */
} TclPlatStubs;
-#ifdef __cplusplus
-extern "C" {
-#endif
extern const TclPlatStubs *tclPlatStubsPtr;
+
#ifdef __cplusplus
}
#endif
@@ -95,7 +97,7 @@ extern const TclPlatStubs *tclPlatStubsPtr;
* Inline function declarations:
*/
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
#define Tcl_WinUtfToTChar \
(tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */
#define Tcl_WinTCharToUtf \
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..ce1c767 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);
@@ -1863,9 +1855,39 @@ InterpProcNR2(
}
/*
- * Process the result code.
+ * Free the stack-allocated compiled locals and CallFrame. It is important
+ * to pop the call frame without freeing it first: the compiledLocals
+ * cannot be freed before the frame is popped, as the local variables must
+ * be deleted. But the compiledLocals must be freed first, as they were
+ * allocated later on the stack.
*/
+ if (result != TCL_OK) {
+ goto process;
+ }
+
+ done:
+ if (TCL_DTRACE_PROC_RESULT_ENABLED()) {
+ int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
+ Tcl_Obj *r = Tcl_GetObjResult(interp);
+
+ TCL_DTRACE_PROC_RESULT(l < iPtr->varFramePtr->objc ?
+ TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result,
+ TclGetString(r), r);
+ }
+
+ freePtr = iPtr->framePtr;
+ Tcl_PopCallFrame(interp); /* Pop but do not free. */
+ TclStackFree(interp, freePtr->compiledLocals);
+ /* Free compiledLocals. */
+ TclStackFree(interp, freePtr); /* Free CallFrame. */
+ return result;
+
+ /*
+ * Process any non-TCL_OK result code.
+ */
+
+ process:
switch (result) {
case TCL_RETURN:
/*
@@ -1900,46 +1922,8 @@ InterpProcNR2(
*/
errorProc(interp, procNameObj);
-
- default:
- /*
- * Process other results (OK and non-standard) by doing nothing
- * special, skipping directly to the code afterwards that cleans up
- * associated memory.
- *
- * Non-standard results are processed by passing them through quickly.
- * This means they all work as exceptions, unwinding the stack quickly
- * and neatly. Who knows how well they are handled by third-party code
- * though...
- */
-
- (void) 0; /* do nothing */
}
-
- if (TCL_DTRACE_PROC_RESULT_ENABLED()) {
- int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
- Tcl_Obj *r = Tcl_GetObjResult(interp);
-
- TCL_DTRACE_PROC_RESULT(l < iPtr->varFramePtr->objc ?
- TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result,
- TclGetString(r), r);
- }
-
- /*
- * Free the stack-allocated compiled locals and CallFrame. It is important
- * to pop the call frame without freeing it first: the compiledLocals
- * cannot be freed before the frame is popped, as the local variables must
- * be deleted. But the compiledLocals must be freed first, as they were
- * allocated later on the stack.
- */
-
- freePtr = iPtr->framePtr;
- Tcl_PopCallFrame(interp); /* Pop but do not free. */
- TclStackFree(interp, freePtr->compiledLocals);
- /* Free compiledLocals. */
- TclStackFree(interp, freePtr); /* Free CallFrame. */
-
- return result;
+ goto done;
}
/*
@@ -1975,7 +1959,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 +2079,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 +2349,7 @@ TclNewProcBodyObj(
TclNewObj(objPtr);
if (objPtr) {
objPtr->typePtr = &tclProcBodyType;
- objPtr->internalRep.otherValuePtr = procPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = procPtr;
procPtr->refCount++;
}
@@ -2395,10 +2379,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 +2409,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 +2587,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 +2704,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 +2943,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 +3042,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..100644
--- 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..dffa38c 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
@@ -1281,23 +1281,43 @@ Tcl_AppendObjToObj(
if ((TclIsPureByteArray(objPtr) || objPtr->bytes == tclEmptyStringRep)
&& TclIsPureByteArray(appendObjPtr)) {
- unsigned char *bytesSrc;
- int lengthSrc, lengthTotal;
/*
- * We do not assume that objPtr and appendObjPtr must be distinct!
- * This makes this code a bit more complex than it otherwise would be,
- * but in turn makes it much safer.
+ * You might expect the code here to be
+ *
+ * bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length);
+ * TclAppendBytesToByteArray(objPtr, bytes, length);
+ *
+ * and essentially all of the time that would be fine. However,
+ * it would run into trouble in the case where objPtr and
+ * appendObjPtr point to the same thing. That may never be a
+ * good idea. It seems to violate Copy On Write, and we don't
+ * have any tests for the situation, since making any Tcl commands
+ * that call Tcl_AppendObjToObj() do that appears impossible
+ * (They honor Copy On Write!). For the sake of extensions that
+ * go off into that realm, though, here's a more complex approach
+ * that can handle all the cases.
*/
+ /* Get lengths */
+ int lengthSrc;
+
(void) Tcl_GetByteArrayFromObj(objPtr, &length);
(void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc);
- lengthTotal = length + lengthSrc;
- if (((length > lengthSrc) ? length : lengthSrc) > lengthTotal) {
- Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
- }
- bytesSrc = Tcl_GetByteArrayFromObj(appendObjPtr, NULL);
- TclAppendBytesToByteArray(objPtr, bytesSrc, lengthSrc);
+
+ /* Grow buffer enough for the append */
+ TclAppendBytesToByteArray(objPtr, NULL, lengthSrc);
+
+ /* Reset objPtr back to the original value */
+ Tcl_SetByteArrayLength(objPtr, length);
+
+ /*
+ * Now do the append knowing that buffer growth cannot cause
+ * any trouble.
+ */
+
+ TclAppendBytesToByteArray(objPtr,
+ Tcl_GetByteArrayFromObj(appendObjPtr, NULL), lengthSrc);
return;
}
diff --git a/generic/tclStringTrim.h b/generic/tclStringTrim.h
new file mode 100644
index 0000000..030e4ec
--- /dev/null
+++ b/generic/tclStringTrim.h
@@ -0,0 +1,43 @@
+/*
+ * tclStringTrim.h --
+ *
+ * This file contains the definition of what characters are to be trimmed
+ * from a string by [string trim] by default. It's only needed by Tcl's
+ * implementation; it does not form a public or private API at all.
+ *
+ * Copyright (c) 1987-1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 Scriptics Corporation.
+ * Copyright (c) 2002 ActiveState Corporation.
+ * Copyright (c) 2003-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.
+ */
+
+#ifndef TCL_STRING_TRIM_H
+#define TCL_STRING_TRIM_H
+
+/*
+ * 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]
+ */
+
+MODULE_SCOPE const char tclDefaultTrimSet[];
+
+/*
+ * The whitespace trimming set used when [concat]enating. This is a subset of
+ * the above, and deliberately so.
+ */
+
+#define CONCAT_TRIM_SET " \f\v\r\t\n"
+
+#endif /* TCL_STRING_TRIM_H */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 1d1fe15..7a84cba 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -42,6 +42,11 @@
#undef TclpGetPid
#undef TclSockMinimumBuffers
#define TclBackgroundException Tcl_BackgroundException
+#undef Tcl_SetIntObj
+#undef TclpInetNtoa
+#undef TclWinGetServByName
+#undef TclWinGetSockOpt
+#undef TclWinSetSockOpt
/* See bug 510001: TclSockMinimumBuffers needs plat imp */
#ifdef _WIN64
@@ -54,6 +59,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
@@ -63,7 +93,7 @@ static unsigned short TclWinNToHS(unsigned short ns) {
}
#endif
-#ifdef __WIN32__
+#ifdef _WIN32
# define TclUnixWaitForFile 0
# define TclUnixCopyFile 0
# define TclUnixOpenTemporaryFile 0
@@ -84,7 +114,8 @@ TclpIsAtty(int fd)
return isatty(fd);
}
-int
+#define TclWinGetPlatformId winGetPlatformId
+static int
TclWinGetPlatformId()
{
/* Don't bother to determine the real platform on cygwin,
@@ -100,27 +131,31 @@ void *TclWinGetTclInstance()
return hInstance;
}
-int
+#define TclWinSetSockOpt winSetSockOpt
+static int
TclWinSetSockOpt(SOCKET s, int level, int optname,
const char *optval, int optlen)
{
return setsockopt((int) s, level, optname, optval, optlen);
}
-int
+#define TclWinGetSockOpt winGetSockOpt
+static int
TclWinGetSockOpt(SOCKET s, int level, int optname,
char *optval, int *optlen)
{
return getsockopt((int) s, level, optname, optval, optlen);
}
-struct servent *
+#define TclWinGetServByName winGetServByName
+static struct servent *
TclWinGetServByName(const char *name, const char *proto)
{
return getservbyname(name, proto);
}
-char *
+#define TclWinNoBackslash winNoBackslash
+static char *
TclWinNoBackslash(char *path)
{
char *p;
@@ -171,6 +206,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
@@ -348,8 +466,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 */
@@ -357,8 +475,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 */
@@ -441,12 +559,13 @@ static const TclIntStubs tclIntStubs = {
TclCopyChannel, /* 248 */
TclDoubleDigits, /* 249 */
TclSetSlaveCancelFlags, /* 250 */
+ TclRegisterLiteral, /* 251 */
};
static const TclIntPlatStubs tclIntPlatStubs = {
TCL_STUB_MAGIC,
0,
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
TclGetAndDetachPids, /* 0 */
TclpCloseFile, /* 1 */
TclpCreateCommandChannel, /* 2 */
@@ -479,7 +598,7 @@ static const TclIntPlatStubs tclIntPlatStubs = {
TclWinCPUID, /* 29 */
TclUnixOpenTemporaryFile, /* 30 */
#endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
TclWinConvertError, /* 0 */
TclWinConvertWSAError, /* 1 */
TclWinGetServByName, /* 2 */
@@ -550,7 +669,7 @@ static const TclIntPlatStubs tclIntPlatStubs = {
static const TclPlatStubs tclPlatStubs = {
TCL_STUB_MAGIC,
0,
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
Tcl_WinUtfToTChar, /* 0 */
Tcl_WinTCharToUtf, /* 1 */
#endif /* WIN */
@@ -647,19 +766,19 @@ const TclStubs tclStubs = {
Tcl_DbCkalloc, /* 6 */
Tcl_DbCkfree, /* 7 */
Tcl_DbCkrealloc, /* 8 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
Tcl_CreateFileHandler, /* 9 */
#endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
0, /* 9 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
Tcl_CreateFileHandler, /* 9 */
#endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
Tcl_DeleteFileHandler, /* 10 */
#endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
0, /* 10 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
@@ -821,10 +940,10 @@ const TclStubs tclStubs = {
Tcl_GetMaster, /* 164 */
Tcl_GetNameOfExecutable, /* 165 */
Tcl_GetObjResult, /* 166 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
Tcl_GetOpenFile, /* 167 */
#endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
0, /* 167 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
diff --git a/generic/tclStubLibTbl.c b/generic/tclStubLibTbl.c
new file mode 100644
index 0000000..0391502
--- /dev/null
+++ b/generic/tclStubLibTbl.c
@@ -0,0 +1,58 @@
+/*
+ * tclStubLibTbl.c --
+ *
+ * Stub object that will be statically linked into extensions that want
+ * to access Tcl.
+ *
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * Copyright (c) 1998 Paul Duffin.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitStubTable --
+ *
+ * Initialize the stub table, using the structure pointed at
+ * by the "version" argument.
+ *
+ * Results:
+ * Outputs the value of the "version" argument.
+ *
+ * Side effects:
+ * Sets the stub table pointers.
+ *
+ *----------------------------------------------------------------------
+ */
+MODULE_SCOPE const char *
+TclInitStubTable(
+ const char *version) /* points to the version field of a
+ TclStubInfoType structure variable. */
+{
+ tclStubsPtr = ((const TclStubInfoType *) version)->stubs;
+
+ if (tclStubsPtr->hooks) {
+ tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
+ tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
+ tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
+ } else {
+ tclPlatStubsPtr = NULL;
+ tclIntStubsPtr = NULL;
+ tclIntPlatStubsPtr = NULL;
+ }
+
+ return version;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 297fe4d..a27c95a 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -19,7 +19,6 @@
#ifndef USE_TCL_STUBS
# define USE_TCL_STUBS
#endif
-#include <sys/stat.h>
#include "tclInt.h"
#include "tclOO.h"
#include <math.h>
@@ -328,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,
@@ -413,7 +414,7 @@ static int TestNRELevels(ClientData clientData,
static int TestInterpResolverCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-#if defined(HAVE_CPUID) || defined(__WIN32__)
+#if defined(HAVE_CPUID) || defined(_WIN32)
static int TestcpuidCmd(ClientData dummy,
Tcl_Interp* interp, int objc,
Tcl_Obj *const objv[]);
@@ -524,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;
@@ -643,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,
@@ -666,22 +671,26 @@ 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,
NULL, NULL);
Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
NULL, NULL);
-#if defined(HAVE_CPUID) || defined(__WIN32__)
+#if defined(HAVE_CPUID) || defined(_WIN32)
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);
@@ -1546,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.
*
*----------------------------------------------------------------------
*/
@@ -1847,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;
@@ -4399,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;
}
@@ -5004,6 +5031,7 @@ Testset2Cmd(
}
}
+#ifndef TCL_NO_DEPRECATED
/*
*----------------------------------------------------------------------
*
@@ -5137,6 +5165,7 @@ TestsaveresultFree(
{
freeCount++;
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -6171,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);
@@ -6185,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
@@ -6615,7 +6648,7 @@ TestNumUtfCharsCmd(
return TCL_OK;
}
-#if defined(HAVE_CPUID) || defined(__WIN32__)
+#if defined(HAVE_CPUID) || defined(_WIN32)
/*
*----------------------------------------------------------------------
*
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/tclThread.c b/generic/tclThread.c
index d1f2691..8c972a8 100644
--- a/generic/tclThread.c
+++ b/generic/tclThread.c
@@ -339,8 +339,9 @@ Tcl_ConditionFinalize(
*
* TclFinalizeThreadData --
*
- * This function cleans up the thread-local storage. This is called once
- * for each thread.
+ * This function cleans up the thread-local storage. Secondary, it cleans
+ * thread alloc cache.
+ * This is called once for each thread before thread exits.
*
* Results:
* None.
@@ -355,6 +356,9 @@ void
TclFinalizeThreadData(void)
{
TclFinalizeThreadDataThread();
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+ TclFinalizeThreadAllocThread();
+#endif
}
/*
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index e4261d6..ddf888a 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;
}
@@ -1023,6 +1023,33 @@ TclFinalizeThreadAlloc(void)
TclpFreeAllocCache(NULL);
}
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeThreadAllocThread --
+ *
+ * This procedure is used to destroy single thread private resources used
+ * in this file.
+ * Called in TclpFinalizeThreadData when a thread exits (Tcl_FinalizeThread).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeThreadAllocThread(void)
+{
+ Cache *cachePtr = TclpGetAllocCache();
+ if (cachePtr != NULL) {
+ TclpFreeAllocCache(cachePtr);
+ }
+}
+
#else /* !(TCL_THREADS && USE_THREAD_ALLOC) */
/*
*----------------------------------------------------------------------
diff --git a/generic/tclThreadJoin.c b/generic/tclThreadJoin.c
index 4b09e1c..5c70a62 100644
--- a/generic/tclThreadJoin.c
+++ b/generic/tclThreadJoin.c
@@ -14,7 +14,7 @@
#include "tclInt.h"
-#ifdef WIN32
+#ifdef _WIN32
/*
* The information about each joinable thread is remembered in a structure as
@@ -305,7 +305,7 @@ TclSignalExitThread(
Tcl_MutexUnlock(&threadPtr->threadMutex);
}
-#endif /* WIN32 */
+#endif /* _WIN32 */
/*
* Local Variables:
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/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 27e2474..2d00adf 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -14,6 +14,7 @@
#include "tclInt.h"
#include "tclParse.h"
+#include "tclStringTrim.h"
#include <math.h>
/*
@@ -1768,8 +1769,7 @@ TclTrimLeft(
*/
/* The whitespace characters trimmed during [concat] operations */
-#define CONCAT_WS " \f\v\r\t\n"
-#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_WS "") - 1)
+#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_TRIM_SET "") - 1)
char *
Tcl_Concat(
@@ -1825,7 +1825,8 @@ Tcl_Concat(
* Trim away the leading whitespace.
*/
- trim = TclTrimLeft(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
+ trim = TclTrimLeft(element, elemLength, CONCAT_TRIM_SET,
+ CONCAT_WS_SIZE);
element += trim;
elemLength -= trim;
@@ -1834,7 +1835,8 @@ Tcl_Concat(
* a final backslash character.
*/
- trim = TclTrimRight(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
+ trim = TclTrimRight(element, elemLength, CONCAT_TRIM_SET,
+ CONCAT_WS_SIZE);
trim -= trim && (element[elemLength - trim - 1] == '\\');
elemLength -= trim;
@@ -1959,7 +1961,8 @@ Tcl_ConcatObj(
* Trim away the leading whitespace.
*/
- trim = TclTrimLeft(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
+ trim = TclTrimLeft(element, elemLength, CONCAT_TRIM_SET,
+ CONCAT_WS_SIZE);
element += trim;
elemLength -= trim;
@@ -1968,7 +1971,8 @@ Tcl_ConcatObj(
* a final backslash character.
*/
- trim = TclTrimRight(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
+ trim = TclTrimRight(element, elemLength, CONCAT_TRIM_SET,
+ CONCAT_WS_SIZE);
trim -= trim && (element[elemLength - trim - 1] == '\\');
elemLength -= trim;
@@ -3580,10 +3584,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 9b8527c..4694cd8 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -144,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:
*/
@@ -475,6 +499,9 @@ TclObjLookupVar(
if (part2) {
part2Ptr = Tcl_NewStringObj(part2, -1);
+ if (createPart2) {
+ Tcl_IncrRefCount(part2Ptr);
+ }
}
resPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr,
@@ -487,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. */
@@ -627,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;
@@ -673,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
@@ -1083,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.
*
*----------------------------------------------------------------------
*/
@@ -1208,6 +1247,7 @@ TclLookupArrayElement(
*----------------------------------------------------------------------
*/
+#undef Tcl_GetVar
const char *
Tcl_GetVar(
Tcl_Interp *interp, /* Command interpreter in which varName is to
@@ -1217,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) {
@@ -1265,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);
@@ -1326,6 +1361,7 @@ Tcl_GetVar2Ex(
if (part2) {
part2Ptr = Tcl_NewStringObj(part2, -1);
+ Tcl_IncrRefCount(part2Ptr);
}
resPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
@@ -1358,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.
+ *
*----------------------------------------------------------------------
*/
@@ -1552,6 +1590,7 @@ Tcl_SetObjCmd(
*----------------------------------------------------------------------
*/
+#undef Tcl_SetVar
const char *
Tcl_SetVar(
Tcl_Interp *interp, /* Command interpreter in which varName is to
@@ -1563,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;
}
@@ -1721,6 +1756,7 @@ Tcl_SetVar2Ex(
* 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.
*
*----------------------------------------------------------------------
*/
@@ -2011,6 +2047,7 @@ TclPtrSetVar(
* 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.
*
*----------------------------------------------------------------------
*/
@@ -2036,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,
@@ -2156,6 +2193,7 @@ TclPtrIncrObjVar(
*----------------------------------------------------------------------
*/
+#undef Tcl_UnsetVar
int
Tcl_UnsetVar(
Tcl_Interp *interp, /* Command interpreter in which varName is to
@@ -3812,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
@@ -4515,6 +4600,7 @@ TclPtrObjMakeUpvar(
*----------------------------------------------------------------------
*/
+#undef Tcl_UpVar
int
Tcl_UpVar(
Tcl_Interp *interp, /* Command interpreter in which varName is to
@@ -5108,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;
}
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 47091de..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;
@@ -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/encoding/tis-620.enc b/library/encoding/tis-620.enc
index c233be5..c233be5 100755..100644
--- a/library/encoding/tis-620.enc
+++ b/library/encoding/tis-620.enc
diff --git a/library/http/http.tcl b/library/http/http.tcl
index 01bf772..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.6
+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
}
diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl
index a8641e1..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.6 [list tclPkgSetup $dir http 2.8.6 {{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/msgs/af.msg b/library/msgs/af.msg
index 0892615..0892615 100755..100644
--- a/library/msgs/af.msg
+++ b/library/msgs/af.msg
diff --git a/library/msgs/af_za.msg b/library/msgs/af_za.msg
index fef48ad..fef48ad 100755..100644
--- a/library/msgs/af_za.msg
+++ b/library/msgs/af_za.msg
diff --git a/library/msgs/ar.msg b/library/msgs/ar.msg
index 257157f..257157f 100755..100644
--- a/library/msgs/ar.msg
+++ b/library/msgs/ar.msg
diff --git a/library/msgs/ar_in.msg b/library/msgs/ar_in.msg
index 185e49c..185e49c 100755..100644
--- a/library/msgs/ar_in.msg
+++ b/library/msgs/ar_in.msg
diff --git a/library/msgs/ar_jo.msg b/library/msgs/ar_jo.msg
index 0f5e269..0f5e269 100755..100644
--- a/library/msgs/ar_jo.msg
+++ b/library/msgs/ar_jo.msg
diff --git a/library/msgs/ar_lb.msg b/library/msgs/ar_lb.msg
index e62acd3..e62acd3 100755..100644
--- a/library/msgs/ar_lb.msg
+++ b/library/msgs/ar_lb.msg
diff --git a/library/msgs/ar_sy.msg b/library/msgs/ar_sy.msg
index d5e1c87..d5e1c87 100755..100644
--- a/library/msgs/ar_sy.msg
+++ b/library/msgs/ar_sy.msg
diff --git a/library/msgs/be.msg b/library/msgs/be.msg
index 379a1d7..379a1d7 100755..100644
--- a/library/msgs/be.msg
+++ b/library/msgs/be.msg
diff --git a/library/msgs/bg.msg b/library/msgs/bg.msg
index ff17759..ff17759 100755..100644
--- a/library/msgs/bg.msg
+++ b/library/msgs/bg.msg
diff --git a/library/msgs/bn.msg b/library/msgs/bn.msg
index 664b9d8..664b9d8 100755..100644
--- a/library/msgs/bn.msg
+++ b/library/msgs/bn.msg
diff --git a/library/msgs/bn_in.msg b/library/msgs/bn_in.msg
index 28c000f..28c000f 100755..100644
--- a/library/msgs/bn_in.msg
+++ b/library/msgs/bn_in.msg
diff --git a/library/msgs/ca.msg b/library/msgs/ca.msg
index 36c9772..36c9772 100755..100644
--- a/library/msgs/ca.msg
+++ b/library/msgs/ca.msg
diff --git a/library/msgs/cs.msg b/library/msgs/cs.msg
index 8db8bdd..8db8bdd 100755..100644
--- a/library/msgs/cs.msg
+++ b/library/msgs/cs.msg
diff --git a/library/msgs/da.msg b/library/msgs/da.msg
index e4fec7f..e4fec7f 100755..100644
--- a/library/msgs/da.msg
+++ b/library/msgs/da.msg
diff --git a/library/msgs/de.msg b/library/msgs/de.msg
index 9eb3145..9eb3145 100755..100644
--- a/library/msgs/de.msg
+++ b/library/msgs/de.msg
diff --git a/library/msgs/de_at.msg b/library/msgs/de_at.msg
index 61bc266..61bc266 100755..100644
--- a/library/msgs/de_at.msg
+++ b/library/msgs/de_at.msg
diff --git a/library/msgs/de_be.msg b/library/msgs/de_be.msg
index 3614763..3614763 100755..100644
--- a/library/msgs/de_be.msg
+++ b/library/msgs/de_be.msg
diff --git a/library/msgs/el.msg b/library/msgs/el.msg
index ac19f62..ac19f62 100755..100644
--- a/library/msgs/el.msg
+++ b/library/msgs/el.msg
diff --git a/library/msgs/en_au.msg b/library/msgs/en_au.msg
index 7f9870c..7f9870c 100755..100644
--- a/library/msgs/en_au.msg
+++ b/library/msgs/en_au.msg
diff --git a/library/msgs/en_be.msg b/library/msgs/en_be.msg
index 5072986..5072986 100755..100644
--- a/library/msgs/en_be.msg
+++ b/library/msgs/en_be.msg
diff --git a/library/msgs/en_bw.msg b/library/msgs/en_bw.msg
index 8fd20c7..8fd20c7 100755..100644
--- a/library/msgs/en_bw.msg
+++ b/library/msgs/en_bw.msg
diff --git a/library/msgs/en_ca.msg b/library/msgs/en_ca.msg
index 278efe7..278efe7 100755..100644
--- a/library/msgs/en_ca.msg
+++ b/library/msgs/en_ca.msg
diff --git a/library/msgs/en_gb.msg b/library/msgs/en_gb.msg
index 5c61c43..5c61c43 100755..100644
--- a/library/msgs/en_gb.msg
+++ b/library/msgs/en_gb.msg
diff --git a/library/msgs/en_hk.msg b/library/msgs/en_hk.msg
index 8b33bc0..8b33bc0 100755..100644
--- a/library/msgs/en_hk.msg
+++ b/library/msgs/en_hk.msg
diff --git a/library/msgs/en_ie.msg b/library/msgs/en_ie.msg
index ba621cf..ba621cf 100755..100644
--- a/library/msgs/en_ie.msg
+++ b/library/msgs/en_ie.msg
diff --git a/library/msgs/en_in.msg b/library/msgs/en_in.msg
index a1f155d..a1f155d 100755..100644
--- a/library/msgs/en_in.msg
+++ b/library/msgs/en_in.msg
diff --git a/library/msgs/en_nz.msg b/library/msgs/en_nz.msg
index b419017..b419017 100755..100644
--- a/library/msgs/en_nz.msg
+++ b/library/msgs/en_nz.msg
diff --git a/library/msgs/en_ph.msg b/library/msgs/en_ph.msg
index 682666d..682666d 100755..100644
--- a/library/msgs/en_ph.msg
+++ b/library/msgs/en_ph.msg
diff --git a/library/msgs/en_sg.msg b/library/msgs/en_sg.msg
index 4dc5b1d..4dc5b1d 100755..100644
--- a/library/msgs/en_sg.msg
+++ b/library/msgs/en_sg.msg
diff --git a/library/msgs/en_za.msg b/library/msgs/en_za.msg
index fe43797..fe43797 100755..100644
--- a/library/msgs/en_za.msg
+++ b/library/msgs/en_za.msg
diff --git a/library/msgs/en_zw.msg b/library/msgs/en_zw.msg
index 2a5804f..2a5804f 100755..100644
--- a/library/msgs/en_zw.msg
+++ b/library/msgs/en_zw.msg
diff --git a/library/msgs/eo.msg b/library/msgs/eo.msg
index 1d2a24f..1d2a24f 100755..100644
--- a/library/msgs/eo.msg
+++ b/library/msgs/eo.msg
diff --git a/library/msgs/es.msg b/library/msgs/es.msg
index a24f0a1..a24f0a1 100755..100644
--- a/library/msgs/es.msg
+++ b/library/msgs/es.msg
diff --git a/library/msgs/es_ar.msg b/library/msgs/es_ar.msg
index 7d35027..7d35027 100755..100644
--- a/library/msgs/es_ar.msg
+++ b/library/msgs/es_ar.msg
diff --git a/library/msgs/es_bo.msg b/library/msgs/es_bo.msg
index 498ad0d..498ad0d 100755..100644
--- a/library/msgs/es_bo.msg
+++ b/library/msgs/es_bo.msg
diff --git a/library/msgs/es_cl.msg b/library/msgs/es_cl.msg
index 31d465c..31d465c 100755..100644
--- a/library/msgs/es_cl.msg
+++ b/library/msgs/es_cl.msg
diff --git a/library/msgs/es_co.msg b/library/msgs/es_co.msg
index 77e57f0..77e57f0 100755..100644
--- a/library/msgs/es_co.msg
+++ b/library/msgs/es_co.msg
diff --git a/library/msgs/es_cr.msg b/library/msgs/es_cr.msg
index 7a652fa..7a652fa 100755..100644
--- a/library/msgs/es_cr.msg
+++ b/library/msgs/es_cr.msg
diff --git a/library/msgs/es_do.msg b/library/msgs/es_do.msg
index 0e283da..0e283da 100755..100644
--- a/library/msgs/es_do.msg
+++ b/library/msgs/es_do.msg
diff --git a/library/msgs/es_ec.msg b/library/msgs/es_ec.msg
index 9e921e0..9e921e0 100755..100644
--- a/library/msgs/es_ec.msg
+++ b/library/msgs/es_ec.msg
diff --git a/library/msgs/es_gt.msg b/library/msgs/es_gt.msg
index ecd6faf..ecd6faf 100755..100644
--- a/library/msgs/es_gt.msg
+++ b/library/msgs/es_gt.msg
diff --git a/library/msgs/es_hn.msg b/library/msgs/es_hn.msg
index a758ca2..a758ca2 100755..100644
--- a/library/msgs/es_hn.msg
+++ b/library/msgs/es_hn.msg
diff --git a/library/msgs/es_mx.msg b/library/msgs/es_mx.msg
index 7cfb545..7cfb545 100755..100644
--- a/library/msgs/es_mx.msg
+++ b/library/msgs/es_mx.msg
diff --git a/library/msgs/es_ni.msg b/library/msgs/es_ni.msg
index 7c39495..7c39495 100755..100644
--- a/library/msgs/es_ni.msg
+++ b/library/msgs/es_ni.msg
diff --git a/library/msgs/es_pa.msg b/library/msgs/es_pa.msg
index cecacdc..cecacdc 100755..100644
--- a/library/msgs/es_pa.msg
+++ b/library/msgs/es_pa.msg
diff --git a/library/msgs/es_pe.msg b/library/msgs/es_pe.msg
index 9f90595..9f90595 100755..100644
--- a/library/msgs/es_pe.msg
+++ b/library/msgs/es_pe.msg
diff --git a/library/msgs/es_pr.msg b/library/msgs/es_pr.msg
index 8511b12..8511b12 100755..100644
--- a/library/msgs/es_pr.msg
+++ b/library/msgs/es_pr.msg
diff --git a/library/msgs/es_py.msg b/library/msgs/es_py.msg
index aa93d36..aa93d36 100755..100644
--- a/library/msgs/es_py.msg
+++ b/library/msgs/es_py.msg
diff --git a/library/msgs/es_sv.msg b/library/msgs/es_sv.msg
index fc7954d..fc7954d 100755..100644
--- a/library/msgs/es_sv.msg
+++ b/library/msgs/es_sv.msg
diff --git a/library/msgs/es_uy.msg b/library/msgs/es_uy.msg
index b33525c..b33525c 100755..100644
--- a/library/msgs/es_uy.msg
+++ b/library/msgs/es_uy.msg
diff --git a/library/msgs/es_ve.msg b/library/msgs/es_ve.msg
index 7c2a7b0..7c2a7b0 100755..100644
--- a/library/msgs/es_ve.msg
+++ b/library/msgs/es_ve.msg
diff --git a/library/msgs/et.msg b/library/msgs/et.msg
index 8d32e9e..8d32e9e 100755..100644
--- a/library/msgs/et.msg
+++ b/library/msgs/et.msg
diff --git a/library/msgs/eu.msg b/library/msgs/eu.msg
index cf708b6..cf708b6 100755..100644
--- a/library/msgs/eu.msg
+++ b/library/msgs/eu.msg
diff --git a/library/msgs/eu_es.msg b/library/msgs/eu_es.msg
index 2694418..2694418 100755..100644
--- a/library/msgs/eu_es.msg
+++ b/library/msgs/eu_es.msg
diff --git a/library/msgs/fa.msg b/library/msgs/fa.msg
index 89b2f90..89b2f90 100755..100644
--- a/library/msgs/fa.msg
+++ b/library/msgs/fa.msg
diff --git a/library/msgs/fa_in.msg b/library/msgs/fa_in.msg
index adc9e91..adc9e91 100755..100644
--- a/library/msgs/fa_in.msg
+++ b/library/msgs/fa_in.msg
diff --git a/library/msgs/fa_ir.msg b/library/msgs/fa_ir.msg
index 597ce9d..597ce9d 100755..100644
--- a/library/msgs/fa_ir.msg
+++ b/library/msgs/fa_ir.msg
diff --git a/library/msgs/fi.msg b/library/msgs/fi.msg
index acabba0..acabba0 100755..100644
--- a/library/msgs/fi.msg
+++ b/library/msgs/fi.msg
diff --git a/library/msgs/fo.msg b/library/msgs/fo.msg
index 4696e62..4696e62 100755..100644
--- a/library/msgs/fo.msg
+++ b/library/msgs/fo.msg
diff --git a/library/msgs/fo_fo.msg b/library/msgs/fo_fo.msg
index 2392b8e..2392b8e 100755..100644
--- a/library/msgs/fo_fo.msg
+++ b/library/msgs/fo_fo.msg
diff --git a/library/msgs/fr.msg b/library/msgs/fr.msg
index 55b19bf..55b19bf 100755..100644
--- a/library/msgs/fr.msg
+++ b/library/msgs/fr.msg
diff --git a/library/msgs/fr_be.msg b/library/msgs/fr_be.msg
index cdb13bd..cdb13bd 100755..100644
--- a/library/msgs/fr_be.msg
+++ b/library/msgs/fr_be.msg
diff --git a/library/msgs/fr_ca.msg b/library/msgs/fr_ca.msg
index 00ccfff..00ccfff 100755..100644
--- a/library/msgs/fr_ca.msg
+++ b/library/msgs/fr_ca.msg
diff --git a/library/msgs/fr_ch.msg b/library/msgs/fr_ch.msg
index 7e2bac7..7e2bac7 100755..100644
--- a/library/msgs/fr_ch.msg
+++ b/library/msgs/fr_ch.msg
diff --git a/library/msgs/ga.msg b/library/msgs/ga.msg
index 6edf13a..6edf13a 100755..100644
--- a/library/msgs/ga.msg
+++ b/library/msgs/ga.msg
diff --git a/library/msgs/ga_ie.msg b/library/msgs/ga_ie.msg
index b6acbbc..b6acbbc 100755..100644
--- a/library/msgs/ga_ie.msg
+++ b/library/msgs/ga_ie.msg
diff --git a/library/msgs/gl.msg b/library/msgs/gl.msg
index 4b869e8..4b869e8 100755..100644
--- a/library/msgs/gl.msg
+++ b/library/msgs/gl.msg
diff --git a/library/msgs/gl_es.msg b/library/msgs/gl_es.msg
index d4ed270..d4ed270 100755..100644
--- a/library/msgs/gl_es.msg
+++ b/library/msgs/gl_es.msg
diff --git a/library/msgs/gv.msg b/library/msgs/gv.msg
index 7d332ad..7d332ad 100755..100644
--- a/library/msgs/gv.msg
+++ b/library/msgs/gv.msg
diff --git a/library/msgs/gv_gb.msg b/library/msgs/gv_gb.msg
index 5e96e6f..5e96e6f 100755..100644
--- a/library/msgs/gv_gb.msg
+++ b/library/msgs/gv_gb.msg
diff --git a/library/msgs/he.msg b/library/msgs/he.msg
index 4fd921d..4fd921d 100755..100644
--- a/library/msgs/he.msg
+++ b/library/msgs/he.msg
diff --git a/library/msgs/hi.msg b/library/msgs/hi.msg
index 50c9fb8..50c9fb8 100755..100644
--- a/library/msgs/hi.msg
+++ b/library/msgs/hi.msg
diff --git a/library/msgs/hi_in.msg b/library/msgs/hi_in.msg
index 239793f..239793f 100755..100644
--- a/library/msgs/hi_in.msg
+++ b/library/msgs/hi_in.msg
diff --git a/library/msgs/hr.msg b/library/msgs/hr.msg
index cec145b..cec145b 100755..100644
--- a/library/msgs/hr.msg
+++ b/library/msgs/hr.msg
diff --git a/library/msgs/hu.msg b/library/msgs/hu.msg
index e5e68d9..e5e68d9 100755..100644
--- a/library/msgs/hu.msg
+++ b/library/msgs/hu.msg
diff --git a/library/msgs/id.msg b/library/msgs/id.msg
index 17c6bb5..17c6bb5 100755..100644
--- a/library/msgs/id.msg
+++ b/library/msgs/id.msg
diff --git a/library/msgs/id_id.msg b/library/msgs/id_id.msg
index bb672c1..bb672c1 100755..100644
--- a/library/msgs/id_id.msg
+++ b/library/msgs/id_id.msg
diff --git a/library/msgs/is.msg b/library/msgs/is.msg
index adc2d2a..adc2d2a 100755..100644
--- a/library/msgs/is.msg
+++ b/library/msgs/is.msg
diff --git a/library/msgs/it.msg b/library/msgs/it.msg
index b641cde..b641cde 100755..100644
--- a/library/msgs/it.msg
+++ b/library/msgs/it.msg
diff --git a/library/msgs/it_ch.msg b/library/msgs/it_ch.msg
index b36ed36..b36ed36 100755..100644
--- a/library/msgs/it_ch.msg
+++ b/library/msgs/it_ch.msg
diff --git a/library/msgs/ja.msg b/library/msgs/ja.msg
index 2767665..2767665 100755..100644
--- a/library/msgs/ja.msg
+++ b/library/msgs/ja.msg
diff --git a/library/msgs/kl.msg b/library/msgs/kl.msg
index d877bfe..d877bfe 100755..100644
--- a/library/msgs/kl.msg
+++ b/library/msgs/kl.msg
diff --git a/library/msgs/kl_gl.msg b/library/msgs/kl_gl.msg
index 403aa10..403aa10 100755..100644
--- a/library/msgs/kl_gl.msg
+++ b/library/msgs/kl_gl.msg
diff --git a/library/msgs/ko.msg b/library/msgs/ko.msg
index 0cd17a1..0cd17a1 100755..100644
--- a/library/msgs/ko.msg
+++ b/library/msgs/ko.msg
diff --git a/library/msgs/ko_kr.msg b/library/msgs/ko_kr.msg
index ea5bbd7..ea5bbd7 100755..100644
--- a/library/msgs/ko_kr.msg
+++ b/library/msgs/ko_kr.msg
diff --git a/library/msgs/kok.msg b/library/msgs/kok.msg
index 0869f20..0869f20 100755..100644
--- a/library/msgs/kok.msg
+++ b/library/msgs/kok.msg
diff --git a/library/msgs/kok_in.msg b/library/msgs/kok_in.msg
index abcb1ff..abcb1ff 100755..100644
--- a/library/msgs/kok_in.msg
+++ b/library/msgs/kok_in.msg
diff --git a/library/msgs/kw.msg b/library/msgs/kw.msg
index aaf79b3..aaf79b3 100755..100644
--- a/library/msgs/kw.msg
+++ b/library/msgs/kw.msg
diff --git a/library/msgs/kw_gb.msg b/library/msgs/kw_gb.msg
index 2967680..2967680 100755..100644
--- a/library/msgs/kw_gb.msg
+++ b/library/msgs/kw_gb.msg
diff --git a/library/msgs/lt.msg b/library/msgs/lt.msg
index 27b0985..27b0985 100755..100644
--- a/library/msgs/lt.msg
+++ b/library/msgs/lt.msg
diff --git a/library/msgs/lv.msg b/library/msgs/lv.msg
index a037b15..a037b15 100755..100644
--- a/library/msgs/lv.msg
+++ b/library/msgs/lv.msg
diff --git a/library/msgs/mk.msg b/library/msgs/mk.msg
index 41cf60d..41cf60d 100755..100644
--- a/library/msgs/mk.msg
+++ b/library/msgs/mk.msg
diff --git a/library/msgs/mr.msg b/library/msgs/mr.msg
index cea427a..cea427a 100755..100644
--- a/library/msgs/mr.msg
+++ b/library/msgs/mr.msg
diff --git a/library/msgs/mr_in.msg b/library/msgs/mr_in.msg
index 1889da5..1889da5 100755..100644
--- a/library/msgs/mr_in.msg
+++ b/library/msgs/mr_in.msg
diff --git a/library/msgs/ms.msg b/library/msgs/ms.msg
index e954431..e954431 100755..100644
--- a/library/msgs/ms.msg
+++ b/library/msgs/ms.msg
diff --git a/library/msgs/ms_my.msg b/library/msgs/ms_my.msg
index c1f93d4..c1f93d4 100755..100644
--- a/library/msgs/ms_my.msg
+++ b/library/msgs/ms_my.msg
diff --git a/library/msgs/mt.msg b/library/msgs/mt.msg
index ddd5446..ddd5446 100755..100644
--- a/library/msgs/mt.msg
+++ b/library/msgs/mt.msg
diff --git a/library/msgs/nb.msg b/library/msgs/nb.msg
index 90d49a3..90d49a3 100755..100644
--- a/library/msgs/nb.msg
+++ b/library/msgs/nb.msg
diff --git a/library/msgs/nl.msg b/library/msgs/nl.msg
index 4c5c675..4c5c675 100755..100644
--- a/library/msgs/nl.msg
+++ b/library/msgs/nl.msg
diff --git a/library/msgs/nl_be.msg b/library/msgs/nl_be.msg
index 4b19670..4b19670 100755..100644
--- a/library/msgs/nl_be.msg
+++ b/library/msgs/nl_be.msg
diff --git a/library/msgs/nn.msg b/library/msgs/nn.msg
index bd61ac9..bd61ac9 100755..100644
--- a/library/msgs/nn.msg
+++ b/library/msgs/nn.msg
diff --git a/library/msgs/pl.msg b/library/msgs/pl.msg
index d206f4b..d206f4b 100755..100644
--- a/library/msgs/pl.msg
+++ b/library/msgs/pl.msg
diff --git a/library/msgs/pt.msg b/library/msgs/pt.msg
index 96fdb35..96fdb35 100755..100644
--- a/library/msgs/pt.msg
+++ b/library/msgs/pt.msg
diff --git a/library/msgs/pt_br.msg b/library/msgs/pt_br.msg
index 8684327..8684327 100755..100644
--- a/library/msgs/pt_br.msg
+++ b/library/msgs/pt_br.msg
diff --git a/library/msgs/ro.msg b/library/msgs/ro.msg
index bdd7c61..bdd7c61 100755..100644
--- a/library/msgs/ro.msg
+++ b/library/msgs/ro.msg
diff --git a/library/msgs/ru.msg b/library/msgs/ru.msg
index 65b075d..65b075d 100755..100644
--- a/library/msgs/ru.msg
+++ b/library/msgs/ru.msg
diff --git a/library/msgs/ru_ua.msg b/library/msgs/ru_ua.msg
index 6e1f8a8..6e1f8a8 100755..100644
--- a/library/msgs/ru_ua.msg
+++ b/library/msgs/ru_ua.msg
diff --git a/library/msgs/sh.msg b/library/msgs/sh.msg
index 6ee0fc7..6ee0fc7 100755..100644
--- a/library/msgs/sh.msg
+++ b/library/msgs/sh.msg
diff --git a/library/msgs/sk.msg b/library/msgs/sk.msg
index 9b2f0aa..9b2f0aa 100755..100644
--- a/library/msgs/sk.msg
+++ b/library/msgs/sk.msg
diff --git a/library/msgs/sl.msg b/library/msgs/sl.msg
index 42bc509..42bc509 100755..100644
--- a/library/msgs/sl.msg
+++ b/library/msgs/sl.msg
diff --git a/library/msgs/sq.msg b/library/msgs/sq.msg
index 8fb1fce..8fb1fce 100755..100644
--- a/library/msgs/sq.msg
+++ b/library/msgs/sq.msg
diff --git a/library/msgs/sr.msg b/library/msgs/sr.msg
index 7576668..7576668 100755..100644
--- a/library/msgs/sr.msg
+++ b/library/msgs/sr.msg
diff --git a/library/msgs/sv.msg b/library/msgs/sv.msg
index f7a67c6..f7a67c6 100755..100644
--- a/library/msgs/sv.msg
+++ b/library/msgs/sv.msg
diff --git a/library/msgs/sw.msg b/library/msgs/sw.msg
index b888b43..b888b43 100755..100644
--- a/library/msgs/sw.msg
+++ b/library/msgs/sw.msg
diff --git a/library/msgs/ta.msg b/library/msgs/ta.msg
index 4abb90c..4abb90c 100755..100644
--- a/library/msgs/ta.msg
+++ b/library/msgs/ta.msg
diff --git a/library/msgs/ta_in.msg b/library/msgs/ta_in.msg
index 24590ac..24590ac 100755..100644
--- a/library/msgs/ta_in.msg
+++ b/library/msgs/ta_in.msg
diff --git a/library/msgs/te.msg b/library/msgs/te.msg
index 6111473..6111473 100755..100644
--- a/library/msgs/te.msg
+++ b/library/msgs/te.msg
diff --git a/library/msgs/te_in.msg b/library/msgs/te_in.msg
index 61638b5..61638b5 100755..100644
--- a/library/msgs/te_in.msg
+++ b/library/msgs/te_in.msg
diff --git a/library/msgs/th.msg b/library/msgs/th.msg
index 7486c35..7486c35 100755..100644
--- a/library/msgs/th.msg
+++ b/library/msgs/th.msg
diff --git a/library/msgs/tr.msg b/library/msgs/tr.msg
index 7b2ecf9..7b2ecf9 100755..100644
--- a/library/msgs/tr.msg
+++ b/library/msgs/tr.msg
diff --git a/library/msgs/uk.msg b/library/msgs/uk.msg
index 7d4c64a..7d4c64a 100755..100644
--- a/library/msgs/uk.msg
+++ b/library/msgs/uk.msg
diff --git a/library/msgs/vi.msg b/library/msgs/vi.msg
index c98b2a6..c98b2a6 100755..100644
--- a/library/msgs/vi.msg
+++ b/library/msgs/vi.msg
diff --git a/library/msgs/zh.msg b/library/msgs/zh.msg
index b799a32..b799a32 100755..100644
--- a/library/msgs/zh.msg
+++ b/library/msgs/zh.msg
diff --git a/library/msgs/zh_cn.msg b/library/msgs/zh_cn.msg
index d62ce77..d62ce77 100755..100644
--- a/library/msgs/zh_cn.msg
+++ b/library/msgs/zh_cn.msg
diff --git a/library/msgs/zh_hk.msg b/library/msgs/zh_hk.msg
index badb1dd..badb1dd 100755..100644
--- a/library/msgs/zh_hk.msg
+++ b/library/msgs/zh_hk.msg
diff --git a/library/msgs/zh_sg.msg b/library/msgs/zh_sg.msg
index a2f3e39..a2f3e39 100755..100644
--- a/library/msgs/zh_sg.msg
+++ b/library/msgs/zh_sg.msg
diff --git a/library/msgs/zh_tw.msg b/library/msgs/zh_tw.msg
index e0796b1..e0796b1 100755..100644
--- a/library/msgs/zh_tw.msg
+++ b/library/msgs/zh_tw.msg
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