summaryrefslogtreecommitdiffstats
path: root/tests/auto/qvariant
ModeNameSize
-rw-r--r--.gitignore13logstatsplain
-rw-r--r--qvariant.pro111logstatsplain
-rw-r--r--tst_qvariant.cpp95775logstatsplain
ug_3392070'>bug_3392070 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/crnl-glob10
-rw-r--r--.fossil-settings/encoding-glob10
-rw-r--r--ChangeLog82
-rw-r--r--README2
-rw-r--r--changes459
-rw-r--r--compat/fake-rfc2553.c32
-rw-r--r--compat/fake-rfc2553.h10
-rw-r--r--compat/fixstrtod.c2
-rw-r--r--compat/gettod.c2
-rw-r--r--compat/limits.h22
-rw-r--r--compat/mkstemp.c2
-rw-r--r--compat/opendir.c2
-rw-r--r--compat/strncasecmp.c2
-rw-r--r--compat/strstr.c2
-rw-r--r--compat/strtod.c6
-rw-r--r--compat/strtol.c2
-rw-r--r--compat/strtoul.c6
-rw-r--r--compat/unistd.h2
-rw-r--r--compat/waitpid.c2
-rw-r--r--doc/Access.34
-rw-r--r--doc/AddErrInfo.328
-rw-r--r--doc/Alloc.34
-rw-r--r--doc/AllowExc.36
-rw-r--r--doc/AppInit.36
-rw-r--r--doc/AssocData.34
-rw-r--r--doc/Async.34
-rw-r--r--doc/BackgdErr.34
-rw-r--r--doc/Backslash.36
-rw-r--r--doc/BoolObj.312
-rw-r--r--doc/ByteArrObj.310
-rw-r--r--doc/CallDel.32
-rw-r--r--doc/Cancel.328
-rw-r--r--doc/ChnlStack.32
-rw-r--r--doc/Class.37
-rw-r--r--doc/CmdCmplt.32
-rw-r--r--doc/Concat.32
-rw-r--r--doc/CrtChannel.314
-rw-r--r--doc/CrtChnlHdlr.32
-rw-r--r--doc/CrtCloseHdlr.32
-rw-r--r--doc/CrtCommand.36
-rw-r--r--doc/CrtFileHdlr.32
-rw-r--r--doc/CrtInterp.32
-rw-r--r--doc/CrtMathFnc.36
-rw-r--r--doc/CrtObjCmd.38
-rw-r--r--doc/CrtSlave.312
-rw-r--r--doc/CrtTimerHdlr.32
-rw-r--r--doc/CrtTrace.38
-rw-r--r--doc/DString.34
-rw-r--r--doc/DetachPids.32
-rw-r--r--doc/DictObj.32
-rw-r--r--doc/DoOneEvent.38
-rw-r--r--doc/DoWhenIdle.32
-rw-r--r--doc/DoubleObj.38
-rw-r--r--doc/DumpActiveMemory.36
-rw-r--r--doc/Encoding.3116
-rw-r--r--doc/Ensemble.38
-rw-r--r--doc/Environment.32
-rw-r--r--doc/Eval.38
-rw-r--r--doc/Exit.36
-rw-r--r--doc/ExprLong.36
-rw-r--r--doc/ExprLongObj.32
-rw-r--r--doc/FileSystem.314
-rw-r--r--doc/FindExec.32
-rwxr-xr-xdoc/GetCwd.32
-rw-r--r--doc/GetHostName.36
-rw-r--r--doc/GetIndex.32
-rw-r--r--doc/GetInt.32
-rw-r--r--doc/GetOpnFl.32
-rw-r--r--doc/GetStdChan.312
-rw-r--r--doc/GetTime.32
-rwxr-xr-xdoc/GetVersion.310
-rw-r--r--doc/Hash.312
-rw-r--r--doc/Init.32
-rw-r--r--doc/InitStubs.32
-rw-r--r--doc/IntObj.38
-rw-r--r--doc/Interp.36
-rw-r--r--doc/Limit.32
-rw-r--r--doc/LinkVar.32
-rw-r--r--doc/ListObj.310
-rw-r--r--doc/Load.32
-rw-r--r--doc/Method.311
-rw-r--r--doc/NRE.324
-rw-r--r--doc/Namespace.32
-rw-r--r--doc/Notifier.36
-rw-r--r--doc/OOInitStubs.354
-rw-r--r--doc/Object.36
-rw-r--r--doc/ObjectType.310
-rw-r--r--doc/OpenFileChnl.328
-rw-r--r--doc/OpenTcp.32
-rw-r--r--doc/Panic.36
-rw-r--r--doc/ParseArgs.32
-rw-r--r--doc/ParseCmd.320
-rw-r--r--doc/PkgRequire.38
-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.312
-rw-r--r--doc/SaveResult.38
-rw-r--r--doc/SetChanErr.32
-rw-r--r--doc/SetErrno.32
-rw-r--r--doc/SetRecLmt.32
-rw-r--r--doc/SetResult.36
-rw-r--r--doc/SetVar.36
-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.315
-rw-r--r--doc/SubstObj.32
-rw-r--r--doc/TCL_MEM_DEBUG.32
-rw-r--r--doc/Tcl.n53
-rw-r--r--doc/TclZlib.32
-rw-r--r--doc/Tcl_Main.310
-rw-r--r--doc/Thread.313
-rw-r--r--doc/ToUpper.34
-rw-r--r--doc/TraceCmd.339
-rw-r--r--doc/TraceVar.38
-rw-r--r--doc/Translate.36
-rw-r--r--doc/UniCharIsAlpha.34
-rw-r--r--doc/UpVar.36
-rw-r--r--doc/Utf.318
-rw-r--r--doc/WrongNumArgs.36
-rw-r--r--doc/after.n6
-rw-r--r--doc/append.n4
-rw-r--r--doc/apply.n8
-rw-r--r--doc/array.n4
-rw-r--r--doc/bgerror.n4
-rw-r--r--doc/binary.n44
-rw-r--r--doc/break.n2
-rw-r--r--doc/case.n2
-rw-r--r--doc/catch.n8
-rw-r--r--doc/cd.n2
-rw-r--r--doc/chan.n14
-rw-r--r--doc/class.n2
-rw-r--r--doc/clock.n33
-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.n8
-rw-r--r--doc/define.n2
-rw-r--r--doc/dict.n28
-rw-r--r--doc/encoding.n42
-rw-r--r--doc/eof.n2
-rw-r--r--doc/error.n6
-rw-r--r--doc/eval.n2
-rw-r--r--doc/exec.n75
-rw-r--r--doc/exit.n4
-rw-r--r--doc/expr.n6
-rw-r--r--doc/fconfigure.n8
-rw-r--r--doc/fcopy.n39
-rw-r--r--doc/file.n42
-rw-r--r--doc/fileevent.n6
-rw-r--r--doc/filename.n12
-rw-r--r--doc/flush.n2
-rw-r--r--doc/for.n6
-rw-r--r--doc/foreach.n2
-rw-r--r--doc/format.n40
-rw-r--r--doc/gets.n2
-rw-r--r--doc/glob.n10
-rw-r--r--doc/global.n6
-rw-r--r--doc/history.n2
-rw-r--r--doc/http.n15
-rw-r--r--doc/if.n2
-rw-r--r--doc/incr.n2
-rw-r--r--doc/info.n2
-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.n22
-rw-r--r--doc/lindex.n8
-rw-r--r--doc/linsert.n6
-rw-r--r--doc/list.n2
-rw-r--r--doc/llength.n6
-rw-r--r--doc/lmap.n6
-rw-r--r--doc/load.n2
-rw-r--r--doc/lrange.n6
-rw-r--r--doc/lrepeat.n2
-rw-r--r--doc/lreplace.n4
-rw-r--r--doc/lreverse.n2
-rw-r--r--doc/lsearch.n10
-rwxr-xr-xdoc/lset.n10
-rw-r--r--doc/lsort.n10
-rw-r--r--doc/mathfunc.n10
-rw-r--r--doc/mathop.n2
-rw-r--r--doc/memory.n12
-rw-r--r--doc/msgcat.n312
-rw-r--r--doc/my.n4
-rw-r--r--doc/namespace.n2
-rw-r--r--doc/next.n25
-rw-r--r--doc/object.n2
-rw-r--r--doc/open.n69
-rw-r--r--doc/package.n6
-rw-r--r--doc/packagens.n2
-rw-r--r--doc/pid.n2
-rw-r--r--doc/pkgMkIndex.n8
-rw-r--r--doc/platform.n2
-rw-r--r--doc/platform_shell.n2
-rw-r--r--doc/prefix.n2
-rw-r--r--doc/proc.n16
-rw-r--r--doc/puts.n2
-rw-r--r--doc/pwd.n2
-rw-r--r--doc/re_syntax.n26
-rw-r--r--doc/read.n8
-rw-r--r--doc/refchan.n2
-rw-r--r--doc/regexp.n8
-rw-r--r--doc/registry.n2
-rw-r--r--doc/regsub.n6
-rw-r--r--doc/rename.n2
-rw-r--r--doc/return.n14
-rw-r--r--doc/safe.n48
-rw-r--r--doc/scan.n34
-rw-r--r--doc/seek.n2
-rw-r--r--doc/self.n2
-rw-r--r--doc/set.n8
-rw-r--r--doc/socket.n10
-rw-r--r--doc/source.n4
-rw-r--r--doc/split.n2
-rw-r--r--doc/string.n56
-rw-r--r--doc/subst.n6
-rw-r--r--doc/switch.n2
-rw-r--r--doc/tailcall.n2
-rw-r--r--doc/tclsh.12
-rw-r--r--doc/tcltest.n68
-rw-r--r--doc/tclvars.n32
-rw-r--r--doc/tell.n2
-rw-r--r--doc/throw.n2
-rw-r--r--doc/time.n2
-rw-r--r--doc/tm.n2
-rw-r--r--doc/trace.n4
-rw-r--r--doc/transchan.n4
-rw-r--r--doc/try.n4
-rw-r--r--doc/unknown.n10
-rw-r--r--doc/unload.n8
-rw-r--r--doc/unset.n4
-rw-r--r--doc/update.n4
-rw-r--r--doc/uplevel.n4
-rw-r--r--doc/upvar.n4
-rw-r--r--doc/variable.n4
-rw-r--r--doc/vwait.n4
-rw-r--r--doc/while.n4
-rw-r--r--doc/zlib.n6
-rw-r--r--generic/regc_color.c15
-rw-r--r--generic/regc_cvec.c1
-rw-r--r--generic/regc_lex.c37
-rw-r--r--generic/regc_locale.c727
-rw-r--r--generic/regc_nfa.c1951
-rw-r--r--generic/regcomp.c246
-rw-r--r--generic/regcustom.h8
-rw-r--r--generic/rege_dfa.c29
-rw-r--r--generic/regerror.c4
-rw-r--r--generic/regerrs.h2
-rw-r--r--generic/regex.h62
-rw-r--r--generic/regexec.c1049
-rw-r--r--generic/regguts.h81
-rw-r--r--generic/tcl.decls14
-rw-r--r--generic/tcl.h121
-rw-r--r--generic/tclAlloc.c2
-rw-r--r--generic/tclAssembly.c45
-rw-r--r--generic/tclBasic.c645
-rw-r--r--generic/tclBinary.c382
-rw-r--r--generic/tclClock.c97
-rw-r--r--generic/tclCmdAH.c4
-rw-r--r--generic/tclCmdIL.c129
-rw-r--r--generic/tclCmdMZ.c150
-rw-r--r--generic/tclCompCmds.c942
-rw-r--r--generic/tclCompCmdsGR.c746
-rw-r--r--generic/tclCompCmdsSZ.c975
-rw-r--r--generic/tclCompExpr.c196
-rw-r--r--generic/tclCompile.c1447
-rw-r--r--generic/tclCompile.h167
-rw-r--r--generic/tclDate.c8
-rw-r--r--generic/tclDecls.h53
-rw-r--r--generic/tclDictObj.c286
-rw-r--r--generic/tclDisassemble.c1503
-rw-r--r--generic/tclEncoding.c119
-rw-r--r--generic/tclEnsemble.c109
-rw-r--r--generic/tclEnv.c185
-rw-r--r--generic/tclEvent.c59
-rw-r--r--generic/tclExecute.c2112
-rw-r--r--generic/tclFCmd.c8
-rw-r--r--generic/tclFileName.c12
-rw-r--r--generic/tclFileSystem.h4
-rw-r--r--generic/tclHash.c2
-rw-r--r--generic/tclHistory.c4
-rw-r--r--generic/tclIO.c3694
-rw-r--r--generic/tclIO.h36
-rw-r--r--generic/tclIOCmd.c37
-rw-r--r--generic/tclIOGT.c198
-rw-r--r--generic/tclIORChan.c369
-rw-r--r--generic/tclIORTrans.c119
-rw-r--r--generic/tclIOSock.c40
-rw-r--r--generic/tclIOUtil.c187
-rw-r--r--generic/tclInt.decls11
-rw-r--r--generic/tclInt.h164
-rw-r--r--generic/tclIntDecls.h14
-rw-r--r--generic/tclIntPlatDecls.h30
-rw-r--r--generic/tclInterp.c59
-rw-r--r--generic/tclListObj.c44
-rw-r--r--generic/tclLiteral.c32
-rw-r--r--generic/tclLoad.c4
-rw-r--r--generic/tclLoadNone.c18
-rw-r--r--generic/tclMain.c9
-rw-r--r--generic/tclNamesp.c209
-rw-r--r--generic/tclNotify.c6
-rw-r--r--generic/tclOO.c147
-rw-r--r--generic/tclOO.decls20
-rw-r--r--generic/tclOO.h38
-rw-r--r--generic/tclOOBasic.c51
-rw-r--r--generic/tclOOCall.c99
-rw-r--r--generic/tclOODecls.h80
-rw-r--r--generic/tclOODefineCmds.c26
-rw-r--r--generic/tclOOInfo.c124
-rw-r--r--generic/tclOOInt.h5
-rw-r--r--generic/tclOOIntDecls.h41
-rw-r--r--generic/tclOOMethod.c75
-rw-r--r--generic/tclOOStubLib.c2
-rw-r--r--generic/tclObj.c92
-rw-r--r--generic/tclOptimize.c26
-rw-r--r--generic/tclPanic.c17
-rw-r--r--generic/tclParse.c121
-rw-r--r--generic/tclPathObj.c24
-rw-r--r--generic/tclPkg.c2
-rw-r--r--generic/tclPlatDecls.h14
-rw-r--r--generic/tclPreserve.c3
-rw-r--r--generic/tclProc.c480
-rw-r--r--generic/tclRegexp.c9
-rw-r--r--generic/tclResult.c4
-rw-r--r--generic/tclScan.c10
-rwxr-xr-xgeneric/tclStrToD.c46
-rw-r--r--generic/tclStringObj.c168
-rw-r--r--generic/tclStringRep.h97
-rw-r--r--generic/tclStringTrim.h43
-rw-r--r--generic/tclStubInit.c54
-rw-r--r--generic/tclTest.c162
-rw-r--r--generic/tclTestProcBodyObj.c4
-rw-r--r--generic/tclThread.c15
-rwxr-xr-xgeneric/tclThreadAlloc.c165
-rw-r--r--generic/tclThreadJoin.c4
-rw-r--r--generic/tclThreadStorage.c6
-rw-r--r--generic/tclThreadTest.c6
-rw-r--r--generic/tclTomMath.decls23
-rw-r--r--generic/tclTomMathDecls.h25
-rw-r--r--generic/tclTrace.c26
-rw-r--r--generic/tclUniData.c1701
-rw-r--r--generic/tclUtf.c125
-rw-r--r--generic/tclUtil.c184
-rw-r--r--generic/tclVar.c281
-rw-r--r--generic/tclZlib.c184
-rw-r--r--library/auto.tcl69
-rw-r--r--library/clock.tcl150
-rw-r--r--library/encoding/jis0208.enc12
-rw-r--r--library/http/http.tcl66
-rw-r--r--library/http/pkgIndex.tcl2
-rw-r--r--library/init.tcl29
-rw-r--r--library/msgcat/msgcat.tcl731
-rw-r--r--library/msgcat/pkgIndex.tcl2
-rw-r--r--library/opt/optparse.tcl4
-rw-r--r--library/package.tcl2
-rw-r--r--library/parray.tcl2
-rw-r--r--library/platform/pkgIndex.tcl2
-rw-r--r--library/platform/platform.tcl56
-rw-r--r--library/platform/shell.tcl2
-rwxr-xr-xlibrary/reg/pkgIndex.tcl4
-rw-r--r--library/safe.tcl4
-rw-r--r--library/tcltest/pkgIndex.tcl2
-rw-r--r--library/tcltest/tcltest.tcl164
-rw-r--r--library/tm.tcl11
-rw-r--r--library/tzdata/Africa/Accra32
-rw-r--r--library/tzdata/Africa/Addis_Ababa8
-rwxr-xr-xlibrary/tzdata/Africa/Asmara9
-rw-r--r--library/tzdata/Africa/Asmera6
-rw-r--r--library/tzdata/Africa/Bamako9
-rw-r--r--library/tzdata/Africa/Bangui7
-rw-r--r--library/tzdata/Africa/Banjul9
-rw-r--r--library/tzdata/Africa/Bissau2
-rw-r--r--library/tzdata/Africa/Blantyre7
-rw-r--r--library/tzdata/Africa/Brazzaville7
-rw-r--r--library/tzdata/Africa/Bujumbura7
-rw-r--r--library/tzdata/Africa/Cairo4
-rw-r--r--library/tzdata/Africa/Casablanca374
-rw-r--r--library/tzdata/Africa/Conakry9
-rw-r--r--library/tzdata/Africa/Dakar8
-rw-r--r--library/tzdata/Africa/Dar_es_Salaam9
-rw-r--r--library/tzdata/Africa/Djibouti7
-rw-r--r--library/tzdata/Africa/Douala7
-rw-r--r--library/tzdata/Africa/El_Aaiun212
-rw-r--r--library/tzdata/Africa/Freetown37
-rw-r--r--library/tzdata/Africa/Gaborone10
-rw-r--r--library/tzdata/Africa/Harare7
-rw-r--r--library/tzdata/Africa/Juba40
-rw-r--r--library/tzdata/Africa/Kampala10
-rw-r--r--library/tzdata/Africa/Kigali7
-rw-r--r--library/tzdata/Africa/Kinshasa7
-rw-r--r--library/tzdata/Africa/Libreville7
-rw-r--r--library/tzdata/Africa/Lome7
-rw-r--r--library/tzdata/Africa/Luanda8
-rw-r--r--library/tzdata/Africa/Lubumbashi7
-rw-r--r--library/tzdata/Africa/Lusaka7
-rw-r--r--library/tzdata/Africa/Malabo8
-rw-r--r--library/tzdata/Africa/Maseru9
-rw-r--r--library/tzdata/Africa/Mbabane7
-rw-r--r--library/tzdata/Africa/Mogadishu9
-rw-r--r--library/tzdata/Africa/Niamey9
-rw-r--r--library/tzdata/Africa/Nouakchott9
-rw-r--r--library/tzdata/Africa/Ouagadougou7
-rw-r--r--library/tzdata/Africa/Porto-Novo8
-rw-r--r--library/tzdata/Africa/Sao_Tome8
-rw-r--r--library/tzdata/Africa/Timbuktu6
-rw-r--r--library/tzdata/Africa/Tripoli174
-rw-r--r--library/tzdata/America/Adak466
-rw-r--r--library/tzdata/America/Anguilla7
-rw-r--r--library/tzdata/America/Antigua8
-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/Cancun171
-rw-r--r--library/tzdata/America/Caracas1
-rw-r--r--library/tzdata/America/Cayman8
-rw-r--r--library/tzdata/America/Dominica7
-rw-r--r--library/tzdata/America/Eirunepe1
-rw-r--r--library/tzdata/America/Fort_Nelson151
-rw-r--r--library/tzdata/America/Grand_Turk175
-rw-r--r--library/tzdata/America/Grenada7
-rw-r--r--library/tzdata/America/Guadeloupe7
-rw-r--r--library/tzdata/America/Havana2
-rw-r--r--library/tzdata/America/Jamaica9
-rw-r--r--library/tzdata/America/Marigot6
-rw-r--r--library/tzdata/America/Metlakatla171
-rw-r--r--library/tzdata/America/Montevideo169
-rw-r--r--library/tzdata/America/Montreal367
-rw-r--r--library/tzdata/America/Montserrat7
-rw-r--r--library/tzdata/America/Port-au-Prince168
-rw-r--r--library/tzdata/America/Rio_Branco1
-rw-r--r--library/tzdata/America/Santa_Isabel285
-rw-r--r--library/tzdata/America/Santiago356
-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/Casey6
-rw-r--r--library/tzdata/Antarctica/Macquarie180
-rw-r--r--library/tzdata/Antarctica/McMurdo258
-rw-r--r--library/tzdata/Antarctica/Palmer342
-rw-r--r--library/tzdata/Antarctica/South_Pole6
-rw-r--r--library/tzdata/Antarctica/Troll196
-rw-r--r--library/tzdata/Asia/Aden7
-rw-r--r--library/tzdata/Asia/Almaty103
-rw-r--r--library/tzdata/Asia/Amman3
-rw-r--r--library/tzdata/Asia/Anadyr4
-rw-r--r--library/tzdata/Asia/Aqtau107
-rw-r--r--library/tzdata/Asia/Aqtobe105
-rw-r--r--library/tzdata/Asia/Bahrain8
-rw-r--r--library/tzdata/Asia/Baku170
-rw-r--r--library/tzdata/Asia/Barnaul73
-rw-r--r--library/tzdata/Asia/Chita72
-rw-r--r--library/tzdata/Asia/Choibalsan171
-rw-r--r--library/tzdata/Asia/Chongqing20
-rw-r--r--library/tzdata/Asia/Chungking6
-rw-r--r--library/tzdata/Asia/Dhaka2
-rw-r--r--library/tzdata/Asia/Dili2
-rw-r--r--library/tzdata/Asia/Gaza348
-rw-r--r--library/tzdata/Asia/Harbin23
-rw-r--r--library/tzdata/Asia/Hebron348
-rw-r--r--library/tzdata/Asia/Ho_Chi_Minh13
-rw-r--r--library/tzdata/Asia/Hovd170
-rw-r--r--library/tzdata/Asia/Irkutsk11
-rw-r--r--library/tzdata/Asia/Jakarta12
-rw-r--r--library/tzdata/Asia/Jayapura6
-rw-r--r--library/tzdata/Asia/Jerusalem4
-rw-r--r--library/tzdata/Asia/Kamchatka4
-rw-r--r--library/tzdata/Asia/Karachi4
-rw-r--r--library/tzdata/Asia/Kashgar21
-rw-r--r--library/tzdata/Asia/Khandyga5
-rw-r--r--library/tzdata/Asia/Krasnoyarsk9
-rw-r--r--library/tzdata/Asia/Kuwait7
-rw-r--r--library/tzdata/Asia/Magadan6
-rw-r--r--library/tzdata/Asia/Makassar4
-rw-r--r--library/tzdata/Asia/Muscat7
-rw-r--r--library/tzdata/Asia/Novokuznetsk9
-rw-r--r--library/tzdata/Asia/Novosibirsk5
-rw-r--r--library/tzdata/Asia/Omsk9
-rw-r--r--library/tzdata/Asia/Oral106
-rw-r--r--library/tzdata/Asia/Phnom_Penh10
-rw-r--r--library/tzdata/Asia/Pontianak12
-rw-r--r--library/tzdata/Asia/Pyongyang11
-rw-r--r--library/tzdata/Asia/Qyzylorda105
-rw-r--r--library/tzdata/Asia/Riyadh2
-rw-r--r--library/tzdata/Asia/Sakhalin10
-rw-r--r--library/tzdata/Asia/Samarkand4
-rw-r--r--library/tzdata/Asia/Seoul35
-rw-r--r--library/tzdata/Asia/Shanghai4
-rw-r--r--library/tzdata/Asia/Srednekolymsk71
-rw-r--r--library/tzdata/Asia/Taipei16
-rw-r--r--library/tzdata/Asia/Tashkent4
-rw-r--r--library/tzdata/Asia/Tbilisi6
-rw-r--r--library/tzdata/Asia/Tehran124
-rw-r--r--library/tzdata/Asia/Tokyo4
-rw-r--r--library/tzdata/Asia/Tomsk73
-rw-r--r--library/tzdata/Asia/Ulaanbaatar170
-rw-r--r--library/tzdata/Asia/Urumqi15
-rw-r--r--library/tzdata/Asia/Ust-Nera5
-rw-r--r--library/tzdata/Asia/Vientiane10
-rw-r--r--library/tzdata/Asia/Vladivostok15
-rw-r--r--library/tzdata/Asia/Yakutsk9
-rw-r--r--library/tzdata/Asia/Yekaterinburg10
-rw-r--r--library/tzdata/Asia/Yerevan6
-rw-r--r--library/tzdata/Atlantic/Azores2
-rw-r--r--library/tzdata/Atlantic/Canary1
-rw-r--r--library/tzdata/Atlantic/Madeira2
-rw-r--r--library/tzdata/Atlantic/Reykjavik11
-rw-r--r--library/tzdata/Atlantic/St_Helena8
-rw-r--r--library/tzdata/Australia/Adelaide536
-rw-r--r--library/tzdata/Australia/Brisbane36
-rw-r--r--library/tzdata/Australia/Broken_Hill540
-rw-r--r--library/tzdata/Australia/Currie536
-rw-r--r--library/tzdata/Australia/Darwin20
-rwxr-xr-xlibrary/tzdata/Australia/Eucla40
-rw-r--r--library/tzdata/Australia/Hobart552
-rw-r--r--library/tzdata/Australia/Lindeman46
-rw-r--r--library/tzdata/Australia/Lord_Howe240
-rw-r--r--library/tzdata/Australia/Melbourne534
-rw-r--r--library/tzdata/Australia/Perth40
-rw-r--r--library/tzdata/Australia/Sydney534
-rw-r--r--library/tzdata/Europe/Astrakhan71
-rw-r--r--library/tzdata/Europe/Budapest10
-rw-r--r--library/tzdata/Europe/Chisinau418
-rw-r--r--library/tzdata/Europe/Helsinki8
-rw-r--r--library/tzdata/Europe/Istanbul6
-rw-r--r--library/tzdata/Europe/Kaliningrad15
-rw-r--r--library/tzdata/Europe/Kiev6
-rw-r--r--library/tzdata/Europe/Kirov70
-rw-r--r--library/tzdata/Europe/Lisbon6
-rw-r--r--library/tzdata/Europe/Minsk4
-rw-r--r--library/tzdata/Europe/Moscow26
-rw-r--r--library/tzdata/Europe/Riga14
-rw-r--r--library/tzdata/Europe/Samara24
-rw-r--r--library/tzdata/Europe/Simferopol175
-rw-r--r--library/tzdata/Europe/Sofia1
-rw-r--r--library/tzdata/Europe/Tallinn3
-rw-r--r--library/tzdata/Europe/Ulyanovsk73
-rw-r--r--library/tzdata/Europe/Vaduz246
-rw-r--r--library/tzdata/Europe/Vilnius11
-rwxr-xr-xlibrary/tzdata/Europe/Volgograd86
-rw-r--r--library/tzdata/Europe/Zurich4
-rw-r--r--library/tzdata/Indian/Antananarivo9
-rw-r--r--library/tzdata/Indian/Comoro7
-rw-r--r--library/tzdata/Indian/Mayotte7
-rw-r--r--library/tzdata/Pacific/Apia188
-rw-r--r--library/tzdata/Pacific/Bougainville10
-rw-r--r--library/tzdata/Pacific/Chatham3
-rw-r--r--library/tzdata/Pacific/Easter353
-rw-r--r--library/tzdata/Pacific/Fiji248
-rw-r--r--library/tzdata/Pacific/Johnston6
-rw-r--r--library/tzdata/Pacific/Midway11
-rw-r--r--library/tzdata/Pacific/Norfolk3
-rw-r--r--library/tzdata/Pacific/Pago_Pago3
-rw-r--r--library/tzdata/Pacific/Saipan10
-rw-r--r--library/word.tcl16
-rw-r--r--license.terms4
-rw-r--r--macosx/GNUmakefile2
-rw-r--r--macosx/Tcl.xcode/project.pbxproj2
-rw-r--r--macosx/Tcl.xcodeproj/project.pbxproj2
-rw-r--r--macosx/configure.ac2
-rw-r--r--macosx/tclMacOSXNotify.c3
-rw-r--r--pkgs/README6
-rw-r--r--pkgs/package.list.txt11
-rw-r--r--tests/aaa_exit.test54
-rw-r--r--tests/all.tcl3
-rw-r--r--tests/append.test17
-rw-r--r--tests/appendComp.test21
-rw-r--r--tests/assemble.test86
-rw-r--r--tests/binary.test103
-rw-r--r--tests/chanio.test22
-rw-r--r--tests/clock.test47
-rw-r--r--tests/cmdAH.test13
-rw-r--r--tests/compile.test235
-rw-r--r--tests/coroutine.test127
-rw-r--r--tests/dict.test206
-rw-r--r--tests/env.test43
-rw-r--r--tests/error.test16
-rw-r--r--tests/exec.test6
-rw-r--r--tests/execute.test23
-rw-r--r--tests/expr.test4
-rw-r--r--tests/fCmd.test96
-rw-r--r--tests/fileSystem.test3
-rw-r--r--tests/for.test408
-rw-r--r--tests/foreach.test11
-rw-r--r--tests/http.test40
-rw-r--r--tests/http11.test33
-rw-r--r--tests/httpd11.tcl25
-rw-r--r--tests/interp.test4
-rw-r--r--tests/io.test876
-rw-r--r--tests/ioCmd.test125
-rw-r--r--tests/ioTrans.test230
-rw-r--r--tests/iogt.test183
-rw-r--r--tests/load.test6
-rw-r--r--tests/lreplace.test112
-rw-r--r--tests/msgcat.test418
-rw-r--r--tests/namespace.test54
-rw-r--r--tests/nre.test25
-rw-r--r--tests/obj.test4
-rw-r--r--tests/oo.test217
-rw-r--r--tests/ooNext2.test279
-rw-r--r--tests/parse.test36
-rw-r--r--tests/parseExpr.test14
-rw-r--r--tests/parseOld.test19
-rw-r--r--tests/platform.test19
-rw-r--r--tests/reg.test69
-rw-r--r--tests/regexp.test18
-rw-r--r--tests/regexpComp.test21
-rw-r--r--tests/registry.test4
-rw-r--r--tests/safe.test2
-rw-r--r--tests/scan.test17
-rw-r--r--tests/set-old.test5
-rw-r--r--tests/socket.test666
-rw-r--r--tests/source.test10
-rw-r--r--tests/string.test47
-rw-r--r--tests/stringComp.test90
-rw-r--r--tests/stringObj.test19
-rw-r--r--tests/subst.test20
-rw-r--r--tests/switch.test8
-rw-r--r--tests/tailcall.test30
-rwxr-xr-xtests/tcltest.test36
-rw-r--r--tests/thread.test32
-rw-r--r--tests/unixFCmd.test4
-rw-r--r--tests/uplevel.test99
-rw-r--r--tests/upvar.test44
-rw-r--r--tests/utf.test152
-rw-r--r--tests/util.test5
-rw-r--r--tests/var.test90
-rw-r--r--tests/winFCmd.test159
-rw-r--r--tests/winFile.test18
-rw-r--r--tests/winPipe.test8
-rw-r--r--tests/zlib.test58
-rw-r--r--tools/Makefile.in4
-rwxr-xr-xtools/findBadExternals.tcl4
-rw-r--r--tools/genStubs.tcl15
-rwxr-xr-xtools/loadICU.tcl12
-rwxr-xr-xtools/makeTestCases.tcl132
-rw-r--r--tools/man2help.tcl2
-rw-r--r--tools/man2help2.tcl2
-rw-r--r--tools/man2html.tcl10
-rw-r--r--tools/man2html1.tcl20
-rw-r--r--tools/man2html2.tcl2
-rw-r--r--tools/mkdepend.tcl14
-rw-r--r--tools/tcl.hpj.in38
-rwxr-xr-xtools/tclZIC.tcl2
-rw-r--r--tools/tcltk-man2html-utils.tcl3
-rwxr-xr-xtools/tcltk-man2html.tcl17
-rw-r--r--tools/uniParse.tcl6
-rw-r--r--unix/Makefile.in118
-rwxr-xr-xunix/configure290
-rw-r--r--unix/configure.in5
-rw-r--r--unix/dltest/Makefile.in15
-rw-r--r--unix/dltest/pkge.c2
-rw-r--r--unix/dltest/pkgooa.c141
-rwxr-xr-xunix/ldAix6
-rw-r--r--unix/tcl.m4104
-rw-r--r--unix/tcl.pc.in8
-rw-r--r--unix/tcl.spec4
-rw-r--r--unix/tclConfig.h.in38
-rw-r--r--unix/tclConfig.sh.in2
-rw-r--r--unix/tclLoadDl.c25
-rw-r--r--unix/tclLoadDyld.c1
-rw-r--r--unix/tclUnixChan.c46
-rw-r--r--unix/tclUnixFCmd.c190
-rw-r--r--unix/tclUnixFile.c13
-rw-r--r--unix/tclUnixInit.c34
-rw-r--r--unix/tclUnixNotfy.c359
-rw-r--r--unix/tclUnixPipe.c14
-rw-r--r--unix/tclUnixPort.h22
-rw-r--r--unix/tclUnixSock.c437
-rw-r--r--unix/tclUnixTest.c29
-rw-r--r--unix/tclUnixThrd.c2
-rw-r--r--unix/tclUnixThrd.h2
-rw-r--r--unix/tclUnixTime.c5
-rw-r--r--unix/tclXtTest.c19
-rw-r--r--unix/tclooConfig.sh2
-rw-r--r--win/Makefile.in98
-rw-r--r--win/README2
-rwxr-xr-xwin/buildall.vc.bat206
-rw-r--r--win/coffbase.txt85
-rwxr-xr-xwin/configure92
-rw-r--r--win/configure.in32
-rw-r--r--win/makefile.bc1183
-rw-r--r--win/makefile.vc2462
-rw-r--r--win/nmakehlp.c6
-rw-r--r--win/rules.vc1396
-rw-r--r--win/tcl.dsp3134
-rw-r--r--win/tcl.dsw58
-rw-r--r--win/tcl.hpj.in38
-rw-r--r--win/tcl.m452
-rw-r--r--win/tcl.rc2
-rw-r--r--win/tclAppInit.c3
-rw-r--r--win/tclConfig.sh.in4
-rw-r--r--win/tclWin32Dll.c39
-rw-r--r--win/tclWinChan.c133
-rw-r--r--win/tclWinConsole.c27
-rw-r--r--win/tclWinError.c4
-rw-r--r--win/tclWinFCmd.c55
-rw-r--r--win/tclWinFile.c128
-rw-r--r--win/tclWinInit.c39
-rw-r--r--win/tclWinInt.h19
-rw-r--r--win/tclWinLoad.c62
-rw-r--r--win/tclWinPipe.c24
-rw-r--r--win/tclWinPort.h17
-rw-r--r--win/tclWinReg.c100
-rw-r--r--win/tclWinSerial.c29
-rw-r--r--win/tclWinSock.c3508
-rw-r--r--win/tclWinTest.c49
-rw-r--r--win/tclWinThrd.c11
-rw-r--r--win/tclooConfig.sh2
-rw-r--r--win/tclsh.exe.manifest.in53
-rw-r--r--win/tclsh.rc13
726 files changed, 38314 insertions, 25793 deletions
diff --git a/.fossil-settings/crnl-glob b/.fossil-settings/crnl-glob
index e69de29..c014320 100644
--- a/.fossil-settings/crnl-glob
+++ b/.fossil-settings/crnl-glob
@@ -0,0 +1,10 @@
+tools/tcl.hpj.in
+tools/tcl.wse.in
+win/buildall.vc.bat
+win/coffbase.txt
+win/makefile.bc
+win/makefile.vc
+win/rules.vc
+win/tcl.dsp
+win/tcl.dsw
+win/tcl.hpj.in
diff --git a/.fossil-settings/encoding-glob b/.fossil-settings/encoding-glob
new file mode 100644
index 0000000..c014320
--- /dev/null
+++ b/.fossil-settings/encoding-glob
@@ -0,0 +1,10 @@
+tools/tcl.hpj.in
+tools/tcl.wse.in
+win/buildall.vc.bat
+win/coffbase.txt
+win/makefile.bc
+win/makefile.vc
+win/rules.vc
+win/tcl.dsp
+win/tcl.dsw
+win/tcl.hpj.in
diff --git a/ChangeLog b/ChangeLog
index ddde893..e2881a0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,58 @@
+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
@@ -36,12 +91,13 @@
2013-06-27 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclConfig.c: Bug [9b2e636361]: Tcl_CreateInterp() needs initialized
- * generic/tclMain.c: encodings.
+ * 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.
+ * generic/tclEvent.c: Bug [3611974]: InitSubsystems multiple thread
+ issue.
2013-06-17 Jan Nijtmans <nijtmans@users.sf.net>
@@ -153,10 +209,10 @@
* 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.
+ 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>
@@ -174,8 +230,8 @@
* 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.
+ 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
@@ -857,6 +913,14 @@
* win/nmakehlp.c: Let "nmakehlp -V" start searching digits after the
found match (suggested by Harald Oehlmann).
+2012-09-19 Harald Oehlmann <oehhar@users.sf.net>
+
+ IMPLEMENTATION OF TIP#412.
+
+ * library/msgcat/msgcat.tcl: dynamic locale change with mc file
+ * library/clock.tcl: load on locale change.
+ clock uses new msgcat features.
+
2012-09-07 Harald Oehlmann <oehhar@users.sf.net>
*** 8.6b3 TAGGED FOR RELEASE ***
diff --git a/README b/README
index 8ecd7a9..f3e50dd 100644
--- a/README
+++ b/README
@@ -1,5 +1,5 @@
README: Tcl
- This is the Tcl 8.6.0 source distribution.
+ This is the Tcl 8.6.5 source distribution.
http://sourceforge.net/projects/tcl/files/Tcl/
You can get any source release of Tcl from the URL above.
diff --git a/changes b/changes
index d3bbb43..1e24269 100644
--- a/changes
+++ b/changes
@@ -8164,6 +8164,463 @@ Dropped support for OS X versions less than 10.4 (Tiger) (fellows)
--- Released 8.6.0, December 20, 2012 --- See ChangeLog for details ---
-2013-05-08 (bug fix)[3036566] Honor language packs on Vista+ to get initial locale (oehlmann)
+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-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, September 20, 2013 --- http://core.tcl.tk/tcl/ for details
+
+2013-09-27 (enhancement) improved ::env synchronization (fellows)
+
+2013-10-20 (bug fix)[2835313] segfault from
+[apply {{} {while 1 {a {*}[return -level 0 -code continue]}}}] (fellows)
+
+2013-10-22 (bug fix)[3556215] [scan %E%G%X] support (fellows)
+
+2013-10-25 (bug fix)[3eb2ec1] upper case scheme names in url. (nijtmans)
+=> http 2.8.8
+
+2013-10-29 (bug fix)[414d103] HP-UX: restore [exec] in threaded Tcl (nijtmans)
+
+2013-11-04 (bug fix) C++ friendly stubs struct declarations (nijtmans)
+
+2013-11-05 (bug fix)[426679e] OpenBSD man page rendering (nijtmans)
+
+2013-11-12 (bug fix)[5425f2c] [fconfigure -error] breaks [socket -async]
+
+2013-11-20 (bug fix) Improved environment variable management (nijtmans)
+=> tcltest 2.3.7
+
+2013-11-21 (platforms) Support for Windows 8.1 (nijtmans)
+
+2013-12-06 (RFE) improved [foreach] bytecode (fellows)
+
+2013-12-10 (RFE) improved [lmap] bytecode (sofer)
+
+2013-12-11 (RFE) improved [catch] bytecode (sofer)
+
+2013-12-18 (bug fix)[0b874c3] SEGV [coroutine X coroutine Y info frame] (porter)
+
+2013-12-20 (RFE) reduced numeric conversion in bytecode (sofer)
+
+2014-01-07 (RFE) compilers for [concat], [linsert], [namespace origin],
+[next], [string replace], [string tolower], [string totitle], [string toupper],
+[string trim], [string trimleft], [string trimright] (fellows)
+
+2014-01-22 (RFE) compilers for [nextto], [yieldto] (fellows)
+
+2014-02-02 (RFE) compiler for [string is] (fellows)
+
+2014-02-06 (bug fix)[a4494e2] panic in test namespace-13.2 (porter)
+
+2014-03-20 (bug fix)[2f7cbd0] FreeBSD 10.0 build failure (nijtmans)
+
+2014-03-26 (RFE)[b42b208] Cygwin: [file attr -readonly -archive -hidden -system]
+(nijtmans)
+
+2014-03-27 (bug fix) segfault iocmd-23.11 (porter)
+
+2014-04-02 (bug fix)[581937a] Win: readable event on async connect failure
+
+2014-04-04 (bug fix)[581937a,97069ea] async socket connect fail (oehlmann)
+
+2014-04-10 (bug fix)[792641f] Win: no \ in normalized path (nijtmans)
+
+2014-04-11 (bug fix)[3118489] protect NUL in filenames (nijtmans)
+
+2014-04-15 (bug fix)[88aef05] segfault iocmd-21.20 (porter)
+
+2014-04-16 (update) Win: use Winsock 2.2 (nijtmans)
+
+2014-04-16 (bug fix)[d19a30d] segfault clock-67.[23] (sebres)
+
+2014-04-21 (bug fix) segfault iocmd-21.2[12] (porter)
+
+2014-04-22 (bug fix) segfault iogt-2.4 (porter)
+
+2014-04-23 (bug fix)[3493120] memleak in thread exit
+
+2014-05-08 refactoring of core I/O functions (porter)
+
+2014-05-09 (bug fix)[3389978] Win: extended paths support (nijtmans)
+
+2014-05-09 (bug fix) segfault iocmd-32.1 (porter)
+
+2014-05-11 (bug fix)[6d2f249] nested ensemble compile failure (fellows)
+
+2014-05-17 (RFE)[47d6625] wideint support in [lsearch -integer] [lsort -integer] (nijtmans)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2014-05-20 (bug fix) Stop eof and blocked state leaking thru stacks (porter)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2014-05-20 (bug fix)[13d3af3] Win: socket -async tried only first IP address
+
+2014-05-28 (platforms) work around systems that fail when a shared library
+is deleted after it is [load]ed (kupries)
+
+2014-05-31 (bug fix) chan events on pipes must be on proper ends (porter)
+
+2014-06-04 (bug fix) socket-2.12 (porter)
+
+2014-06-05 (bug fix) io-12.6 (kupries,porter)
+
+2014-06-15 (RFE)[1b0266d] [dict replace|remove] return canonical dict (fellows)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2014-06-16 (bug fix) socket-2.13 workaround broken select() (porter)
+
+2014-06-20 (bug fix)[b47b176] iortrans.tf-11.0 (porter)
+
+2014-06-22 (RFE)[2f9df4c] -cleanup scripts before -out compare (nijtmans)
+
+2014-07-04 (update) Update Unicode data to 7.0 (nijtmans)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2014-07-08 (bug) [chan push] converts blocked writes to error (aspect,porter)
+
+2014-07-10 (bug fix)[7368d2] memleak Tcl_SetVar2(..,TCL_APPEND_VALUE) (porter)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2014-07-11 (bug) leaks in SetFsPathFromAny, [info frame] (porter)
+
+2014-07-15 (bug) compress dict leak in zlib xform channel close (porter)
+
+2014-07-17 (bug fix)[9969cf8] leak trace data in coroutine deletion (porter)
+
+2014-07-18 (RFE)[b43f2b4] fix [lappend] multi performance collapse (fellows)
+
+2014-07-19 (bug fix)[75b8433] memleak managing oo instance lists (porter)
+
+2014-07-21 (bug fix)[e6477e1] memleak in AtForkChild() (porter)
+
+2014-07-22 (bug fix)[12b0997] memleak in iocmd.tf-32.0 (porter)
+
+2014-07-28 (RFE) Optimized binary [chan copy] by moving buffers (porter)
+
+2014-07-30 (enhancement) use refcounts, not Tcl_Preserve to manage lifetime
+of Tcl_Channel (porter)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2014-07-31 (bug fix)[a84a720] double free in oo chain deletion (porter)
+
+2014-08-01 (bug fix)[e75faba] SEGV [apply {{} {namespace upvar a b [x]}}] (porter)
+
+2014-08-01 (update) "macosx*-i386-x86_64" "macosx-universal" no longer compatible (kupries)
+=> platform 1.0.13
+
+2014-08-12 tzdata updated to Olson's tzdata2014f (kenny)
+
+2014-08-17 (bug fix)[7d52e11] [info class subclasses oo::object] should
+include ::oo::class (fellows)
+
+2014-08-25 (TIP 429) New command [string cat] (leitgeb,ferrieux)
+
+--- Released 8.6.2, August 27, 2014 --- http://core.tcl.tk/tcl/ for details
+
+2014-08-28 (bug)[b9e1a3] Correct Method Search Order (nadkarni,fellows)
+=> TclOO 1.0.3
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2014-09-05 (bug)[ccc2c2] Regression [lreplace {} 1 1] (bron,fellows)
+
+2014-09-08 (bug)<oo-1.18.2> Crash regression in [oo::class destroy] (porter)
+
+2014-09-09 (bug)[84af11] Regress [regsub -all {\(.*} a(b) {}] (fellows)
+
+2014-09-10 (bug)[cee90e] [try {} on ok {} - on return {} {}] panic (porter)
+
+2014-09-20 (feature) [tcl::unsupported::getbytecode] disassember (fellows)
+
+2014-09-27 (enhancement) [string cat] bytecode optimization (leitgeb,ferrieux)
+
+2014-09-27 (bug)[82521b] segfault in mangled bytecode (ogilvie,sofer)
+
+2014-10-02 (bug)[bc5b79] Hang in some [read]s of limited size (rogers,porter)
+
+2014-10-03 (bug)[bc1a96] segfault in [array set] of traced array (tab,porter)
+
+2014-10-08 (bug)[59a2e7] MSVC14 compile support (dower,nijtmans)
+
+2014-10-10 (bug)[ed29c4] [fcopy] treats [blocked] as error (rowen,porter)
+
+2014-10-10 (bug)[bf7135] regression in Tcl_Write() interface (porter)
+
+2014-10-18 (bug)[10dc6d] fix [gets] on non-blocking channels (fassel,porter)
+
+2014-10-26 Support for Windows 10 (nijtmans)
+
+2014-10-31 (bug)[dcc034] restore [open comX: r+] (lll,nijtmans)
+
+2014-11-05 (bug)[214cc0] Restore [lappend v] return value (sayers,porter)
+
+2014-11-06 (bug)[5adc35] Stop forcing EOF to be permanent (porter)
+
+--- Released 8.6.3, November 12, 2014 --- http://core.tcl.tk/tcl/ for details
+
+2014-11-21 (bug)[743338] Win: socket error encoding (ladayaroslav,nijtmans)
+
+2014-12-01 (bug) restore tbcload/tclcompiler support (kupries)
+
+2014-12-03 (bug)[0c043a] Fix compiled [set var($) val] (porter)
+
+2014-12-04 (bug)[d2ffcc] Limit $... and bareword parsing to ASCII (ladayaroslav,porter)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2014-12-06 (bug)[c6cd4a] Win: hang in async socket connection (shults,nadkarni)
+
+2014-12-10 tzdata updated to Olson's tzdata2014j (venkat)
+
+2014-12-13 fix header files installation on OS X (houben)
+
+2014-12-17 (TIP 427) [fconfigure $h -connecting, -peername, -sockname] (oehlmann,rmax)
+
+2014-12-18 (bug)[af08c8] Crash in full finalize encoding teardown (porter)
+
+2014-12-18 (bug)[7c187a] [chan copy] crash (io-53.17) (benno,porter)
+
+2015-01-26 (bug)[df0848] Trouble with INFINITY macro (dower,nijtmans)
+
+2015-01-29 (bug) Stop crashes when extension var resolvers misbehave (porter)
+
+2015-01-29 (bug)[088727] [read] past EOF (io-73.4) (fenugrec,porter)
+
+2015-02-11 tzdata updated to Olson's tzdata2015a (venkat)
+
+2015-02-20 (bug)[32b615] Fix compiled [lreplace] (lreplace-4.[345]) (aspect)
+
+2015-03-10 (enhancement) Revise OS X notifier for better Cocoa (walzer)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+--- Released 8.6.4, March 12, 2015 --- http://core.tcl.tk/tcl/ for details
+
+2015-03-19 (bug)[e66e44] Win: Ctrl-C/Ctrl-Break in console not EOF (nadkarni)
+
+2015-03-21 (bug)[d87cb1] Proper tailcall from compiled ensembles (sofer)
+
+2015-04-23 (bug)[19ea02] Win: shared read from linked dirs (bogdan,oehhar)
+
+2015-04-24 (bug)[879a07] Incomplete chars @ buffer ends (leunissen,porter)
+
+2015-04-29 (bug)[894da1] Hang flushing blocking channels (yorick)
+
+2015-05-14 (enhance)[b9d043] Default use of gzip transfer encoding (fellows)
+=> http 2.8.9
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2015-05-15 (bug)[9dd1bd] destructor [self] after failed constructor (calvo,fellows)
+
+2015-05-15 (bug)[0f42ff] [tailcall] combined with [next] (aspect,fellows)
+
+2015-05-18 (bug)[c11a51] http: race condition in -accept option (fellows)
+
+2015-05-19 (enhance) More pure lists from compiled [list] (porter,fellows)
+
+2015-05-27 (enhancement) Relax memdebug constraint on extensions (kupries)
+
+2015-06-03 (bug)[268b23] crash in traced [expr] (execute-11.2)(tomkinson,porter)
+
+2015-06-11 (bug)[478c44] Memleak in zlib compresion errors (mistachkin)
+
+2015-06-16 (bug)[e770d9] Higher baud on serial channels (woods,nijtmans)
+
+2015-06-18 (update) Update Unicode data to 8.0 (nijtmans)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2015-06-18 (bug)[a4cb3f] compiled [lreplace] handling of end (bron,aspect)
+
+2015-06-23 (enhance) Use Unicode SendMessageTimeout() (nijtmans)
+=> registry 1.3.1
+
+2015-06-25 (TIP 412) msgcat dynamic locale change and package private locale (oehlmann)
+=> msgcat 1.6.0
+
+2015-07-05 (bug)[a0ece9] crash in traced [expr] (execute-11.3) (hans,porter)
+
+2015-07-10 (TIP 436) [info object isa] favors 'false' over error (fellows)
+=> TclOO 1.0.4
+
+2015-07-15 (bug)[b1534b][9bad63] writes beyond buffer bounds (hanno,porter)
+
+2015-07-18 (bug)[a3309d] Memleak in compiled [unset a($i)] (jeff,porter)
+
+2015-07-23 (bug)[57945b] lock in forking/multi-threading (neumann,mistachkin)
+
+2015-07-29 (bug)[3e7eca] Allocation overflow in expr parsing (rickyb,porter)
+
+2015-07-30 (bug)[f00009] Win: Memleak in [file] (rp,sebres)
+
+2015-07-31 (bug) Correct problems found in Coverity audit (sofer)
+
+2015-08-19 (bug)[00189c] MSVC 14: semi-static UCRT support (dower,nijtmans)
+
+2015-08-26 (bug)[0df7a1] Tolerate getcwd() failures (cato,nijtmans)
+
+2015-09-21 (bug)[1115587][a3c350][d7ea9f][0e0e15][187d7f] Many fixes and
+improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich)
+
+2015-09-23 (enhance) hash lookup microoptimization (hipp)
+
+2015-09-23 (bug)[e0a7b3] Input buffer draining & file events (griffin,porter)
+
+2015-09-29 (bug)[219866] Cygwin support error (yorick,nijtmans)
+=> platform 1.0.14
+
+2015-10-06 (bug)[b42a85] Win: [file normalize ~user] wrong dir (nadkarni)
+
+2015-10-21 (bug)[1080042][8f2450] More regexp from Postgres (lane,porter)
+
+2015-10-23 (bug)[4a0c16] [clock] react to msgcat locale change (oehlmann)
+
+2015-11-10 (bug)[261a8a] Overflow segfault in I/O translation (brooks,porter)
+
+2015-11-20 (bug)[40f628] ListObjReplace callers fail to detect max (porter)
+
+2015-11-30 (enhance)[32c574] Improve list growth performance (brooks,porter)
+
+2015-12-11 (bug)[c9eb6b] tolerate unset ::env(TZ) (gahr, nijtmans)
+
+2016-01-29 (TIP 440) tcl_platform(engine) -- Tcl implementation (mistachkin)
+
+2016-02-03 (bug)[25842c] stream [zlib deflate] fails with 0 input (ade,fellows)
+
+2016-02-04 (bug)[3d96b7][593baa][cf74de] crashes in OO teardown (porter,fellows)
+
+2016-02-22 (bug)[9b4702] [info exists env(missing)] kills trace (nijtmans)
+
+--- Released 8.6.5, February 29, 2016 --- http://core.tcl.tk/tcl/ for details
diff --git a/compat/fake-rfc2553.c b/compat/fake-rfc2553.c
index 3b91041..c8e69400 100644
--- a/compat/fake-rfc2553.c
+++ b/compat/fake-rfc2553.c
@@ -1,7 +1,7 @@
/*
* Copyright (C) 2000-2003 Damien Miller. All rights reserved.
* Copyright (C) 1999 WIDE Project. All rights reserved.
- *
+ *
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
@@ -13,7 +13,7 @@
* 3. Neither the name of the project nor the names of its contributors
* may be used to endorse or promote products derived from this software
* without specific prior written permission.
- *
+ *
* THIS SOFTWARE IS PROVIDED BY THE PROJECT AND CONTRIBUTORS ``AS IS'' AND
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
@@ -67,7 +67,7 @@ strlcpy(char *dst, const char *src, size_t siz)
}
#endif
-int fake_getnameinfo(const struct sockaddr *sa, size_t salen, char *host,
+int fake_getnameinfo(const struct sockaddr *sa, size_t salen, char *host,
size_t hostlen, char *serv, size_t servlen, int flags)
{
struct sockaddr_in *sin = (struct sockaddr_in *)sa;
@@ -96,7 +96,7 @@ int fake_getnameinfo(const struct sockaddr *sa, size_t salen, char *host,
} else {
int ret;
Tcl_MutexLock(&netdbMutex);
- hp = gethostbyaddr((char *)&sin->sin_addr,
+ hp = gethostbyaddr((char *)&sin->sin_addr,
sizeof(struct in_addr), AF_INET);
if (hp == NULL) {
ret = EAI_NODATA;
@@ -130,7 +130,7 @@ fake_gai_strerror(int err)
default:
return ("unknown/invalid error.");
}
-}
+}
#endif /* !HAVE_GAI_STRERROR */
#ifndef HAVE_FREEADDRINFO
@@ -156,9 +156,9 @@ addrinfo *malloc_ai(int port, u_long addr, const struct addrinfo *hints)
ai = malloc(sizeof(*ai) + sizeof(struct sockaddr_in));
if (ai == NULL)
return (NULL);
-
+
memset(ai, '\0', sizeof(*ai) + sizeof(struct sockaddr_in));
-
+
ai->ai_addr = (struct sockaddr *)(ai + 1);
/* XXX -- ssh doesn't use sa_len */
ai->ai_addrlen = sizeof(struct sockaddr_in);
@@ -166,7 +166,7 @@ addrinfo *malloc_ai(int port, u_long addr, const struct addrinfo *hints)
((struct sockaddr_in *)(ai)->ai_addr)->sin_port = port;
((struct sockaddr_in *)(ai)->ai_addr)->sin_addr.s_addr = addr;
-
+
/* XXX: the following is not generally correct, but does what we want */
if (hints->ai_socktype)
ai->ai_socktype = hints->ai_socktype;
@@ -180,7 +180,7 @@ addrinfo *malloc_ai(int port, u_long addr, const struct addrinfo *hints)
}
int
-fake_getaddrinfo(const char *hostname, const char *servname,
+fake_getaddrinfo(const char *hostname, const char *servname,
const struct addrinfo *hints, struct addrinfo **res)
{
struct hostent *hp;
@@ -211,29 +211,29 @@ fake_getaddrinfo(const char *hostname, const char *servname,
if (hostname && inet_aton(hostname, &in) != 0)
addr = in.s_addr;
*res = malloc_ai(port, addr, hints);
- if (*res == NULL)
+ if (*res == NULL)
return (EAI_MEMORY);
return (0);
}
-
+
if (!hostname) {
*res = malloc_ai(port, htonl(0x7f000001), hints);
- if (*res == NULL)
+ if (*res == NULL)
return (EAI_MEMORY);
return (0);
}
-
+
if (inet_aton(hostname, &in)) {
*res = malloc_ai(port, in.s_addr, hints);
- if (*res == NULL)
+ if (*res == NULL)
return (EAI_MEMORY);
return (0);
}
-
+
/* Don't try DNS if AI_NUMERICHOST is set */
if (hints && hints->ai_flags & AI_NUMERICHOST)
return (EAI_NONAME);
-
+
Tcl_MutexLock(&netdbMutex);
hp = gethostbyname(hostname);
if (hp && hp->h_name && hp->h_name[0] && hp->h_addr_list[0]) {
diff --git a/compat/fake-rfc2553.h b/compat/fake-rfc2553.h
index cc26f55..6413170 100644
--- a/compat/fake-rfc2553.h
+++ b/compat/fake-rfc2553.h
@@ -1,7 +1,7 @@
/*
* Copyright (C) 2000-2003 Damien Miller. All rights reserved.
* Copyright (C) 1999 WIDE Project. All rights reserved.
- *
+ *
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
@@ -13,7 +13,7 @@
* 3. Neither the name of the project nor the names of its contributors
* may be used to endorse or promote products derived from this software
* without specific prior written permission.
- *
+ *
* THIS SOFTWARE IS PROVIDED BY THE PROJECT AND CONTRIBUTORS ``AS IS'' AND
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
@@ -39,7 +39,7 @@
#define _FAKE_RFC2553_H
/*
- * First, socket and INET6 related definitions
+ * First, socket and INET6 related definitions
*/
#ifndef HAVE_STRUCT_SOCKADDR_STORAGE
# define _SS_MAXSIZE 128 /* Implementation specific max size */
@@ -146,7 +146,7 @@ struct addrinfo {
# undef getaddrinfo
#endif
#define getaddrinfo(a,b,c,d) (fake_getaddrinfo(a,b,c,d))
-int getaddrinfo(const char *, const char *,
+int getaddrinfo(const char *, const char *,
const struct addrinfo *, struct addrinfo **);
#endif /* !HAVE_GETADDRINFO */
@@ -162,7 +162,7 @@ void freeaddrinfo(struct addrinfo *);
#ifndef HAVE_GETNAMEINFO
#define getnameinfo(a,b,c,d,e,f,g) (fake_getnameinfo(a,b,c,d,e,f,g))
-int getnameinfo(const struct sockaddr *, size_t, char *, size_t,
+int getnameinfo(const struct sockaddr *, size_t, char *, size_t,
char *, size_t, int);
#endif /* !HAVE_GETNAMEINFO */
diff --git a/compat/fixstrtod.c b/compat/fixstrtod.c
index 91f309e..63fb8ef 100644
--- a/compat/fixstrtod.c
+++ b/compat/fixstrtod.c
@@ -1,4 +1,4 @@
-/*
+/*
* fixstrtod.c --
*
* Source code for the "fixstrtod" procedure. This procedure is
diff --git a/compat/gettod.c b/compat/gettod.c
index 28e1432..ca20cf8 100644
--- a/compat/gettod.c
+++ b/compat/gettod.c
@@ -1,4 +1,4 @@
-/*
+/*
* gettod.c --
*
* This file provides the gettimeofday function on systems
diff --git a/compat/limits.h b/compat/limits.h
deleted file mode 100644
index 2cb082b..0000000
--- a/compat/limits.h
+++ /dev/null
@@ -1,22 +0,0 @@
-/*
- * limits.h --
- *
- * This is a dummy header file to #include in Tcl when there
- * is no limits.h in /usr/include. There are only a few
- * definitions here; also see tclPort.h, which already
- * #defines some of the things here if they're not arleady
- * defined.
- *
- * Copyright (c) 1991 The Regents of the University of California.
- * Copyright (c) 1994 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#define LONG_MIN 0x80000000
-#define LONG_MAX 0x7fffffff
-#define INT_MIN 0x80000000
-#define INT_MAX 0x7fffffff
-#define SHRT_MIN 0x8000
-#define SHRT_MAX 0x7fff
diff --git a/compat/mkstemp.c b/compat/mkstemp.c
index eaa0b66..1a44dfa 100644
--- a/compat/mkstemp.c
+++ b/compat/mkstemp.c
@@ -1,4 +1,4 @@
-/*
+/*
* mkstemp.c --
*
* Source code for the "mkstemp" library routine.
diff --git a/compat/opendir.c b/compat/opendir.c
index a18f96b..22e8a3a 100644
--- a/compat/opendir.c
+++ b/compat/opendir.c
@@ -1,4 +1,4 @@
-/*
+/*
* opendir.c --
*
* This file provides dirent-style directory-reading procedures for V7
diff --git a/compat/strncasecmp.c b/compat/strncasecmp.c
index 299715d..0a69f35 100644
--- a/compat/strncasecmp.c
+++ b/compat/strncasecmp.c
@@ -1,4 +1,4 @@
-/*
+/*
* strncasecmp.c --
*
* Source code for the "strncasecmp" library routine.
diff --git a/compat/strstr.c b/compat/strstr.c
index 6698c9f..e3b9b8d 100644
--- a/compat/strstr.c
+++ b/compat/strstr.c
@@ -1,4 +1,4 @@
-/*
+/*
* strstr.c --
*
* Source code for the "strstr" library routine.
diff --git a/compat/strtod.c b/compat/strtod.c
index cb9f76d..9643c09 100644
--- a/compat/strtod.c
+++ b/compat/strtod.c
@@ -1,4 +1,4 @@
-/*
+/*
* strtod.c --
*
* Source code for the "strtod" library procedure.
@@ -137,7 +137,7 @@ strtod(
* has more than 18 digits, ignore the extras, since they can't affect the
* value anyway.
*/
-
+
pExp = p;
p -= mantSize;
if (decPt < 0) {
@@ -217,7 +217,7 @@ strtod(
* by processing the exponent one bit at a time to combine many powers of
* 2 of 10. Then combine the exponent with the fraction.
*/
-
+
if (exp < 0) {
expSign = TRUE;
exp = -exp;
diff --git a/compat/strtol.c b/compat/strtol.c
index b111d97..811006a 100644
--- a/compat/strtol.c
+++ b/compat/strtol.c
@@ -1,4 +1,4 @@
-/*
+/*
* strtol.c --
*
* Source code for the "strtol" library procedure.
diff --git a/compat/strtoul.c b/compat/strtoul.c
index d572c2b..15587f1 100644
--- a/compat/strtoul.c
+++ b/compat/strtoul.c
@@ -1,4 +1,4 @@
-/*
+/*
* strtoul.c --
*
* Source code for the "strtoul" library procedure.
@@ -90,7 +90,7 @@ strtoul(
* If no base was provided, pick one from the leading characters of the
* string.
*/
-
+
if (base == 0) {
if (*p == '0') {
p += 1;
@@ -206,7 +206,7 @@ strtoul(
if (overflow) {
errno = ERANGE;
return ULONG_MAX;
- }
+ }
if (negative) {
return -result;
}
diff --git a/compat/unistd.h b/compat/unistd.h
index 2de5bd0..a8f14f2 100644
--- a/compat/unistd.h
+++ b/compat/unistd.h
@@ -20,7 +20,7 @@
#define NULL 0
#endif
-/*
+/*
* Strict POSIX stuff goes here. Extensions go down below, in the ifndef
* _POSIX_SOURCE section.
*/
diff --git a/compat/waitpid.c b/compat/waitpid.c
index 8f65799..e03275a 100644
--- a/compat/waitpid.c
+++ b/compat/waitpid.c
@@ -1,4 +1,4 @@
-/*
+/*
* waitpid.c --
*
* This procedure emulates the POSIX waitpid kernel call on BSD systems
diff --git a/doc/Access.3 b/doc/Access.3
index 1e82e07..699d7ed 100644
--- a/doc/Access.3
+++ b/doc/Access.3
@@ -3,9 +3,9 @@
'\"
'\" See 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 36f6a20..caba125 100644
--- a/doc/AddErrInfo.3
+++ b/doc/AddErrInfo.3
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -17,7 +17,7 @@ Tcl_GetReturnOptions, Tcl_SetReturnOptions, Tcl_AddErrorInfo, Tcl_AppendObjToErr
Tcl_Obj *
\fBTcl_GetReturnOptions\fR(\fIinterp, code\fR)
.sp
-int
+int
\fBTcl_SetReturnOptions\fR(\fIinterp, options\fR)
.sp
\fBTcl_AddErrorInfo\fR(\fIinterp, message\fR)
@@ -45,7 +45,7 @@ void
.AS Tcl_Interp commandLength
.AP Tcl_Interp *interp in
Interpreter in which to record information.
-.AP int code
+.AP int code
The code returned from script evaluation.
.AP Tcl_Obj *options
A dictionary of return options.
@@ -121,7 +121,7 @@ retrieve the stack trace when script evaluation returns
.CS
int code = Tcl_Eval(interp, script);
if (code == TCL_ERROR) {
- Tcl_Obj *options = \fBTcl_GetReturnOptions\fR(interp, code);
+ Tcl_Obj *options = \fBTcl_GetReturnOptions\fR(interp, code);
Tcl_Obj *key = Tcl_NewStringObj("-errorinfo", -1);
Tcl_Obj *stackTrace;
Tcl_IncrRefCount(key);
@@ -163,12 +163,12 @@ to any reference counting. This is analogous to
.PP
While \fBTcl_SetReturnOptions\fR provides a general interface
to set any collection of return options, there are a handful
-of return options that are very frequently used. Most
+of return options that are very frequently used. Most
notably the \fB\-errorinfo\fR and \fB\-errorcode\fR return
options should be set properly when the command procedure
of a command returns \fBTCL_ERROR\fR. The \fB\-errorline\fR
return option is also read by commands that evaluate scripts
-and wish to supply detailed error location information in
+and wish to supply detailed error location information in
the stack trace text they append to the \fB\-errorinfo\fR option.
Tcl provides several simpler interfaces to more directly set
these return options.
@@ -224,7 +224,7 @@ is available as a \fBTcl_Obj\fR instead of as a \fBchar\fR array.
.PP
\fBTcl_AddObjErrorInfo\fR is nearly identical
to \fBTcl_AddErrorInfo\fR, except that it has an additional \fIlength\fR
-argument. This allows the \fImessage\fR string to contain
+argument. This allows the \fImessage\fR string to contain
embedded null bytes. This is essentially never a good idea.
If the \fImessage\fR needs to contain the null character \fBU+0000\fR,
Tcl's usual internal encoding rules should be used to avoid
@@ -232,9 +232,9 @@ the need for a null byte. If the \fBTcl_AddObjErrorInfo\fR
interface is used at all, it should be with a negative \fIlength\fR value.
.PP
The procedure \fBTcl_SetObjErrorCode\fR is used to set the
-\fB\-errorcode\fR return option to the list value \fIerrorObjPtr\fR
-built up by the caller.
-\fBTcl_SetObjErrorCode\fR is typically invoked just
+\fB\-errorcode\fR return option to the list value \fIerrorObjPtr\fR
+built up by the caller.
+\fBTcl_SetObjErrorCode\fR is typically invoked just
before returning an error. If an error is
returned without calling \fBTcl_SetObjErrorCode\fR or
\fBTcl_SetErrorCode\fR the Tcl interpreter automatically sets
@@ -275,7 +275,7 @@ the interpreter's result.
\fBTcl_LogCommandInfo\fR is invoked after an error occurs in an
interpreter. It adds information about the command that was being
executed when the error occurred to the \fB\-errorinfo\fR value, and
-the line number stored internally in the interpreter is set.
+the line number stored internally in the interpreter is set.
.PP
In older releases of Tcl, there was no \fBTcl_GetReturnOptions\fR
routine. In its place, the global Tcl variables \fBerrorInfo\fR
@@ -288,7 +288,7 @@ global variables remains a supported way to access these
return option values, it is important not to assume that
writing to those global variables will properly set the
corresponding return options. It has long been emphasized
-in this manual page that it is important to
+in this manual page that it is important to
call the procedures described here rather than
setting \fBerrorInfo\fR or \fBerrorCode\fR directly with
\fBTcl_ObjSetVar2\fR.
@@ -297,7 +297,7 @@ If the procedure \fBTcl_ResetResult\fR is called,
it clears all of the state of the interpreter associated with
script evaluation, including the entire return options dictionary.
In particular, the \fB\-errorinfo\fR and \fB\-errorcode\fR options
-are reset.
+are reset.
If an error had occurred, the \fBTcl_ResetResult\fR call will
clear the error state to make it appear as if no error had
occurred after all.
diff --git a/doc/Alloc.3 b/doc/Alloc.3
index ca4f949..8f25c52 100644
--- a/doc/Alloc.3
+++ b/doc/Alloc.3
@@ -3,9 +3,9 @@
'\"
'\" See 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..172bb30 100644
--- a/doc/AllowExc.3
+++ b/doc/AllowExc.3
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -31,7 +31,7 @@ return with an appropriate message. The particular script
evaluation procedures of Tcl that act in the manner are
\fBTcl_EvalObjEx\fR, \fBTcl_EvalObjv\fR, \fBTcl_Eval\fR, \fBTcl_EvalEx\fR,
\fBTcl_GlobalEval\fR, \fBTcl_GlobalEvalObj\fR, \fBTcl_VarEval\fR and
-\fBTcl_VarEvalVA\fR.
+\fBTcl_VarEvalVA\fR.
.PP
However, if \fBTcl_AllowExceptions\fR is invoked immediately before
calling one of those a procedures, then arbitrary completion
diff --git a/doc/AppInit.3 b/doc/AppInit.3
index e4ae971..44b2d6b 100644
--- a/doc/AppInit.3
+++ b/doc/AppInit.3
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -52,7 +52,7 @@ Invoke a startup script to initialize the application.
Use the routines \fBTcl_SetStartupScript\fR and
\fBTcl_GetStartupScript\fR to set or query the file and encoding
that the active \fBTcl_Main\fR or \fBTk_Main\fR routine will
-use as a startup script.
+use as a startup script.
.LP
\fBTcl_AppInit\fR returns \fBTCL_OK\fR or \fBTCL_ERROR\fR.
If it returns \fBTCL_ERROR\fR then it must leave an error message in
diff --git a/doc/AssocData.3 b/doc/AssocData.3
index 59c26a4..d4fa3d7 100644
--- a/doc/AssocData.3
+++ b/doc/AssocData.3
@@ -3,9 +3,9 @@
'\"
'\" See 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..347ba3d 100644
--- a/doc/Async.3
+++ b/doc/Async.3
@@ -4,9 +4,9 @@
'\"
'\" See 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..adbe33c 100644
--- a/doc/BackgdErr.3
+++ b/doc/BackgdErr.3
@@ -4,9 +4,9 @@
'\"
'\" See 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..0805f8e 100644
--- a/doc/Backslash.3
+++ b/doc/Backslash.3
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -33,7 +33,7 @@ The use of \fBTcl_Backslash\fR is deprecated in favor of
.PP
This is a utility procedure provided for backwards compatibility with
non-internationalized Tcl extensions. It parses a backslash sequence and
-returns the low byte of the Unicode character corresponding to the sequence.
+returns the low byte of the Unicode character corresponding to the sequence.
\fBTcl_Backslash\fR modifies \fI*countPtr\fR to contain the number of
characters in the backslash sequence.
.PP
diff --git a/doc/BoolObj.3 b/doc/BoolObj.3
index 6691140..7268e1f 100644
--- a/doc/BoolObj.3
+++ b/doc/BoolObj.3
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -50,7 +50,7 @@ value \fIboolValue\fR in it, and returns a pointer to the new Tcl_Obj.
The new Tcl_Obj has reference count of zero.
.PP
\fBTcl_SetBooleanObj\fR accepts \fIobjPtr\fR, a pointer to
-an existing Tcl_Obj, and stores in the Tcl_Obj \fI*objPtr\fR
+an existing Tcl_Obj, and stores in the Tcl_Obj \fI*objPtr\fR
the boolean value \fIboolValue\fR. This is a write operation
on \fI*objPtr\fR, so \fIobjPtr\fR must be unshared. Attempts to
write to a shared Tcl_Obj will panic. A successful write
@@ -61,7 +61,7 @@ any former value stored in \fI*objPtr\fR.
from the value stored in \fI*objPtr\fR.
If \fIobjPtr\fR holds a string value recognized by \fBTcl_GetBoolean\fR,
then the recognized boolean value is written at the address given
-by \fIboolPtr\fR.
+by \fIboolPtr\fR.
If \fIobjPtr\fR holds any value recognized as
a number by Tcl, then if that value is zero a 0 is written at
the address given by \fIboolPtr\fR and if that
@@ -69,10 +69,10 @@ value is non-zero a 1 is written at the address given by \fIboolPtr\fR.
In all cases where a value is written at the address given
by \fIboolPtr\fR, \fBTcl_GetBooleanFromObj\fR returns \fBTCL_OK\fR.
If the value of \fIobjPtr\fR does not meet any of the conditions
-above, then \fBTCL_ERROR\fR is returned and an error message is
+above, then \fBTCL_ERROR\fR is returned and an error message is
left in the interpreter's result unless \fIinterp\fR is NULL.
\fBTcl_GetBooleanFromObj\fR may also make changes to the internal
-fields of \fI*objPtr\fR so that future calls to
+fields of \fI*objPtr\fR so that future calls to
\fBTcl_GetBooleanFromObj\fR on the same \fIobjPtr\fR can be
performed more efficiently.
.PP
diff --git a/doc/ByteArrObj.3 b/doc/ByteArrObj.3
index 2921f68..ff0b4e1 100644
--- a/doc/ByteArrObj.3
+++ b/doc/ByteArrObj.3
@@ -3,12 +3,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 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
+Tcl_NewByteArrayObj, Tcl_SetByteArrayObj, Tcl_GetByteArrayFromObj, Tcl_SetByteArrayLength \- manipulate Tcl values as a arrays of bytes
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -16,7 +16,7 @@ Tcl_NewByteArrayObj, Tcl_SetByteArrayObj, Tcl_GetByteArrayFromObj, Tcl_SetByteAr
Tcl_Obj *
\fBTcl_NewByteArrayObj\fR(\fIbytes, length\fR)
.sp
-void
+void
\fBTcl_SetByteArrayObj\fR(\fIobjPtr, bytes, length\fR)
.sp
unsigned char *
@@ -82,7 +82,7 @@ allocated for the array, the array is reallocated to the new length; the
newly allocated bytes at the end of the array have arbitrary values. If
\fIlength\fR is less than the space currently allocated for the array,
the length of array is reduced to the new length. The return value is a
-pointer to the value's new array of bytes.
+pointer to the value's new array of bytes.
.SH "SEE ALSO"
Tcl_GetStringFromObj, Tcl_NewObj, Tcl_IncrRefCount, Tcl_DecrRefCount
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..847707e 100644
--- a/doc/Cancel.3
+++ b/doc/Cancel.3
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -13,20 +13,25 @@ Tcl_CancelEval, Tcl_Canceled \- cancel Tcl scripts
.nf
\fB#include <tcl.h>\fR
int
-\fBTcl_CancelEval\fR(\fIinterp, clientData, flags\fR)
+\fBTcl_CancelEval\fR(\fIinterp, resultObjPtr, clientData, flags\fR)
.sp
int
\fBTcl_Canceled\fR(\fIinterp, flags\fR)
.SH ARGUMENTS
+.AS Tcl_Interp *interp
.AP Tcl_Interp *interp in
Interpreter in which to cancel the script.
+.AP Tcl_Obj *resultObjPtr in
+Error message to use in the cancellation, or NULL to use a default message. If
+not NULL, this object will have its reference count decremented before
+\fBTcl_CancelEval\fR returns.
.AP int flags in
ORed combination of flag bits that specify additional options.
For \fBTcl_CancelEval\fR, only \fBTCL_CANCEL_UNWIND\fR is currently
supported. For \fBTcl_Canceled\fR, only \fBTCL_LEAVE_ERR_MSG\fR and
\fBTCL_CANCEL_UNWIND\fR are currently supported.
.AP ClientData clientData in
-Currently, reserved for future use.
+Currently reserved for future use.
It should be set to NULL.
.BE
.SH DESCRIPTION
@@ -41,19 +46,21 @@ returns \fBTCL_ERROR\fR if it has. Otherwise, \fBTCL_OK\fR is returned.
Extensions can use this function to check to see if they should abort a long
running command. This function is thread sensitive and may only be called
from the thread the interpreter was created in.
-.SH "FLAG BITS"
+.SS "FLAG BITS"
Any ORed combination of the following values may be used for the
\fIflags\fR argument to procedures such as \fBTcl_CancelEval\fR:
-.TP 23
+.TP 20
\fBTCL_CANCEL_UNWIND\fR
+.
This flag is used by \fBTcl_CancelEval\fR and \fBTcl_Canceled\fR.
-For \fBTcl_CancelEval\fR, if this flag is set, the script in progress
+For \fBTcl_CancelEval\fR, if this flag is set, the script in progress
is canceled and the evaluation stack for the interpreter is unwound.
-For \fBTcl_Canceled\fR, if this flag is set, the script in progress
-is considered to be canceled only if the evaluation stack for the
+For \fBTcl_Canceled\fR, if this flag is set, the script in progress
+is considered to be canceled only if the evaluation stack for the
interpreter is being unwound.
-.TP 23
+.TP 20
\fBTCL_LEAVE_ERR_MSG\fR
+.
This flag is only used by \fBTcl_Canceled\fR; it is ignored by
other procedures. If an error is returned and this bit is set in
\fIflags\fR, then an error message will be left in the interpreter's
@@ -61,6 +68,7 @@ result, where it can be retrieved with \fBTcl_GetObjResult\fR or
\fBTcl_GetStringResult\fR. If this flag bit is not set then no error
message is left and the interpreter's result will not be modified.
.SH "SEE ALSO"
+interp(n), Tcl_Eval(3),
TIP 285
.SH KEYWORDS
cancel, unwind
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..1c3fe08 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
@@ -71,7 +71,8 @@ The name of the object to create, or NULL if a new unused name is to be
automatically selected.
.AP "const char" *nsName in
The name of the namespace to create for the object's private use, or NULL if a
-new unused name is to be automatically selected.
+new unused name is to be automatically selected. The namespace must not
+already exist.
.AP int objc in
The number of elements in the \fIobjv\fR array.
.AP "Tcl_Obj *const" *objv in
@@ -111,7 +112,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..6ef94b5 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
@@ -336,7 +336,7 @@ typedef struct Tcl_ChannelType {
It is not necessary to provide implementations for all channel
operations. Those which are not necessary may be set to NULL in the
struct: \fIblockModeProc\fR, \fIseekProc\fR, \fIsetOptionProc\fR,
-\fIgetOptionProc\fR, and \fIclose2Proc\fR, in addition to
+\fIgetOptionProc\fR, \fIgetHandleProc\fR, and \fIclose2Proc\fR, in addition to
\fIflushProc\fR, \fIhandlerProc\fR, \fIthreadActionProc\fR, and
\fItruncateProc\fR. Other functions that cannot be implemented in a
meaningful way should return \fBEINVAL\fR when called, to indicate
@@ -639,13 +639,13 @@ called to set them, e.g. \fB\-blockmode\fR. Other options are specific to
each channel type and the \fIsetOptionProc\fR procedure of the channel
driver will get called to implement them. The \fIsetOptionProc\fR field can
be NULL, which indicates that this channel type supports no type specific
-options.
+options.
.PP
If the option value is successfully modified to the new value, the function
returns \fBTCL_OK\fR.
It should call \fBTcl_BadChannelOption\fR which itself returns
\fBTCL_ERROR\fR if the \fIoptionName\fR is
-unrecognized.
+unrecognized.
If \fInewValue\fR specifies a value for the option that
is not supported or if a system call error occurs,
the function should leave an error message in the
@@ -674,7 +674,7 @@ channel. If the option name is not NULL, the function stores its current
value, as a string, in the Tcl dynamic string \fIoptionValue\fR.
If \fIoptionName\fR is NULL, the function stores in \fIoptionValue\fR an
alternating list of all supported options and their current values.
-On success, the function returns \fBTCL_OK\fR.
+On success, the function returns \fBTCL_OK\fR.
It should call \fBTcl_BadChannelOption\fR which itself returns
\fBTCL_ERROR\fR if the \fIoptionName\fR is
unrecognized. If a system call error occurs,
@@ -839,7 +839,7 @@ which returns a pointer to the function.
This procedure generates a
.QW "bad option"
error message in an
-(optional) interpreter. It is used by channel drivers when
+(optional) interpreter. It is used by channel drivers when
an invalid Set/Get option is requested. Its purpose is to concatenate
the generic options list to the specific ones and factorize
the generic options error message string.
@@ -850,7 +850,7 @@ An error message is generated in \fIinterp\fR's result value to
indicate that a command was invoked with a bad option.
The message has the form
.CS
- bad option "blah": should be one of
+ bad option "blah": should be one of
<...generic options...>+<...specific options...>
.CE
so you get for instance:
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..bf76d48 100644
--- a/doc/CrtCommand.3
+++ b/doc/CrtCommand.3
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -91,7 +91,7 @@ the command, \fIargc\fR giving the number of arguments (including
the command name) and \fIargv\fR giving the values of the arguments
as strings. The \fIargv\fR array will contain \fIargc\fR+1 values;
the first \fIargc\fR values point to the argument strings, and the
-last value is NULL.
+last value is NULL.
Note that the argument strings should not be modified as they may
point to constant strings or may be shared with other parts of the
interpreter.
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 1156a20..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
diff --git a/doc/CrtMathFnc.3 b/doc/CrtMathFnc.3
index cdde20b..acceb5b 100644
--- a/doc/CrtMathFnc.3
+++ b/doc/CrtMathFnc.3
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -147,7 +147,7 @@ released by passing it to \fBTcl_Free\fR. Some functions (the
standard set implemented in the core, and those defined by placing
commands in the \fBtcl::mathfunc\fR namespace) do not have
argument type information; attempting to retrieve values for
-them causes a NULL to be stored in the variable pointed to by
+them causes a NULL to be stored in the variable pointed to by
\fIprocPtr\fR and the variable pointed to by \fIclientDataPtr\fR
will not be modified. The variable pointed to by \fInumArgsPointer\fR
will contain -1, and no argument types will be stored in the variable
diff --git a/doc/CrtObjCmd.3 b/doc/CrtObjCmd.3
index faf8b74..6714bd7 100644
--- a/doc/CrtObjCmd.3
+++ b/doc/CrtObjCmd.3
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -150,7 +150,7 @@ However, if the existing command was created by a previous call to
but instead arranges for the Tcl interpreter to call the
\fBTcl_ObjCmdProc\fR \fIproc\fR in the future.
The old string-based \fBTcl_CmdProc\fR associated with the command
-is retained and its address can be obtained by subsequent
+is retained and its address can be obtained by subsequent
\fBTcl_GetCommandInfo\fR calls. This is done for backwards compatibility.
.PP
\fIDeleteProc\fR will be invoked when (if) \fIname\fR is deleted.
@@ -288,7 +288,7 @@ command is not deleted or renamed; callers should copy the string if
they need to keep it for a long time.
.PP
\fBTcl_GetCommandFullName\fR produces the fully qualified name
-of a command from a command token.
+of a command from a command token.
The name, including all namespace prefixes,
is appended to the value specified by \fIobjPtr\fR.
.PP
diff --git a/doc/CrtSlave.3 b/doc/CrtSlave.3
index 000ae58..ac681bc 100644
--- a/doc/CrtSlave.3
+++ b/doc/CrtSlave.3
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -122,8 +122,8 @@ is either \fBTCL_OK\fR or \fBTCL_ERROR\fR. If \fBTCL_ERROR\fR is returned
then the \fBresult\fR field of the interpreter contains an error message.
.PP
\fBTcl_CreateSlave\fR creates a new interpreter as a slave of \fIinterp\fR.
-It also creates a slave command named \fIslaveName\fR in \fIinterp\fR which
-allows \fIinterp\fR to manipulate the new slave.
+It also creates a slave command named \fIslaveName\fR in \fIinterp\fR which
+allows \fIinterp\fR to manipulate the new slave.
If \fIisSafe\fR is zero, the command creates a trusted slave in which Tcl
code has access to all the Tcl commands.
If it is \fB1\fR, the command creates a
@@ -178,7 +178,7 @@ created by \fBTcl_CreateSlave\fR) between \fIslaveInterp\fR and
\fItargetInterp\fR. Any two interpreters can be used, without any
restrictions on how they are related.
.PP
-\fBTcl_CreateAliasObj\fR is similar to \fBTcl_CreateAlias\fR except
+\fBTcl_CreateAliasObj\fR is similar to \fBTcl_CreateAlias\fR except
that it takes a vector of values to pass as additional arguments instead
of a vector of strings.
.PP
@@ -196,7 +196,7 @@ strings.
\fBTcl_ExposeCommand\fR moves the command named \fIhiddenCmdName\fR from
the set of hidden commands to the set of exposed commands, putting
it under the name
-\fIcmdName\fR.
+\fIcmdName\fR.
\fIHiddenCmdName\fR must be the name of an existing hidden
command, or the operation will return \fBTCL_ERROR\fR and leave an error
message in the \fIresult\fR field in \fIinterp\fR.
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..d5353ac 100644
--- a/doc/CrtTrace.3
+++ b/doc/CrtTrace.3
@@ -5,9 +5,9 @@
'\"
'\" See 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
@@ -65,7 +65,7 @@ interpreter.
\fBTcl_CmdObjTraceProc\fR:
.PP
.CS
-typedef int \fBTcl_CmdObjTraceProc\fR(
+typedef int \fBTcl_CmdObjTraceProc\fR(
\fBClientData\fR \fIclientData\fR,
\fBTcl_Interp\fR* \fIinterp\fR,
int \fIlevel\fR,
@@ -143,7 +143,7 @@ When \fBTcl_DeleteTrace\fR is called, the interpreter invokes the
\fBTcl_CmdObjTraceDeleteProc\fR:
.PP
.CS
-typedef void \fBTcl_CmdObjTraceDeleteProc\fR(
+typedef void \fBTcl_CmdObjTraceDeleteProc\fR(
\fBClientData\fR \fIclientData\fR);
.CE
.PP
diff --git a/doc/DString.3 b/doc/DString.3
index a85b1cf..00f1b8a 100644
--- a/doc/DString.3
+++ b/doc/DString.3
@@ -4,9 +4,9 @@
'\"
'\" See 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..d48afd0 100644
--- a/doc/DoOneEvent.3
+++ b/doc/DoOneEvent.3
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -20,7 +20,7 @@ int
.AS int flags
.AP int flags in
This parameter is normally zero. It may be an OR-ed combination
-of any of the following flag bits:
+of any of the following flag bits:
\fBTCL_WINDOW_EVENTS\fR, \fBTCL_FILE_EVENTS\fR,
\fBTCL_TIMER_EVENTS\fR, \fBTCL_IDLE_EVENTS\fR, \fBTCL_ALL_EVENTS\fR,
or \fBTCL_DONT_WAIT\fR.
@@ -43,7 +43,7 @@ handlers for the first event on the queue, and returns.
If no events are found, \fBTcl_DoOneEvent\fR checks for \fBTcl_DoWhenIdle\fR
callbacks; if any are found, it invokes all of them and returns.
Finally, if no events or idle callbacks have been found, then
-\fBTcl_DoOneEvent\fR sleeps until an event occurs; then it adds any
+\fBTcl_DoOneEvent\fR sleeps until an event occurs; then it adds any
new events to the Tcl event queue, calls handlers for the first event,
and returns.
The normal return value is 1 to signify that some event
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..85e4de5 100644
--- a/doc/DoubleObj.3
+++ b/doc/DoubleObj.3
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -28,7 +28,7 @@ A double-precision floating-point value used to initialize or set a Tcl value.
For \fBTcl_SetDoubleObj\fR, this points to the value in which to store a
double value.
For \fBTcl_GetDoubleFromObj\fR, this refers to the value
-from which to retrieve a double value.
+from which to retrieve a double value.
.AP Tcl_Interp *interp in/out
When non-NULL, an error message is left here when double value retrieval fails.
.AP double *doublePtr out
@@ -56,7 +56,7 @@ returned, and the double value is written to the storage pointed to by
\fIdoublePtr\fR. If the attempt fails, then \fBTCL_ERROR\fR is returned,
and if \fIinterp\fR is non-NULL, an error message is left in \fIinterp\fR.
The \fBTcl_ObjType\fR of \fIobjPtr\fR may be changed to make subsequent
-calls to \fBTcl_GetDoubleFromObj\fR more efficient.
+calls to \fBTcl_GetDoubleFromObj\fR more efficient.
'\" TODO: add discussion of treatment of NaN value
.SH "SEE ALSO"
Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult
diff --git a/doc/DumpActiveMemory.3 b/doc/DumpActiveMemory.3
index 1f6cb46..43333da 100644
--- a/doc/DumpActiveMemory.3
+++ b/doc/DumpActiveMemory.3
@@ -2,9 +2,9 @@
'\" Copyright (c) 1992-1999 Karl Lehenbauer and Mark Diekhans.
'\" 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
@@ -39,7 +39,7 @@ These functions provide access to Tcl memory debugging information.
They are only functional when Tcl has been compiled with
\fBTCL_MEM_DEBUG\fR defined at compile-time. When \fBTCL_MEM_DEBUG\fR
is not defined, these functions are all no-ops.
-.PP
+.PP
\fBTcl_DumpActiveMemory\fR will output a list of all currently
allocated memory to the specified file. The information output for
each allocated block of memory is: starting and ending addresses
diff --git a/doc/Encoding.3 b/doc/Encoding.3
index 7bcb285..81ef508 100644
--- a/doc/Encoding.3
+++ b/doc/Encoding.3
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -76,7 +76,7 @@ desired.
.AP "const char" *name in
Name of encoding to load.
.AP Tcl_Encoding encoding in
-The encoding to query, free, or use for converting text. If \fIencoding\fR is
+The encoding to query, free, or use for converting text. If \fIencoding\fR is
NULL, the current system encoding is used.
.AP Tcl_Obj *objPtr in
Name of encoding to get token for.
@@ -86,17 +86,17 @@ Points to storage where encoding token is to be written.
For the \fBTcl_ExternalToUtf\fR functions, an array of bytes in the
specified encoding that are to be converted to UTF-8. For the
\fBTcl_UtfToExternal\fR and \fBTcl_WinUtfToTChar\fR functions, an array of
-UTF-8 characters to be converted to the specified encoding.
+UTF-8 characters to be converted to the specified encoding.
.AP "const TCHAR" *tsrc in
An array of Windows TCHAR characters to convert to UTF-8.
-.AP int srcLen in
-Length of \fIsrc\fR or \fItsrc\fR in bytes. If the length is negative, the
+.AP int srcLen in
+Length of \fIsrc\fR or \fItsrc\fR in bytes. If the length is negative, the
encoding-specific length of the string is used.
.AP Tcl_DString *dstPtr out
Pointer to an uninitialized or free \fBTcl_DString\fR in which the converted
result will be stored.
.AP int flags in
-Various flag bits OR-ed together.
+Various flag bits OR-ed together.
\fBTCL_ENCODING_START\fR signifies that the
source buffer is the first block in a (potentially multi-block) input
stream, telling the conversion routine to reset to an initial state and
@@ -108,7 +108,7 @@ byte is converted and then to reset to an initial state.
\fBTCL_ENCODING_STOPONERROR\fR signifies that the conversion routine should
return immediately upon reading a source character that does not exist in
the target encoding; otherwise a default fallback character will
-automatically be substituted.
+automatically be substituted.
.AP Tcl_EncodingState *statePtr in/out
Used when converting a (generally long or indefinite length) byte stream
in a piece-by-piece fashion. The conversion routine stores its current
@@ -116,7 +116,7 @@ state in \fI*statePtr\fR after \fIsrc\fR (the buffer containing the
current piece) has been converted; that state information must be passed
back when converting the next piece of the stream so the conversion
routine knows what state it was in when it left off at the end of the
-last piece. May be NULL, in which case the value specified for \fIflags\fR
+last piece. May be NULL, in which case the value specified for \fIflags\fR
is ignored and the source buffer is assumed to contain the complete string to
convert.
.AP char *dst out
@@ -137,11 +137,11 @@ stored in the output buffer. May be NULL.
.AP Tcl_DString *bufPtr out
Storage for the prescribed system encoding name.
.AP "const Tcl_EncodingType" *typePtr in
-Structure that defines a new type of encoding.
+Structure that defines a new type of encoding.
.AP Tcl_Obj *searchPath in
List of filesystem directories in which to search for encoding data files.
.AP "const char" *path in
-A path to the location of the encoding file.
+A path to the location of the encoding file.
.BE
.SH INTRODUCTION
.PP
@@ -180,13 +180,13 @@ The first time \fIname\fR is seen, \fBTcl_GetEncoding\fR returns an
encoding with a reference count of 1. If the same \fIname\fR is requested
further times, then the reference count for that encoding is incremented
without the overhead of allocating a new encoding and all its associated
-data structures.
+data structures.
.PP
When an \fIencoding\fR is no longer needed, \fBTcl_FreeEncoding\fR
should be called to release it. When an \fIencoding\fR is no longer in use
anywhere (i.e., it has been freed as many times as it has been gotten)
\fBTcl_FreeEncoding\fR will release all storage the encoding was using
-and delete it from the database.
+and delete it from the database.
.PP
\fBTcl_GetEncodingFromObj\fR treats the string representation of
\fIobjPtr\fR as an encoding name, and finds an encoding with that
@@ -201,7 +201,7 @@ on the resulting encoding token when that token will no longer be
used.
.PP
\fBTcl_ExternalToUtfDString\fR converts a source buffer \fIsrc\fR from the
-specified \fIencoding\fR into UTF-8. The converted bytes are stored in
+specified \fIencoding\fR into UTF-8. The converted bytes are stored in
\fIdstPtr\fR, which is then null-terminated. The caller should eventually
call \fBTcl_DStringFree\fR to free any information stored in \fIdstPtr\fR.
When converting, if any of the characters in the source buffer cannot be
@@ -227,17 +227,17 @@ sequence, but more bytes were needed to complete this sequence. A
subsequent call to the conversion routine should pass a buffer containing
the unconverted bytes that remained in \fIsrc\fR plus some further bytes
from the source stream to properly convert the formerly split-up multibyte
-sequence.
+sequence.
.IP \fBTCL_CONVERT_SYNTAX\fR 29
The source buffer contained an invalid character sequence. This may occur
if the input stream has been damaged or if the input encoding method was
misidentified.
.IP \fBTCL_CONVERT_UNKNOWN\fR 29
The source buffer contained a character that could not be represented in
-the target encoding and \fBTCL_ENCODING_STOPONERROR\fR was specified.
+the target encoding and \fBTCL_ENCODING_STOPONERROR\fR was specified.
.RE
.LP
-\fBTcl_UtfToExternalDString\fR converts a source buffer \fIsrc\fR from UTF-8
+\fBTcl_UtfToExternalDString\fR converts a source buffer \fIsrc\fR from UTF-8
into the specified \fIencoding\fR. The converted bytes are stored in
\fIdstPtr\fR, which is then terminated with the appropriate encoding-specific
null. The caller should eventually call \fBTcl_DStringFree\fR to free any
@@ -257,51 +257,17 @@ is filled with the corresponding number of bytes that were stored in
.PP
\fBTcl_WinUtfToTChar\fR and \fBTcl_WinTCharToUtf\fR are
Windows-only convenience
-functions for converting between UTF-8 and Windows strings. On Windows 95
-(as with the Unix operating system),
-all strings exchanged between Tcl and the operating system are
-.QW "char"
-based. On Windows NT, some strings exchanged between Tcl and the
-operating system are
-.QW "char"
-oriented while others are in Unicode. By
-convention, in Windows a TCHAR is a character in the ANSI code page
-on Windows 95 and a Unicode character on Windows NT.
-.PP
-If you planned to use the same
-.QW "char"
-based interfaces on both Windows
-95 and Windows NT, you could use \fBTcl_UtfToExternal\fR and
-\fBTcl_ExternalToUtf\fR (or their \fBTcl_DString\fR equivalents) with an
-encoding of NULL (the current system encoding). On the other hand,
-if you planned to use the Unicode interface when running on Windows NT
-and the
-.QW "char"
-interfaces when running on Windows 95, you would have
-to perform the following type of test over and over in your program
-(as represented in pseudo-code):
-.PP
-.CS
-if (running NT) {
- encoding <- Tcl_GetEncoding("unicode");
- nativeBuffer <- Tcl_UtfToExternal(encoding, utfBuffer);
- Tcl_FreeEncoding(encoding);
-} else {
- nativeBuffer <- Tcl_UtfToExternal(NULL, utfBuffer);
-}
-.CE
-.PP
-\fBTcl_WinUtfToTChar\fR and \fBTcl_WinTCharToUtf\fR automatically
-handle this test and use the proper encoding based on the current
-operating system. \fBTcl_WinUtfToTChar\fR returns a pointer to
-a TCHAR string, and \fBTcl_WinTCharToUtf\fR expects a TCHAR string
-pointer as the \fIsrc\fR string. Otherwise, these functions
-behave identically to \fBTcl_UtfToExternalDString\fR and
-\fBTcl_ExternalToUtfDString\fR.
+functions for converting between UTF-8 and Windows strings
+based on the TCHAR type which is by convention
+a Unicode character on Windows NT.
+These functions are essentially wrappers around
+\fBTcl_UtfToExternalDString\fR and
+\fBTcl_ExternalToUtfDString\fR that convert to and from the
+Unicode encoding.
.PP
\fBTcl_GetEncodingName\fR is roughly the inverse of \fBTcl_GetEncoding\fR.
Given an \fIencoding\fR, the return value is the \fIname\fR argument that
-was used to create the encoding. The string returned by
+was used to create the encoding. The string returned by
\fBTcl_GetEncodingName\fR is only guaranteed to persist until the
\fIencoding\fR is deleted. The caller must not modify this string.
.PP
@@ -340,9 +306,9 @@ reference count of 1. If an encoding with the specified \fIname\fR
already exists, then its entry in the database is replaced with the new
encoding; the token for the old encoding will remain valid and continue
to behave as before, but users of the new token will now call the new
-encoding procedures.
+encoding procedures.
.PP
-The \fItypePtr\fR argument to \fBTcl_CreateEncoding\fR contains information
+The \fItypePtr\fR argument to \fBTcl_CreateEncoding\fR contains information
about the name of the encoding and the procedures that will be called to
convert between this encoding and UTF-8. It is defined as follows:
.PP
@@ -354,7 +320,7 @@ typedef struct Tcl_EncodingType {
Tcl_EncodingFreeProc *\fIfreeProc\fR;
ClientData \fIclientData\fR;
int \fInullSize\fR;
-} \fBTcl_EncodingType\fR;
+} \fBTcl_EncodingType\fR;
.CE
.PP
The \fIencodingName\fR provides a string name for the encoding, by
@@ -384,12 +350,12 @@ type \fBTcl_EncodingConvertProc\fR:
.CS
typedef int \fBTcl_EncodingConvertProc\fR(
ClientData \fIclientData\fR,
- const char *\fIsrc\fR,
- int \fIsrcLen\fR,
- int \fIflags\fR,
+ const char *\fIsrc\fR,
+ int \fIsrcLen\fR,
+ int \fIflags\fR,
Tcl_EncodingState *\fIstatePtr\fR,
- char *\fIdst\fR,
- int \fIdstLen\fR,
+ char *\fIdst\fR,
+ int \fIdstLen\fR,
int *\fIsrcReadPtr\fR,
int *\fIdstWrotePtr\fR,
int *\fIdstCharsPtr\fR);
@@ -405,12 +371,12 @@ documented at the top, to \fBTcl_ExternalToUtf\fR or
\fBTcl_UtfToExternal\fR, with the following exceptions. If the
\fIsrcLen\fR argument to one of those high-level functions is negative,
the value passed to the callback procedure will be the appropriate
-encoding-specific string length of \fIsrc\fR. If any of the \fIsrcReadPtr\fR,
+encoding-specific string length of \fIsrc\fR. If any of the \fIsrcReadPtr\fR,
\fIdstWrotePtr\fR, or \fIdstCharsPtr\fR arguments to one of the high-level
functions is NULL, the corresponding value passed to the callback
procedure will be a non-NULL location.
.PP
-The callback procedure \fIfreeProc\fR, if non-NULL, should match the type
+The callback procedure \fIfreeProc\fR, if non-NULL, should match the type
\fBTcl_EncodingFreeProc\fR:
.PP
.CS
@@ -420,11 +386,11 @@ typedef void \fBTcl_EncodingFreeProc\fR(
.PP
This \fIfreeProc\fR function is called when the encoding is deleted. The
\fIclientData\fR parameter is the same as the \fIclientData\fR field
-specified to \fBTcl_CreateEncoding\fR when the encoding was created.
+specified to \fBTcl_CreateEncoding\fR when the encoding was created.
.PP
\fBTcl_GetEncodingSearchPath\fR and \fBTcl_SetEncodingSearchPath\fR
are called to access and set the list of filesystem directories searched
-for encoding data files.
+for encoding data files.
.PP
The value returned by \fBTcl_GetEncodingSearchPath\fR
is the value stored by the last successful call to
@@ -457,7 +423,7 @@ encoding files that can be loaded using the same mechanism. These
encoding files contain information about the tables and/or escape
sequences used to map between an external encoding and Unicode. The
external encoding may consist of single-byte, multi-byte, or double-byte
-characters.
+characters.
.PP
Each dynamically-loadable encoding is represented as a text file. The
initial line of the file, beginning with a
@@ -481,9 +447,9 @@ many Japanese computers.
.IP "[4] \fBE\fR"
An escape-sequence encoding, specifying that certain sequences of bytes
do not represent characters, but commands that describe how following bytes
-should be interpreted.
+should be interpreted.
.PP
-The rest of the lines in the file depend on the type.
+The rest of the lines in the file depend on the type.
.PP
Cases [1], [2], and [3] are collectively referred to as table-based encoding
files. The lines in a table-based encoding file are in the same
@@ -534,7 +500,7 @@ The third line of the file is three numbers. The first number is the
fallback character (in base 16) to use when converting from UTF-8 to this
encoding. The second number is a \fB1\fR if this file represents the
encoding for a symbol font, or \fB0\fR otherwise. The last number (in base
-10) is how many pages of data follow.
+10) is how many pages of data follow.
.PP
Subsequent lines in the example above are pages that describe how to map
from the encoding into 2-byte Unicode. The first line in a page identifies
diff --git a/doc/Ensemble.3 b/doc/Ensemble.3
index cd69bbd..30c1d3b 100644
--- a/doc/Ensemble.3
+++ b/doc/Ensemble.3
@@ -3,11 +3,11 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
'\" 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
@@ -185,7 +185,7 @@ the bound namespace. May be read and written using
\fBTcl_GetEnsembleSubcommandList\fR and
\fBTcl_SetEnsembleSubcommandList\fR respectively. The result of both
of those functions is a Tcl result code (\fBTCL_OK\fR, or
-\fBTCL_ERROR\fR if the
+\fBTCL_ERROR\fR if the
token does not refer to an ensemble) and the list obtained from
\fBTcl_GetEnsembleSubcommandList\fR should always be treated as
immutable even if it is unshared.
diff --git a/doc/Environment.3 b/doc/Environment.3
index 46262ab..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
diff --git a/doc/Eval.3 b/doc/Eval.3
index 0ecf7fa..8661923 100644
--- a/doc/Eval.3
+++ b/doc/Eval.3
@@ -5,9 +5,9 @@
'\"
'\" See 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
@@ -116,7 +116,7 @@ of the words for the Tcl command, one word in each value in
a completion code and result just like \fBTcl_EvalObjEx\fR.
The caller of \fBTcl_EvalObjv\fR has to manage the reference count of the
elements of \fIobjv\fR, insuring that the values are valid until
-\fBTcl_EvalObjv\fR returns.
+\fBTcl_EvalObjv\fR returns.
.PP
\fBTcl_Eval\fR is similar to \fBTcl_EvalObjEx\fR except that the script to
be executed is supplied as a string instead of a value and no compilation
@@ -127,7 +127,7 @@ might be a UTF-8 special code. The string is parsed and executed directly
(using \fBTcl_EvalObjv\fR) instead of compiling it and executing the
bytecodes. In situations where it is known that the script will never be
executed again, \fBTcl_Eval\fR may be faster than \fBTcl_EvalObjEx\fR.
- \fBTcl_Eval\fR returns a completion code and result just like
+ \fBTcl_Eval\fR returns a completion code and result just like
\fBTcl_EvalObjEx\fR. Note: for backward compatibility with versions before
Tcl 8.0, \fBTcl_Eval\fR copies the value result in \fIinterp\fR to
\fIinterp->result\fR (use is deprecated) where it can be accessed directly.
diff --git a/doc/Exit.3 b/doc/Exit.3
index fd251c7..9a04db3 100644
--- a/doc/Exit.3
+++ b/doc/Exit.3
@@ -3,9 +3,9 @@
'\"
'\" See 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)
@@ -120,7 +120,7 @@ If extension \fBA\fR registers its exit handlers before loading extension
\fBB\fR, this ensures that any exit handlers for \fBB\fR will be executed
before the exit handlers for \fBA\fR.
.PP
-\fBTcl_Finalize\fR and \fBTcl_Exit\fR call \fBTcl_FinalizeThread\fR
+\fBTcl_Finalize\fR and \fBTcl_Exit\fR call \fBTcl_FinalizeThread\fR
and the thread exit handlers \fIafter\fR
the process-wide exit handlers. This is because thread finalization shuts
down the I/O channel system, so any attempt at I/O by the global exit
diff --git a/doc/ExprLong.3 b/doc/ExprLong.3
index 4fa972e..0d369ce 100644
--- a/doc/ExprLong.3
+++ b/doc/ExprLong.3
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -30,7 +30,7 @@ int
.AP Tcl_Interp *interp in
Interpreter in whose context to evaluate \fIexpr\fR.
.AP "const char" *expr in
-Expression to be evaluated.
+Expression to be evaluated.
.AP long *longPtr out
Pointer to location in which to store the integer value of the
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..28ee8f0 100644
--- a/doc/FileSystem.3
+++ b/doc/FileSystem.3
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -464,8 +464,8 @@ directory for all files which match a given pattern. The appropriate
function for the filesystem to which \fIpathPtr\fR belongs will be called.
.PP
The return value is a standard Tcl result indicating whether an error
-occurred in globbing. Error messages are placed in interp (unless
-interp is NULL, which is allowed), but good results are placed in the
+occurred in globbing. Error messages are placed in interp (unless
+interp is NULL, which is allowed), but good results are placed in the
resultPtr given.
.PP
Note that the \fBglob\fR code implements recursive patterns internally, so
@@ -1256,8 +1256,8 @@ not, so code should be flexible to both possibilities.
The return value is a standard Tcl result indicating whether an error
occurred in the matching process. Error messages are placed in
\fIinterp\fR, unless \fIinterp\fR in NULL in which case no error
-message need be generated; on a \fBTCL_OK\fR result, results should be
-added to the \fIresultPtr\fR value given (which can be assumed to be a
+message need be generated; on a \fBTCL_OK\fR result, results should be
+added to the \fIresultPtr\fR value given (which can be assumed to be a
valid unshared Tcl list). The matches added
to \fIresultPtr\fR should include any path prefix given in \fIpathPtr\fR
(this usually means they will be absolute path specifications).
@@ -1265,7 +1265,7 @@ Note that if no matches are found, that simply leads to an empty
result; errors are only signaled for actual file or filesystem
problems which may occur during the matching process.
.PP
-The \fBTcl_GlobTypeData\fR structure passed in the \fItypes\fR
+The \fBTcl_GlobTypeData\fR structure passed in the \fItypes\fR
parameter contains the following fields:
.PP
.CS
diff --git a/doc/FindExec.3 b/doc/FindExec.3
index e4b4ed0..b01315c 100644
--- a/doc/FindExec.3
+++ b/doc/FindExec.3
@@ -4,8 +4,8 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-.so man.macros
.TH Tcl_FindExecutable 3 8.1 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_FindExecutable, Tcl_GetNameOfExecutable \- identify or return the name of the binary file containing the application
diff --git a/doc/GetCwd.3 b/doc/GetCwd.3
index 964e237..58abcde 100755
--- a/doc/GetCwd.3
+++ b/doc/GetCwd.3
@@ -4,8 +4,8 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-.so man.macros
.TH Tcl_GetCwd 3 8.1 Tcl "Tcl Library Procedures"
+.so man.macros
.BS
.SH NAME
Tcl_GetCwd, Tcl_Chdir \- manipulate the current working directory
diff --git a/doc/GetHostName.3 b/doc/GetHostName.3
index 28f3a4f..73432d3 100644
--- a/doc/GetHostName.3
+++ b/doc/GetHostName.3
@@ -1,9 +1,9 @@
'\"
'\" 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
@@ -18,7 +18,7 @@ const char *
.SH DESCRIPTION
.PP
\fBTcl_GetHostName\fR is a utility procedure used by some of the
-Tcl commands. It returns a pointer to a string containing the name
+Tcl commands. It returns a pointer to a string containing the name
for the current machine, or an empty string if the name cannot be
determined. The string is statically allocated, and the caller must
not modify of free it.
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..be0e79f 100644
--- a/doc/GetStdChan.3
+++ b/doc/GetStdChan.3
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -34,18 +34,18 @@ Tcl defines three special channels that are used by various I/O related
commands if no other channels are specified. The standard input channel
has a channel name of \fBstdin\fR and is used by \fBread\fR and \fBgets\fR.
The standard output channel is named \fBstdout\fR and is used by
-\fBputs\fR. The standard error channel is named \fBstderr\fR and is used for
+\fBputs\fR. The standard error channel is named \fBstderr\fR and is used for
reporting errors. In addition, the standard channels are inherited by any
child processes created using \fBexec\fR or \fBopen\fR in the absence of any
other redirections.
.PP
The standard channels are actually aliases for other normal channels. The
current channel associated with a standard channel can be retrieved by calling
-\fBTcl_GetStdChannel\fR with one of
+\fBTcl_GetStdChannel\fR with one of
\fBTCL_STDIN\fR, \fBTCL_STDOUT\fR, or \fBTCL_STDERR\fR as the \fItype\fR. The
return value will be a valid channel, or NULL.
.PP
-A new channel can be set for the standard channel specified by \fItype\fR
+A new channel can be set for the standard channel specified by \fItype\fR
by calling \fBTcl_SetStdChannel\fR with a new channel or NULL in the
\fIchannel\fR argument. If the specified channel is closed by a later call to
\fBTcl_Close\fR, then the corresponding standard channel will automatically be
@@ -64,7 +64,7 @@ be corrected without contradicting the assumptions of some existing
code that calls \fBTcl_SetStdChannel\fR.
.PP
If \fBTcl_GetStdChannel\fR is called before \fBTcl_SetStdChannel\fR, Tcl will
-construct a new channel to wrap the appropriate platform-specific standard
+construct a new channel to wrap the appropriate platform-specific standard
file handle. If \fBTcl_SetStdChannel\fR is called before
\fBTcl_GetStdChannel\fR, then the default channel will not be created.
.PP
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..3672382 100755
--- a/doc/GetVersion.3
+++ b/doc/GetVersion.3
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -24,14 +24,14 @@ Minor version number of the Tcl library.
The patch level of the Tcl library (or alpha or beta number).
.AP Tcl_ReleaseType *type out
The type of release, also indicates the type of patch level. Can be
-one of \fBTCL_ALPHA_RELEASE\fR, \fBTCL_BETA_RELEASE\fR, or
+one of \fBTCL_ALPHA_RELEASE\fR, \fBTCL_BETA_RELEASE\fR, or
\fBTCL_FINAL_RELEASE\fR.
.BE
.SH DESCRIPTION
.PP
\fBTcl_GetVersion\fR should be used to query the version number
-of the Tcl library at runtime. This is useful when using a
+of the Tcl library at runtime. This is useful when using a
dynamically loaded Tcl library or when writing a stubs-aware
extension. For instance, if you write an extension that is
linked against the Tcl stubs library, it could be loaded into
@@ -39,7 +39,7 @@ a program linked to an older version of Tcl than you expected.
Use \fBTcl_GetVersion\fR to verify that fact, and possibly to
change the behavior of your extension.
.PP
-\fBTcl_GetVersion\fR accepts NULL for any of the arguments. For instance if
+\fBTcl_GetVersion\fR accepts NULL for any of the arguments. For instance if
you do not care about the \fIpatchLevel\fR of the library, pass
a NULL for the \fIpatchLevel\fR argument.
diff --git a/doc/Hash.3 b/doc/Hash.3
index 73b89c5..4dc3623 100644
--- a/doc/Hash.3
+++ b/doc/Hash.3
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -131,13 +131,13 @@ The pointer value is the key; it need not (and usually does not)
actually point to a string.
.IP \fBTCL_CUSTOM_TYPE_KEYS\fR 25
Keys are of arbitrary type, and are stored in the entry. Hashing
-and comparison is determined by \fItypePtr\fR. The Tcl_HashKeyType
-structure is described in the section
+and comparison is determined by \fItypePtr\fR. The Tcl_HashKeyType
+structure is described in the section
\fBTHE TCL_HASHKEYTYPE STRUCTURE\fR below.
.IP \fBTCL_CUSTOM_PTR_KEYS\fR 25
Keys are pointers to an arbitrary type, and are stored in the entry. Hashing
-and comparison is determined by \fItypePtr\fR. The Tcl_HashKeyType
-structure is described in the section
+and comparison is determined by \fItypePtr\fR. The Tcl_HashKeyType
+structure is described in the section
\fBTHE TCL_HASHKEYTYPE STRUCTURE\fR below.
.IP \fIother\fR 25
If \fIkeyType\fR is not one of the above,
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..dc62642 100644
--- a/doc/IntObj.3
+++ b/doc/IntObj.3
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -87,7 +87,7 @@ used to initialize a multi-precision integer value.
.SH DESCRIPTION
.PP
These procedures are used to create, modify, and read Tcl values
-that hold integral values.
+that hold integral values.
.PP
The different routines exist to accommodate different integral types in C
with which values might be exchanged. The C integral types for which Tcl
@@ -99,7 +99,7 @@ typedef defined to be whatever signed integral type covers at least the
on the platform and the C compiler, the actual type might be
\fBlong int\fR, \fBlong long int\fR, \fBint64\fR, or something else.
The \fBmp_int\fR type is a multiple-precision integer type defined
-by the LibTomMath multiple-precision integer library.
+by the LibTomMath multiple-precision integer library.
.PP
The \fBTcl_NewIntObj\fR, \fBTcl_NewLongObj\fR, \fBTcl_NewWideIntObj\fR,
and \fBTcl_NewBignumObj\fR routines each create and return a new
diff --git a/doc/Interp.3 b/doc/Interp.3
index d908057..731007b 100644
--- a/doc/Interp.3
+++ b/doc/Interp.3
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -76,7 +76,7 @@ and store a pointer to it in \fIinterp->result\fR.
In this case, the command procedure must also set \fIinterp->freeProc\fR
to the address of a procedure that can free the value, or \fBTCL_DYNAMIC\fR
if the storage was allocated directly by Tcl or by a call to
-\fBTcl_Alloc\fR.
+\fBTcl_Alloc\fR.
If \fIinterp->freeProc\fR is non-zero, then Tcl will call \fIfreeProc\fR
to free the space pointed to by \fIinterp->result\fR before it
invokes the next command.
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..dc1ba53 100644
--- a/doc/ListObj.3
+++ b/doc/ListObj.3
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -64,7 +64,7 @@ Points to location where \fBTcl_ListObjGetElements\fR
stores the number of element values in \fIlistPtr\fR.
.AP Tcl_Obj ***objvPtr out
A location where \fBTcl_ListObjGetElements\fR stores a pointer to an array
-of pointers to the element values of \fIlistPtr\fR.
+of pointers to the element values of \fIlistPtr\fR.
.AP int objc in
The number of Tcl values that \fBTcl_NewListObj\fR
will insert into a new list value,
@@ -75,7 +75,7 @@ the number of Tcl values to insert into \fIobjPtr\fR.
An array of pointers to values.
\fBTcl_NewListObj\fR will insert these values into a new list value
and \fBTcl_ListObjReplace\fR will insert them into an existing \fIlistPtr\fR.
-Each value will become a separate list element.
+Each value will become a separate list element.
.AP int *intPtr out
Points to location where \fBTcl_ListObjLength\fR
stores the length of the list.
@@ -134,7 +134,7 @@ If no error occurs,
the two procedures return \fBTCL_OK\fR after appending the values.
.PP
\fBTcl_NewListObj\fR and \fBTcl_SetListObj\fR
-create a new value or modify an existing value to hold
+create a new value or modify an existing value to hold
the \fIobjc\fR elements of the array referenced by \fIobjv\fR
where each element is a pointer to a Tcl value.
If \fIobjc\fR is less than or equal to zero,
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..225da00 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
@@ -67,7 +67,9 @@ The class to create the method in.
The name of the method to create. Should not be NULL unless creating
constructors or destructors.
.AP int isPublic in
-A boolean flag saying whether the method is to be exported.
+A flag saying what the visibility of the method is. The only supported public
+values of this flag are 0 for a non-exported method, and 1 for an exported
+method.
.AP Tcl_MethodType *methodTypePtr in
A description of the type of the method to create, or the type of method to
compare against.
@@ -172,8 +174,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 7ebeb39..ff0d108 100644
--- a/doc/NRE.3
+++ b/doc/NRE.3
@@ -3,12 +3,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 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
@@ -45,7 +45,7 @@ Name of a new command to create.
Implementation of a command that will be called whenever \fIcmdName\fR
is invoked as a command in the unoptimized way.
.AP Tcl_ObjCmdProc *nreProc in
-Implementation of a command that will be called whenever \fIcmdName\fR
+Implementation of a command that will be called whenever \fIcmdName\fR
is invoked and requested to conserve the C stack.
.AP ClientData clientData in
Arbitrary one-word value that will be passed to \fIproc\fR, \fInreProc\fR,
@@ -83,13 +83,13 @@ executing in the interpreter designated by \fIinterp\fR completes.
to the function designated by \fIpostProcPtr\fR when it is invoked.
.BE
.SH DESCRIPTION
-.PP
+.PP
This series of C functions provides an interface whereby commands that
are implemented in C can be evaluated, and invoke Tcl commands scripts
and scripts, without consuming space on the C stack. The non-recursive
evaluation is done by installing a \fItrampoline\fR, a small piece of
code that invokes a command or script, and then executes a series of
-callbacks when the command or script returns.
+callbacks when the command or script returns.
.PP
The \fBTcl_NRCreateCommand\fR function creates a Tcl command in the
interpreter designated by \fIinterp\fR that is prepared to handle
@@ -149,7 +149,7 @@ The remaining arguments are as for \fBTcl_NREvalObjv\fR.
\fBTcl_NREvalObj\fR, \fBTcl_NREvalObjv\fR and \fBTcl_NRCmdSwap\fR
all accept a \fIflags\fR parameter, which is an OR-ed-together set of
bits to control evaluation. At the present time, the only supported flag
-available to callers is \fBTCL_EVAL_GLOBAL\fR.
+available to callers is \fBTCL_EVAL_GLOBAL\fR.
.\" TODO: Again, this is a lie. Do we want to explain TCL_EVAL_INVOKE
.\" and TCL_EVAL_NOERR?
If the \fBTCL_EVAL_GLOBAL\fR flag is set, the script or command is
@@ -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..16f9f8d 100644
--- a/doc/Notifier.3
+++ b/doc/Notifier.3
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -143,7 +143,7 @@ servicing at a future time. Threaded applications work in a
similar manner, except that there is a separate event queue for
each thread containing a Tcl interpreter.
\fBTcl_QueueEvent\fR is used (primarily
-by event sources) to add events to the event queue and
+by event sources) to add events to the event queue and
\fBTcl_DeleteEvents\fR is used to remove events from the queue without
processing them. In a threaded application, \fBTcl_QueueEvent\fR adds
an event to the current thread's queue, and \fBTcl_ThreadQueueEvent\fR
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..bf80fe2 100644
--- a/doc/Object.3
+++ b/doc/Object.3
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -94,7 +94,7 @@ Also, most Tcl values are only read and never modified.
This is especially true for procedure arguments,
which can be shared between the caller and the called procedure.
Assignment and argument binding is done by
-simply assigning a pointer to the value.
+simply assigning a pointer to the value.
Reference counting is used to determine when it is safe to
reclaim a value's storage.
.PP
diff --git a/doc/ObjectType.3 b/doc/ObjectType.3
index ca2c7a0..bf414ac 100644
--- a/doc/ObjectType.3
+++ b/doc/ObjectType.3
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -76,8 +76,8 @@ in that case \fBTCL_ERROR\fR is returned.
if possible.
It creates a new internal representation for \fIobjPtr\fR
appropriate for the target type \fItypePtr\fR
-and sets its \fItypePtr\fR member as determined by calling the
-\fItypePtr->setFromAnyProc\fR routine.
+and sets its \fItypePtr\fR member as determined by calling the
+\fItypePtr->setFromAnyProc\fR routine.
Any internal representation for \fIobjPtr\fR's old type is freed.
If an error occurs during conversion, it returns \fBTCL_ERROR\fR
and leaves an error message in the result value for \fIinterp\fR
@@ -181,7 +181,7 @@ typedef void \fBTcl_UpdateStringProc\fR(
It must always set \fIbytes\fR non-NULL before returning.
We require the string representation's byte array
to have a null after the last byte, at offset \fIlength\fR,
-and to have no null bytes before that; this allows string representations
+and to have no null bytes before that; this allows string representations
to be treated as conventional null character-terminated C strings.
These restrictions are easily met by using Tcl's internal UTF encoding
for the string representation, same as one would do for other
diff --git a/doc/OpenFileChnl.3 b/doc/OpenFileChnl.3
index 82f51ce..582ff4b 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
@@ -115,7 +115,7 @@ Used for error reporting and to look up a channel registered in it.
The name of a local or network file.
.AP "const char" *mode in
Specifies how the file is to be accessed. May have any of the values
-allowed for the \fImode\fR argument to the Tcl \fBopen\fR command.
+allowed for the \fImode\fR argument to the Tcl \fBopen\fR command.
.AP int permissions in
POSIX-style permission flags such as 0644. If a new file is created, these
permissions will be set on the created file.
@@ -141,7 +141,7 @@ file descriptor, for Windows it is a HANDLE.
OR-ed combination of \fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR to indicate
what operations are valid on \fIhandle\fR.
.AP "const char" *channelName in
-The name of the channel.
+The name of the channel.
.AP int *modePtr out
Points at an integer variable that will receive an OR-ed combination of
\fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR denoting whether the channel is
@@ -155,8 +155,8 @@ from a procedure such as \fBTcl_OpenFileChannel\fR.
A pointer to a Tcl value in which to store the characters read from the
channel.
.AP int charsToRead in
-The number of characters to read from the channel. If the channel's encoding
-is \fBbinary\fR, this is equivalent to the number of bytes to read from the
+The number of characters to read from the channel. If the channel's encoding
+is \fBbinary\fR, this is equivalent to the number of bytes to read from the
channel.
.AP int appendFlag in
If non-zero, data read from the channel will be appended to the value.
@@ -169,7 +169,7 @@ be large enough to hold this many bytes.
.AP Tcl_Obj *lineObjPtr in/out
A pointer to a Tcl value in which to store the line read from the
channel. The line read will be appended to the current value of the
-value.
+value.
.AP Tcl_DString *lineRead in/out
A pointer to a Tcl dynamic string in which to store the line read from the
channel. Must have been initialized by the caller. The line read will be
@@ -238,8 +238,8 @@ If an error occurs while opening the channel, \fBTcl_OpenFileChannel\fR
returns NULL and records a POSIX error code that can be
retrieved with \fBTcl_GetErrno\fR.
In addition, if \fIinterp\fR is non-NULL, \fBTcl_OpenFileChannel\fR
-leaves an error message in \fIinterp\fR's result after any error.
-As of Tcl 8.4, the value-based API \fBTcl_FSOpenFileChannel\fR should
+leaves an error message in \fIinterp\fR's result after any error.
+As of Tcl 8.4, the value-based API \fBTcl_FSOpenFileChannel\fR should
be used in preference to \fBTcl_OpenFileChannel\fR wherever possible.
.PP
The newly created channel is not registered in the supplied interpreter; to
@@ -360,7 +360,7 @@ the standard channels (\fBstdout\fR, \fBstderr\fR, \fBstdin\fR), and will return
Code not associated with a Tcl interpreter can call
\fBTcl_DetachChannel\fR with \fIinterp\fR as NULL, to indicate to Tcl
that it no longer holds a reference to that channel. If this is the last
-reference to the channel, unlike \fBTcl_UnregisterChannel\fR,
+reference to the channel, unlike \fBTcl_UnregisterChannel\fR,
it will not be closed.
.SH TCL_ISSTANDARDCHANNEL
.PP
@@ -368,7 +368,7 @@ it will not be closed.
three standard channels, \fBstdin\fR, \fBstdout\fR or \fBstderr\fR.
If so, it returns 1, otherwise 0.
.PP
-No attempt is made to check whether the given channel or the standard
+No attempt is made to check whether the given channel or the standard
channels are initialized or otherwise valid.
.SH TCL_CLOSE
.PP
@@ -402,7 +402,7 @@ corresponding calls to \fBTcl_UnregisterChannel\fR.
.SH "TCL_READCHARS AND TCL_READ"
.PP
\fBTcl_ReadChars\fR consumes bytes from \fIchannel\fR, converting the bytes
-to UTF-8 based on the channel's encoding and storing the produced data in
+to UTF-8 based on the channel's encoding and storing the produced data in
\fIreadObjPtr\fR's string representation. The return value of
\fBTcl_ReadChars\fR is the number of characters, up to \fIcharsToRead\fR,
that were stored in \fIreadObjPtr\fR. If an error occurs while reading, the
@@ -450,7 +450,7 @@ extensions. It consumes bytes from \fIchannel\fR and stores them in
of \fBTcl_Read\fR is the number of bytes, up to \fIbytesToRead\fR, written in
\fIreadBuf\fR. The buffer produced by \fBTcl_Read\fR is not null-terminated.
Its contents are valid from the zeroth position up to and excluding the
-position indicated by the return value.
+position indicated by the return value.
.PP
\fBTcl_ReadRaw\fR is the same as \fBTcl_Read\fR but does not
compensate for stacking. While \fBTcl_Read\fR (and the other functions
@@ -507,7 +507,7 @@ to be null-terminated and it outputs everything up to the null.
.PP
Data queued for output may not appear on the output device immediately, due
to internal buffering. If the data should appear immediately, call
-\fBTcl_Flush\fR after the call to \fBTcl_WriteChars\fR, or set the
+\fBTcl_Flush\fR after the call to \fBTcl_WriteChars\fR, or set the
\fB\-buffering\fR option on the channel to \fBnone\fR. If you wish the data
to appear as soon as a complete line is accepted for output, set the
\fB\-buffering\fR option on the channel to \fBline\fR mode.
@@ -525,7 +525,7 @@ channel. This is done even if the channel has no encoding.
\fBTcl_WriteObj\fR is similar to \fBTcl_WriteChars\fR except it
accepts a Tcl value whose contents will be output to the channel. The
UTF-8 characters in \fIwriteObjPtr\fR's string representation are converted
-to the channel's encoding and queued for output to \fIchannel\fR.
+to the channel's encoding and queued for output to \fIchannel\fR.
As a performance optimization, when writing to a channel with the encoding
\fBbinary\fR, UTF-8 characters are not converted as they are written.
Instead, the bytes in \fIwriteObjPtr\fR's internal representation as a
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..af86665 100644
--- a/doc/Panic.3
+++ b/doc/Panic.3
@@ -1,9 +1,9 @@
'\"
'\" See 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
@@ -69,7 +69,7 @@ After \fBTcl_SetPanicProc\fR returns, any future calls to
\fIformat\fR and \fIarg\fR arguments. \fIpanicProc\fR should avoid
making calls into the Tcl library, or into other libraries that may
call the Tcl library, since the original call to \fBTcl_Panic\fR
-indicates the Tcl library is not in a state of reliable operation.
+indicates the Tcl library is not in a state of reliable operation.
.PP
The typical use of \fBTcl_SetPanicProc\fR arranges for the error message
to be displayed or reported in a manner more suitable for the
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..667d697 100644
--- a/doc/ParseCmd.3
+++ b/doc/ParseCmd.3
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -56,7 +56,7 @@ following \fIstart\fR up to the first null character.
.AP int nested in
Non-zero means that the script is part of a command substitution so an
unquoted close bracket should be treated as a command terminator. If zero,
-close brackets have no special meaning.
+close brackets have no special meaning.
.AP int append in
Non-zero means that \fI*parsePtr\fR already contains valid tokens; the new
tokens should be appended to those already present. Zero means that
@@ -118,7 +118,7 @@ result, and no information is left at \fI*parsePtr\fR.
enclosed in braces such as
\fB{hello}\fR or \fB{string \et with \et tabs}\fR
from the beginning of its argument \fIstart\fR.
-The first character of \fIstart\fR must be \fB{\fR.
+The first character of \fIstart\fR must be \fB{\fR.
If the braced string was parsed successfully,
\fBTcl_ParseBraces\fR returns \fBTCL_OK\fR,
fills in the structure pointed to by \fIparsePtr\fR
@@ -134,7 +134,7 @@ and no information is left at \fI*parsePtr\fR or \fI*termPtr\fR.
\fBTcl_ParseQuotedString\fR parses a double-quoted string such as
\fB"sum is [expr {$a+$b}]"\fR
from the beginning of the argument \fIstart\fR.
-The first character of \fIstart\fR must be \fB\N'34'\fR.
+The first character of \fIstart\fR must be \fB\N'34'\fR.
If the double-quoted string was parsed successfully,
\fBTcl_ParseQuotedString\fR returns \fBTCL_OK\fR,
fills in the structure pointed to by \fIparsePtr\fR
@@ -150,7 +150,7 @@ and no information is left at \fI*parsePtr\fR or \fI*termPtr\fR.
\fBTcl_ParseVarName\fR parses a Tcl variable reference such as
\fB$abc\fR or \fB$x([expr {$index + 1}])\fR from the beginning of its
\fIstart\fR argument.
-The first character of \fIstart\fR must be \fB$\fR.
+The first character of \fIstart\fR must be \fB$\fR.
If a variable name was parsed successfully, \fBTcl_ParseVarName\fR
returns \fBTCL_OK\fR and fills in the structure pointed to by
\fIparsePtr\fR with information about the structure of the variable name
@@ -184,7 +184,7 @@ a Tcl_Parse structure. The tokens typically consist
of all the tokens in a word or all the tokens that make up the index for
a reference to an array variable. \fBTcl_EvalTokensStandard\fR performs the
substitutions requested by the tokens and concatenates the
-resulting values.
+resulting values.
The return value from \fBTcl_EvalTokensStandard\fR is a Tcl completion
code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR,
\fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR, or possibly
@@ -242,7 +242,7 @@ character that terminates the last comment.
If the command is not preceded by any comments, \fIcommentSize\fR is 0.
\fBTcl_ParseCommand\fR also sets the \fIcommandStart\fR field
to point to the first character of the first
-word in the command (skipping any comments and leading space) and
+word in the command (skipping any comments and leading space) and
\fIcommandSize\fR gives the total number of bytes in the command,
including the character pointed to by \fIcommandStart\fR up to and
including the newline, close bracket, or semicolon character that
@@ -350,7 +350,7 @@ just the \fBTCL_TOKEN_OPERATOR\fR token.
Each operand is described by a \fBTCL_TOKEN_SUB_EXPR\fR token.
Otherwise, the subexpression is a value described by
one of the token types \fBTCL_TOKEN_WORD\fR, \fBTCL_TOKEN_TEXT\fR,
-\fBTCL_TOKEN_BS\fR, \fBTCL_TOKEN_COMMAND\fR,
+\fBTCL_TOKEN_BS\fR, \fBTCL_TOKEN_COMMAND\fR,
\fBTCL_TOKEN_VARIABLE\fR, and \fBTCL_TOKEN_SUB_EXPR\fR.
The \fInumComponents\fR field
counts the total number of sub-tokens that make up the subexpression;
@@ -389,7 +389,7 @@ is always 0.
After \fBTcl_ParseCommand\fR returns, the first token pointed to by
the \fItokenPtr\fR field of the
Tcl_Parse structure always has type \fBTCL_TOKEN_WORD\fR or
-\fBTCL_TOKEN_SIMPLE_WORD\fR or \fBTCL_TOKEN_EXPAND_WORD\fR.
+\fBTCL_TOKEN_SIMPLE_WORD\fR or \fBTCL_TOKEN_EXPAND_WORD\fR.
It is followed by the sub-tokens
that must be concatenated to produce the value of that word.
The next token is the \fBTCL_TOKEN_WORD\fR or \fBTCL_TOKEN_SIMPLE_WORD\fR
diff --git a/doc/PkgRequire.3 b/doc/PkgRequire.3
index d54d7af..71f3acf 100644
--- a/doc/PkgRequire.3
+++ b/doc/PkgRequire.3
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -75,8 +75,8 @@ procedures do.
.PP
If \fBTcl_PkgPresent\fR or \fBTcl_PkgRequire\fR complete successfully
they return a pointer to the version string for the version of the package
-that is provided in the interpreter (which may be different than
-\fIversion\fR); if an error occurs they return NULL and leave an error
+that is provided in the interpreter (which may be different than
+\fIversion\fR); if an error occurs they return NULL and leave an error
message in the interpreter's result.
.PP
\fBTcl_PkgProvide\fR returns \fBTCL_OK\fR if it completes successfully;
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..aa757bc 100644
--- a/doc/RegExp.3
+++ b/doc/RegExp.3
@@ -5,9 +5,9 @@
'\"
'\" See 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
@@ -103,7 +103,7 @@ should be stored by \fBTcl_RegExpGetInfo\fR.
\fBTcl_RegExpMatch\fR determines whether its \fIpattern\fR argument
matches \fIregexp\fR, where \fIregexp\fR is interpreted
as a regular expression using the rules in the \fBre_syntax\fR
-reference page.
+reference page.
If there is a match then \fBTcl_RegExpMatch\fR returns 1.
If there is no match then \fBTcl_RegExpMatch\fR returns 0.
If an error occurs in the matching process (e.g. \fIpattern\fR
@@ -111,7 +111,7 @@ is not a valid regular expression) then \fBTcl_RegExpMatch\fR
returns \-1 and leaves an error message in the interpreter result.
\fBTcl_RegExpMatchObj\fR is similar to \fBTcl_RegExpMatch\fR except it
operates on the Tcl values \fItextObj\fR and \fIpatObj\fR instead of
-UTF strings.
+UTF strings.
\fBTcl_RegExpMatchObj\fR is generally more efficient than
\fBTcl_RegExpMatch\fR, so it is the preferred interface.
.PP
@@ -201,7 +201,7 @@ Compile extended regular expressions
.PQ ERE s .
This mode corresponds
to the regular expression syntax recognized by Tcl 8.0 and earlier
-versions.
+versions.
.TP
\fBTCL_REG_BASIC\fR
Compile basic regular expressions
@@ -375,7 +375,7 @@ character in the string where a match could occur. If a match was
found, this will be the same as the beginning of the current match.
If no match was found, then it indicates the earliest point at which a
match might occur if additional text is appended to the string. If it
-is no match is possible even with further text, this field will be set
+is no match is possible even with further text, this field will be set
to \-1.
.SH "SEE ALSO"
re_syntax(n)
diff --git a/doc/SaveResult.3 b/doc/SaveResult.3
index 8eaf38f..b2270a2 100644
--- a/doc/SaveResult.3
+++ b/doc/SaveResult.3
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -67,7 +67,7 @@ a superset of the functions provided by the other routines,
any new code should only make use of the more powerful routines.
The older, weaker routines \fBTcl_SaveResult\fR, \fBTcl_RestoreResult\fR,
and \fBTcl_DiscardResult\fR continue to exist only for the sake
-of existing programs that may already be using them.
+of existing programs that may already be using them.
.PP
\fBTcl_SaveInterpState\fR takes a snapshot of those portions of
interpreter state that make up the full result of script evaluation.
@@ -115,6 +115,6 @@ uninitialized state and cannot be used until another call to
Once \fBTcl_SaveResult\fR is called to save the interpreter
result, either \fBTcl_RestoreResult\fR or
\fBTcl_DiscardResult\fR must be called to properly clean up the
-memory associated with the saved state.
+memory associated with the saved state.
.SH KEYWORDS
result, state, interp
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..dc8f487 100644
--- a/doc/SetResult.3
+++ b/doc/SetResult.3
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -212,7 +212,7 @@ As a migration aid, access can be restored with the compiler directive
but this is meant only to offer life support to otherwise dead code.
.SH "THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT"
.PP
-\fBTcl_SetResult\fR's \fIfreeProc\fR argument specifies how
+\fBTcl_SetResult\fR's \fIfreeProc\fR argument specifies how
the Tcl system is to manage the storage for the \fIresult\fR argument.
If \fBTcl_SetResult\fR or \fBTcl_SetObjResult\fR are called
at a time when \fIinterp\fR holds a string result,
diff --git a/doc/SetVar.3 b/doc/SetVar.3
index 0605ff2..4aa671a 100644
--- a/doc/SetVar.3
+++ b/doc/SetVar.3
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -86,7 +86,7 @@ These procedures are used to create, modify, read, and delete
Tcl variables from C code.
.PP
\fBTcl_SetVar2Ex\fR, \fBTcl_SetVar\fR, \fBTcl_SetVar2\fR, and
-\fBTcl_ObjSetVar2\fR
+\fBTcl_ObjSetVar2\fR
will create a new variable or modify an existing one.
These procedures set the given variable to the value
given by \fInewValuePtr\fR or \fInewValue\fR and return a
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..7042cc8 100644
--- a/doc/StringObj.3
+++ b/doc/StringObj.3
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -293,6 +293,7 @@ of \fBTcl_Format\fR with functionality equivalent to:
Tcl_Obj *newPtr = \fBTcl_Format\fR(interp, format, objc, objv);
if (newPtr == NULL) return TCL_ERROR;
\fBTcl_AppendObjToObj\fR(objPtr, newPtr);
+\fBTcl_DecrRefCount\fR(newPtr);
return TCL_OK;
.CE
.PP
@@ -307,7 +308,7 @@ sprintf(buf, format, ...);
\fBTcl_NewStringObj\fR(buf, -1);
.CE
.PP
-but with greater convenience and no need to
+but with greater convenience and no need to
determine \fBSOME_SUITABLE_LENGTH\fR. The formatting is done with the same
core formatting engine used by \fBTcl_Format\fR. This means the set of
supported conversion specifiers is that of the \fBformat\fR command and
@@ -328,8 +329,8 @@ Tcl_Obj *objPtr = \fBTcl_ObjPrintf\fR("Value is %d", x);
.PP
If the value of \fIformat\fR contains internal inconsistencies or invalid
specifier formats, the formatted string result produced by
-\fBTcl_ObjPrintf\fR will be an error message describing the error.
-It is impossible however to provide runtime protection against
+\fBTcl_ObjPrintf\fR will be an error message describing the error.
+It is impossible however to provide runtime protection against
mismatches between the format and any subsequent arguments.
Compile-time protection may be provided by some compilers.
.PP
@@ -337,7 +338,9 @@ Compile-time protection may be provided by some compilers.
of \fBTcl_ObjPrintf\fR with functionality equivalent to
.PP
.CS
-\fBTcl_AppendObjToObj\fR(objPtr, \fBTcl_ObjPrintf\fR(format, ...));
+Tcl_Obj *newPtr = \fBTcl_ObjPrintf\fR(format, ...);
+\fBTcl_AppendObjToObj\fR(objPtr, newPtr);
+\fBTcl_DecrRefCount\fR(newPtr);
.CE
.PP
but with greater convenience and efficiency when the appending
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..fc3b477 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
.
@@ -191,35 +191,40 @@ in braces or quotes.
Backslash
.PQ \e "" .
.TP 7
-\e\fIooo\fR
+\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
+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\(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
-\e\fBx\fIhh\fR
+\e\fBx\fIhh\fR
.
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
+\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
+\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..3ec33d1 100644
--- a/doc/Tcl_Main.3
+++ b/doc/Tcl_Main.3
@@ -5,9 +5,9 @@
'\"
'\" See 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
@@ -52,7 +52,7 @@ is a program
like tclsh or wish that supports both interactive interpretation
of Tcl and evaluation of a script contained in a file given as
a command line argument. \fBTcl_Main\fR is offered as a convenience
-to developers of shell applications, so they do not have to
+to developers of shell applications, so they do not have to
reproduce all of the code for proper initialization of the Tcl
library and interactive shell operation. Other styles of embedding
Tcl in an application are not supported by \fBTcl_Main\fR. Those
@@ -106,7 +106,7 @@ will not evaluate any startup script.
and encoding set by the most recent \fBTcl_SetStartupScript\fR
call in the same thread. The stored file name is returned,
and the stored encoding name is written to space pointed to
-by \fIencodingPtr\fR, when that is not NULL.
+by \fIencodingPtr\fR, when that is not NULL.
.PP
The file name and encoding values managed by the routines
\fBTcl_SetStartupScript\fR and \fBTcl_GetStartupScript\fR
@@ -136,7 +136,7 @@ commands, \fBTcl_Main\fR calls the procedure given by the
.QW hook
for the application to perform its own initialization of the interpreter
created by \fBTcl_Main\fR, such as defining application-specific
-commands. The application initialization routine might also
+commands. The application initialization routine might also
call \fBTcl_SetStartupScript\fR to (re-)set the file and encoding
to be used as a startup script. The procedure must have an interface
that matches the type \fBTcl_AppInitProc\fR:
diff --git a/doc/Thread.3 b/doc/Thread.3
index ca135ee..5966a71 100644
--- a/doc/Thread.3
+++ b/doc/Thread.3
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -79,9 +79,10 @@ waited upon into it.
.SH INTRODUCTION
Beginning with the 8.1 release, the Tcl core is thread safe, which
allows you to incorporate Tcl into multithreaded applications without
-customizing the Tcl core. To enable Tcl multithreading support,
-you must include the \fB\-\|\-enable-threads\fR option to \fBconfigure\fR
-when you configure and compile your Tcl core.
+customizing the Tcl core. Starting with the 8.6 release, Tcl
+multithreading support is on by default. To disable Tcl multithreading
+support, you must include the \fB\-\|\-disable-threads\fR option to
+\fBconfigure\fR when you configure and compile your Tcl core.
.PP
An important constraint of the Tcl threads implementation is that
\fIonly the thread that created a Tcl interpreter can use that
@@ -126,7 +127,7 @@ will cause a memory leak.
.PP
The \fBTcl_GetThreadData\fR call returns a pointer to a block of
thread-private data. Its argument is a key that is shared by all threads
-and a size for the block of storage. The storage is automatically
+and a size for the block of storage. The storage is automatically
allocated and initialized to all zeros the first time each thread asks for it.
The storage is automatically deallocated by \fBTcl_FinalizeThread\fR.
.SS "SYNCHRONIZATION AND COMMUNICATION"
diff --git a/doc/ToUpper.3 b/doc/ToUpper.3
index d6b3006..b933e9c 100644
--- a/doc/ToUpper.3
+++ b/doc/ToUpper.3
@@ -3,9 +3,9 @@
'\"
'\" See 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..99914a6 100644
--- a/doc/TraceCmd.3
+++ b/doc/TraceCmd.3
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -78,7 +78,7 @@ created. \fIClientData\fR typically points to an application-specific
data structure that describes what to do when \fIproc\fR is invoked.
\fIOldName\fR gives the name of the command being renamed, and
\fInewName\fR gives the name that the command is being renamed to (or
-an empty string or NULL when the command is being deleted.)
+NULL when the command is being deleted.)
\fIFlags\fR is an OR'ed combination of bits potentially providing
several pieces of information. One of the bits \fBTCL_TRACE_RENAME\fR and
\fBTCL_TRACE_DELETE\fR will be set in \fIflags\fR to indicate which
@@ -86,11 +86,14 @@ operation is being performed on the command. The bit
\fBTCL_TRACE_DESTROYED\fR will be set in \fIflags\fR if the trace is about
to be destroyed; this information may be useful to \fIproc\fR so that
it can clean up its own internal data structures (see the section
-\fBTCL_TRACE_DESTROYED\fR below for more details). Lastly, the bit
-\fBTCL_INTERP_DESTROYED\fR will be set if the entire interpreter is being
-destroyed. When this bit is set, \fIproc\fR must be especially
-careful in the things it does (see the section \fBTCL_INTERP_DESTROYED\fR
-below).
+\fBTCL_TRACE_DESTROYED\fR below for more details). Because the
+deletion of commands can take place as part of the deletion of the interp
+that contains them, \fIproc\fR must be careful about checking what
+the passed in \fIinterp\fR value can be called upon to do.
+The routine \fBTcl_InterpDeleted\fR is an important tool for this.
+When \fBTcl_InterpDeleted\fR returns 1, \fIproc\fR will not be able
+to invoke any scripts in \fIinterp\fR. The function of \fIproc\fR
+in that circumstance is limited to the cleanup of its own data structures.
.PP
\fBTcl_UntraceCommand\fR may be used to remove a trace. If the
command specified by \fIinterp\fR, \fIcmdName\fR, and \fIflags\fR has
@@ -123,7 +126,8 @@ traces for a given command that have the same \fIproc\fR.
.PP
During rename traces, the command being renamed is visible with both
names simultaneously, and the command still exists during delete
-traces (if \fBTCL_INTERP_DESTROYED\fR is not set). However, there is no
+traces, unless the interp that contains it is being deleted.
+However, there is no
mechanism for signaling that an error occurred in a trace procedure,
so great care should be taken that errors do not get silently lost.
.SH "MULTIPLE TRACES"
@@ -142,22 +146,5 @@ rename the command, the last renaming takes precedence.
In a delete callback to \fIproc\fR, the \fBTCL_TRACE_DESTROYED\fR bit
is set in \fIflags\fR.
.\" Perhaps need some more comments here? - DKF
-.SH "TCL_INTERP_DESTROYED"
-.PP
-When an interpreter is destroyed, unset traces are called for
-all of its commands.
-The \fBTCL_INTERP_DESTROYED\fR bit will be set in the \fIflags\fR
-argument passed to the trace procedures.
-Trace procedures must be extremely careful in what they do if
-the \fBTCL_INTERP_DESTROYED\fR bit is set.
-It is not safe for the procedures to invoke any Tcl procedures
-on the interpreter, since its state is partially deleted.
-All that trace procedures should do under these circumstances is
-to clean up and free their own internal data structures.
-.SH BUGS
-.PP
-Tcl does not do any error checking to prevent trace procedures
-from misusing the interpreter during traces with \fBTCL_INTERP_DESTROYED\fR
-set.
.SH KEYWORDS
clientData, trace, command
diff --git a/doc/TraceVar.3 b/doc/TraceVar.3
index 6201a4f..19cb467 100644
--- a/doc/TraceVar.3
+++ b/doc/TraceVar.3
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -203,7 +203,7 @@ The procedures \fBTcl_TraceVar2\fR, \fBTcl_UntraceVar2\fR, and
except that the name of the variable consists of two parts.
\fIName1\fR gives the name of a scalar variable or array,
and \fIname2\fR gives the name of an element within an array.
-When \fIname2\fR is NULL,
+When \fIname2\fR is NULL,
\fIname1\fR may contain both an array and an element name:
if the name contains an open parenthesis and ends with a
close parenthesis, then the value between the parentheses is
@@ -214,7 +214,7 @@ If \fIname2\fR is NULL and \fIname1\fR does not refer
to an array element it means that either the variable is
a scalar or the trace is to be set on the entire array rather
than an individual element (see WHOLE-ARRAY TRACES below for
-more information).
+more information).
.SH "ACCESSING VARIABLES DURING TRACES"
.PP
During read, write, and array traces, the
diff --git a/doc/Translate.3 b/doc/Translate.3
index 55233c3..38831d3 100644
--- a/doc/Translate.3
+++ b/doc/Translate.3
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -34,7 +34,7 @@ anything stored here.
This utility procedure translates a file name to a platform-specific form
which, after being converted to the appropriate encoding, is suitable for
passing to the local operating system. In particular, it converts
-network names into native form and does tilde substitution.
+network names into native form and does tilde substitution.
.PP
However, with the advent of the newer \fBTcl_FSGetNormalizedPath\fR and
\fBTcl_FSGetNativePath\fR, there is no longer any need to use this
diff --git a/doc/UniCharIsAlpha.3 b/doc/UniCharIsAlpha.3
index 6029b2d..2336c34 100644
--- a/doc/UniCharIsAlpha.3
+++ b/doc/UniCharIsAlpha.3
@@ -3,9 +3,9 @@
'\"
'\" See 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..9e17ed5 100644
--- a/doc/UpVar.3
+++ b/doc/UpVar.3
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -40,7 +40,7 @@ an upvar-ed variable.
One of \fBTCL_GLOBAL_ONLY\fR, \fBTCL_NAMESPACE_ONLY\fR or 0; if non-zero,
then \fIdestName\fR is a global or namespace variable; otherwise it is
local to the current procedure (or current namespace if no procedure is
-active).
+active).
.AP "const char" *name1 in
First part of source variable's name (scalar name, or name of array
without array index).
diff --git a/doc/Utf.3 b/doc/Utf.3
index 55906e7..378c806 100644
--- a/doc/Utf.3
+++ b/doc/Utf.3
@@ -3,12 +3,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 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
+Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharNcasecmp, Tcl_UniCharCaseMatch, Tcl_UtfNcmp, Tcl_UtfNcasecmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -48,7 +48,7 @@ int
int
\fBTcl_UtfCharComplete\fR(\fIsrc, length\fR)
.sp
-int
+int
\fBTcl_NumUtfChars\fR(\fIsrc, length\fR)
.sp
const char *
@@ -109,7 +109,7 @@ Pointer to the beginning of a UTF-8 string.
.AP int index in
The index of a character (not byte) in the UTF-8 string.
.AP int *readPtr out
-If non-NULL, filled with the number of bytes in the backslash sequence,
+If non-NULL, filled with the number of bytes in the backslash sequence,
including the backslash character.
.AP char *dst out
Buffer in which the bytes represented by the backslash sequence are stored.
@@ -142,7 +142,7 @@ end and dereference non-existent or random memory; if the source buffer
is known to be null-terminated, this will not happen. If the input is
not in proper UTF-8 format, \fBTcl_UtfToUniChar\fR will store the first
byte of \fIsrc\fR in \fI*chPtr\fR as a Tcl_UniChar between 0x0000 and
-0x00ff and return 1.
+0x00ff and return 1.
.PP
\fBTcl_UniCharToUtfDString\fR converts the given Unicode string
to UTF-8, storing the result in a previously initialized \fBTcl_DString\fR.
@@ -210,12 +210,12 @@ length is negative, all bytes up to the first null byte are used.
\fBTcl_UtfFindFirst\fR corresponds to \fBstrchr\fR for UTF-8 strings. It
returns a pointer to the first occurrence of the Tcl_UniChar \fIch\fR
in the null-terminated UTF-8 string \fIsrc\fR. The null terminator is
-considered part of the UTF-8 string.
+considered part of the UTF-8 string.
.PP
\fBTcl_UtfFindLast\fR corresponds to \fBstrrchr\fR for UTF-8 strings. It
returns a pointer to the last occurrence of the Tcl_UniChar \fIch\fR
in the null-terminated UTF-8 string \fIsrc\fR. The null terminator is
-considered part of the UTF-8 string.
+considered part of the UTF-8 string.
.PP
Given \fIsrc\fR, a pointer to some location in a UTF-8 string,
\fBTcl_UtfNext\fR returns a pointer to the next UTF-8 character in the
@@ -239,7 +239,7 @@ characters. Behavior is undefined if a negative \fIindex\fR is given.
.PP
\fBTcl_UtfAtIndex\fR returns a pointer to the specified character (not
byte) \fIindex\fR in the UTF-8 string \fIsrc\fR. The source string must
-contain at least \fIindex\fR characters. This is equivalent to calling
+contain at least \fIindex\fR characters. This is equivalent to calling
\fBTcl_UtfNext\fR \fIindex\fR times. If a negative \fIindex\fR is given,
the return pointer points to the first character in the source string.
.PP
diff --git a/doc/WrongNumArgs.3 b/doc/WrongNumArgs.3
index 15d5caf..93e2ebb 100644
--- a/doc/WrongNumArgs.3
+++ b/doc/WrongNumArgs.3
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -55,7 +55,7 @@ wrong # args: should be "foo bar fileName count"
.PP
\fIObjc\fR is usually 1, but may be 2 or more for commands like
\fBstring\fR and the Tk widget commands, which use the first argument
-as a subcommand.
+as a subcommand.
.PP
Some of the values in the \fIobjv\fR array may be abbreviations for
a subcommand. The command
diff --git a/doc/after.n b/doc/after.n
index d6181c6..3d0d2c4 100644
--- a/doc/after.n
+++ b/doc/after.n
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -47,7 +47,7 @@ The delayed command is formed by concatenating all the \fIscript\fR
arguments in the same fashion as the \fBconcat\fR command.
The command will be executed at global level (outside the context
of any Tcl procedure).
-If an error occurs while executing the delayed command then
+If an error occurs while executing the delayed command then
the background error will be reported by the command
registered with \fBinterp bgerror\fR.
The \fBafter\fR command returns an identifier that can be used
diff --git a/doc/append.n b/doc/append.n
index 034068d..e3bf224 100644
--- a/doc/append.n
+++ b/doc/append.n
@@ -4,9 +4,9 @@
'\"
'\" See 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..aeb2227 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
@@ -14,11 +14,11 @@ apply \- Apply an anonymous function
.SH DESCRIPTION
.PP
The command \fBapply\fR applies the function \fIfunc\fR to the arguments
-\fIarg1 arg2 ...\fR and returns the result.
+\fIarg1 arg2 ...\fR and returns the result.
.PP
The function \fIfunc\fR is a two element list \fI{args body}\fR or a three
element list \fI{args body namespace}\fR (as if the
-\fBlist\fR command had been used).
+\fBlist\fR command had been used).
The first element \fIargs\fR specifies the formal arguments to
\fIfunc\fR. The specification of the formal arguments \fIargs\fR
is shared with the \fBproc\fR command, and is described in detail in the
@@ -96,7 +96,7 @@ set vbl abc
.SH "SEE ALSO"
proc(n), uplevel(n)
.SH KEYWORDS
-anonymous function, argument, lambda, procedure,
+anonymous function, argument, lambda, procedure,
'\" Local Variables:
'\" mode: nroff
'\" End:
diff --git a/doc/array.n b/doc/array.n
index 47f9624..25ad0c6 100644
--- a/doc/array.n
+++ b/doc/array.n
@@ -4,9 +4,9 @@
'\"
'\" See 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 16a23a3..3644b3d 100644
--- a/doc/bgerror.n
+++ b/doc/bgerror.n
@@ -4,9 +4,9 @@
'\"
'\" See 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
diff --git a/doc/binary.n b/doc/binary.n
index a40afe6..5f25d65 100644
--- a/doc/binary.n
+++ b/doc/binary.n
@@ -4,9 +4,9 @@
'\"
'\" See 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"
@@ -288,7 +300,7 @@ example,
.CS
\fBbinary format\fR s3 {3 -3 258 1}
.CE
-will return a string equivalent to
+will return a string equivalent to
\fB\ex03\ex00\exfd\exff\ex02\ex01\fR.
.RE
.IP \fBS\fR 5
@@ -299,7 +311,7 @@ example,
.CS
\fBbinary format\fR S3 {3 -3 258 1}
.CE
-will return a string equivalent to
+will return a string equivalent to
\fB\ex00\ex03\exff\exfd\ex01\ex02\fR.
.RE
.IP \fBt\fR 5
@@ -318,7 +330,7 @@ example,
.CS
\fBbinary format\fR i3 {3 -3 65536 1}
.CE
-will return a string equivalent to
+will return a string equivalent to
\fB\ex03\ex00\ex00\ex00\exfd\exff\exff\exff\ex00\ex00\ex01\ex00\fR
.RE
.IP \fBI\fR 5
@@ -329,7 +341,7 @@ For example,
.CS
\fBbinary format\fR I3 {3 -3 65536 1}
.CE
-will return a string equivalent to
+will return a string equivalent to
\fB\ex00\ex00\ex00\ex03\exff\exff\exff\exfd\ex00\ex01\ex00\ex00\fR
.RE
.IP \fBn\fR 5
@@ -385,7 +397,7 @@ on a Windows system running on an Intel Pentium processor,
.CS
\fBbinary format\fR f2 {1.6 3.4}
.CE
-will return a string equivalent to
+will return a string equivalent to
\fB\excd\excc\excc\ex3f\ex9a\ex99\ex59\ex40\fR.
.RE
.IP \fBr\fR 5
@@ -406,7 +418,7 @@ Windows system running on an Intel Pentium processor,
.CS
\fBbinary format\fR d1 {1.6}
.CE
-will return a string equivalent to
+will return a string equivalent to
\fB\ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f\fR.
.RE
.IP \fBq\fR 5
@@ -672,7 +684,7 @@ order. For example,
\fBbinary scan\fR \ex00\ex05\ex00\ex07\exff\exf0 S2S* var1 var2
.CE
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
-stored in \fIvar2\fR.
+stored in \fIvar2\fR.
.RE
.IP \fBt\fR 5
The data is interpreted as \fIcount\fR 16-bit signed integers
@@ -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), tcl_platform(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 9597ccf..d43a7ec 100644
--- a/doc/catch.n
+++ b/doc/catch.n
@@ -5,9 +5,9 @@
'\"
'\" See 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
@@ -43,7 +43,7 @@ value stored in \fIresultVarName\fR is the value returned from \fIscript\fR.
.PP
If the \fIoptionsVarName\fR argument is given, then the variable it
names is set to a dictionary of return options returned by evaluation
-of \fIscript\fR. Tcl specifies two entries that are always
+of \fIscript\fR. Tcl specifies two entries that are always
defined in the dictionary: \fB\-code\fR and \fB\-level\fR. When
the return code from evaluation of \fIscript\fR is not \fBTCL_RETURN\fR,
the value of the \fB\-level\fR entry will be 0, and the value
@@ -114,7 +114,7 @@ if { [\fBcatch\fR {open $someFile w} fid] } {
.PP
There are more complex examples of \fBcatch\fR usage in the
documentation for the \fBreturn\fR command.
-.SH "SEE ALSO"
+.SH "SEE ALSO"
break(n), continue(n), dict(n), error(n), errorCode(n), errorInfo(n), info(n),
return(n)
.SH KEYWORDS
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..7ea0d19 100644
--- a/doc/chan.n
+++ b/doc/chan.n
@@ -1,10 +1,10 @@
-'\"
+'\"
'\" Copyright (c) 2005-2006 Donal K. Fellows
'\"
'\" See 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
@@ -200,7 +200,7 @@ generate an error.
.TP
\fB\-translation\fR \fImode\fR
.TP
-\fB\-translation\fR \fB{\fIinMode outMode\fB}\fR
+\fB\-translation\fR \fB{\fIinMode outMode\fB}\fR
.
In Tcl scripts the end of a line is always represented using a single
newline character (\en). However, in actual files and devices the end
@@ -240,7 +240,7 @@ all platforms Tcl chooses \fBcrlf\fR, for all Unix flavors, it chooses
\fBcrlf\fR. The default setting for \fB\-translation\fR is \fBauto\fR
for both input and output.
.TP
-\fBbinary\fR
+\fBbinary\fR
.
No end-of-line translations are performed. This is nearly identical
to \fBlf\fR mode, except that in addition \fBbinary\fR mode also sets
@@ -530,8 +530,8 @@ only those channel names that match it (according to the rules of
.
Depending on whether \fImode\fR is \fBinput\fR or \fBoutput\fR,
returns the number of
-bytes of input or output (respectively) currently buffered
-internally for \fIchannelId\fR (especially useful in a readable event
+bytes of input or output (respectively) currently buffered
+internally for \fIchannelId\fR (especially useful in a readable event
callback to impose application-specific limits on input line lengths to avoid
a potential denial-of-service attack where a hostile user crafts
an extremely long line that exceeds the available memory to buffer it).
@@ -546,7 +546,7 @@ separately \fBstderr\fR and \fBstdout\fR from a subprocess. To do
this, spawn with "2>@" or
">@" redirection operators onto the write side of a pipe, and then
immediately close it in the parent. This is necessary to get an EOF on
-the read side once the child has exited or otherwise closed its output.
+the read side once the child has exited or otherwise closed its output.
.VE 8.6
.TP
\fBchan pop \fIchannelId\fR
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..889a5da 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
@@ -16,13 +16,13 @@ package require \fBTcl 8.5\fR
.sp
\fBclock format\fR \fItimeVal\fR ?\fI\-option value\fR...?
.sp
-\fBclock microseconds\fR
+\fBclock microseconds\fR
.sp
-\fBclock milliseconds\fR
+\fBclock milliseconds\fR
.sp
\fBclock scan\fR \fIinputString\fR ?\fI\-option value\fR...?
.sp
-\fBclock seconds\fR
+\fBclock seconds\fR
.sp
.BE
.SH "DESCRIPTION"
@@ -58,10 +58,10 @@ Formats a time that is expressed as an integer number of seconds into a format
intended for consumption by users or external programs.
See \fBFORMATTING TIMES\fR for a full description.
.TP
-\fBclock microseconds\fR
+\fBclock microseconds\fR
Returns the current time as an integer number of microseconds. See \fBHIGH RESOLUTION TIMERS\fR for a full description.
.TP
-\fBclock milliseconds\fR
+\fBclock milliseconds\fR
Returns the current time as an integer number of milliseconds. See \fBHIGH RESOLUTION TIMERS\fR for a full description.
.TP
\fBclock scan\fR \fIinputString\fR ?\fI\-option value\fR...?
@@ -69,7 +69,7 @@ Scans a time that is expressed as a character string and produces an
integer number of seconds.
See \fBSCANNING TIMES\fR for a full description.
.TP
-\fBclock seconds\fR
+\fBclock seconds\fR
Returns the current time as an integer number of seconds.
.SS "PARAMETERS"
.TP
@@ -113,7 +113,7 @@ and their interpretation, are described under \fBFORMAT GROUPS\fR.
On \fBclock format\fR, the default format is
.PP
.CS
-%a %b %d %H:%M:%S %z %Y
+%a %b %d %H:%M:%S %Z %Y
.CE
.PP
On \fBclock scan\fR, the lack of a \fB\-format\fR option indicates that a
@@ -525,7 +525,7 @@ string of the same meaning in the locale, to indicate whether \fB%Y\fR refers
to years before or after Year 1 of the Common Era. On input, accepts
the string \fBB.C.E.\fR, \fBB.C.\fR, \fBC.E.\fR, \fBA.D.\fR, or the
abbreviation appropriate to the current locale, and uses it to fix
-whether \fB%Y\fR refers to years before or after Year 1 of the
+whether \fB%Y\fR refers to years before or after Year 1 of the
Common Era.
.TP
\fB%Ex\fR
@@ -637,8 +637,9 @@ On output, produces a locale-dependent time of day representation on a
12-hour clock. On input, accepts whatever \fB%r\fR produces.
.TP
\fB%R\fR
-On output, produces a locale-dependent time of day representation on a
-24-hour clock. On input, accepts whatever \fB%R\fR produces.
+On output, the time in 24-hour notation (%H:%M). For a version
+including the seconds, see \fB%T\fR below. On input, accepts whatever
+\fB%R\fR produces.
.TP
\fB%s\fR
On output, simply formats the \fItimeVal\fR argument as a decimal
@@ -683,8 +684,8 @@ ISO8601 week number.
\fB%w\fR
On output, produces the ordinal number of the day of the week
(Sunday==0; Saturday==6). On input, accepts a single digit and
-interprets it as the day of the week; Sunday may be represented as
-either 0 or 7. Note that \fB%w\fR is not the ISO8601 weekday number,
+interprets it as the day of the week; Sunday may be represented as
+either 0 or 7. Note that \fB%w\fR is not the ISO8601 weekday number,
which is produced and accepted by \fB%u\fR.
.TP
\fB%W\fR
@@ -764,7 +765,7 @@ The local time zone from the Control Panel on Windows systems.
The C library's idea of the local time zone, as defined by the
\fBmktime\fR and \fBlocaltime\fR functions.
.PP
-In case [1] \fIonly,\fR the string is tested to see if it is one
+In case [1] \fIonly,\fR the string is tested to see if it is one
of the strings:
.PP
.CS
@@ -782,7 +783,7 @@ of the strings:
If it is a string in the above list, it designates a known
time zone, and is interpreted as such.
.PP
-For time zones in case [1] that do not match any of the above strings,
+For time zones in case [1] that do not match any of the above strings,
and always for cases [2]-[6], the following rules apply.
.PP
If the time zone begins with a colon, it is one of a
@@ -908,7 +909,7 @@ giving an explicit \fB\-format\fR option to the \fBclock scan\fR command.
.TP
\fIrelative time\fR
A specification relative to the current time. The format is \fBnumber
-unit\fR. Acceptable units are \fByear\fR, \fBfortnight\fR,
+unit\fR. Acceptable units are \fByear\fR, \fBfortnight\fR,
\fBmonth\fR, \fBweek\fR, \fBday\fR,
\fBhour\fR, \fBminute\fR (or \fBmin\fR), and \fBsecond\fR (or \fBsec\fR). The
unit can be specified as a singular or plural, as in \fB3 weeks\fR.
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..ac3d8ed 100644
--- a/doc/dde.n
+++ b/doc/dde.n
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -85,7 +85,7 @@ the command returns immediately with no error.
.VS 8.6
Without the \fB\-binary\fR option all data will be sent in unicode. For
dde clients which don't implement the CF_UNICODE clipboard format, this
-will automatically be translated to the system encoding. You can use
+will automatically be translated to the system encoding. You can use
the \fB\-binary\fR option in combination with the result of
\fBencoding convertto\fR to send data in any other encoding.
.VE 8.6
@@ -102,7 +102,7 @@ application.
.VS 8.6
Without the \fB\-binary\fR option all data will be sent in unicode. For
dde clients which don't implement the CF_UNICODE clipboard format, this
-will automatically be translated to the system encoding. You can use
+will automatically be translated to the system encoding. You can use
the \fB\-binary\fR option in combination with the result of
\fBencoding convertto\fR to send data in any other encoding.
.VE 8.6
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..fecad85 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
@@ -25,11 +25,12 @@ below for a description), depending on \fIoption\fR. The legal
This appends the given string (or strings) to the value that the given
key maps to in the dictionary value contained in the given variable,
writing the resulting dictionary value back to that variable.
-Non-existent keys are treated as if they map to an empty string.
+Non-existent keys are treated as if they map to an empty string. The
+updated dictionary value is returned.
.TP
\fBdict create \fR?\fIkey value ...\fR?
.
-Create a new dictionary that contains each of the key/value mappings
+Return a new dictionary that contains each of the key/value mappings
listed as arguments (keys and values alternating, with each key being
followed by its associated value.)
.TP
@@ -53,10 +54,10 @@ The key rule only matches those key/value pairs whose keys match any
of the given patterns (in the style of \fBstring match\fR.)
.VE 8.6
.TP
-\fBdict filter \fIdictionaryValue \fBscript {\fIkeyVar valueVar\fB} \fIscript\fR
+\fBdict filter \fIdictionaryValue \fBscript {\fIkeyVariable valueVariable\fB} \fIscript\fR
.
The script rule tests for matching by assigning the key to the
-\fIkeyVar\fR and the value to the \fIvalueVar\fR, and then evaluating
+\fIkeyVariable\fR and the value to the \fIvalueVariable\fR, and then evaluating
the given script which should return a boolean value (with the
key/value pair only being included in the result of the \fBdict
filter\fR when a true value is returned.) Note that the first
@@ -74,7 +75,7 @@ of the given patterns (in the style of \fBstring match\fR.)
.VE 8.6
.RE
.TP
-\fBdict for {\fIkeyVar valueVar\fB} \fIdictionaryValue body\fR
+\fBdict for {\fIkeyVariable valueVariable\fB} \fIdictionaryValue body\fR
.
This command takes three arguments, the first a two-element list of
variable names (for the key and value respectively of each mapping in
@@ -121,7 +122,8 @@ not specified) to the value that the given key maps to in the
dictionary value contained in the given variable, writing the
resulting dictionary value back to that variable. Non-existent keys
are treated as if they map to 0. It is an error to increment a value
-for an existing key if that value is not an integer.
+for an existing key if that value is not an integer. The updated
+dictionary value is returned.
.TP
\fBdict info \fIdictionaryValue\fR
.
@@ -145,9 +147,10 @@ to in the dictionary value contained in the given variable, writing
the resulting dictionary value back to that variable. Non-existent
keys are treated as if they map to an empty list, and it is legal for
there to be no items to append to the list. It is an error for the
-value that the key maps to to not be representable as a list.
+value that the key maps to to not be representable as a list. The
+updated dictionary value is returned.
.TP
-\fBdict map \fR{\fIkeyVar valueVar\fR} \fIdictionaryValue body\fR
+\fBdict map \fR{\fIkeyVariable valueVariable\fR} \fIdictionaryValue body\fR
.
This command applies a transformation to each element of a dictionary,
returning a new dictionary. It takes three arguments: the first is a
@@ -157,7 +160,7 @@ and the third a script to be evaluated for each mapping with the key and value
variables set appropriately (in the manner of \fBlmap\fR). In an iteration
where the evaluated script completes normally (\fBTCL_OK\fR, as opposed to an
\fBerror\fR, etc.) the result of the script is put into an accumulator
-dictionary using the key that is the current contents of the \fIkeyVar\fR
+dictionary using the key that is the current contents of the \fIkeyVariable\fR
variable at that point. The result of the \fBdict map\fR command is the
accumulator dictionary after all keys have been iterated over.
.RS
@@ -202,7 +205,7 @@ This operation takes the name of a variable containing a dictionary
value and places an updated dictionary value in that variable
containing a mapping from the given key to the given value. When
multiple keys are present, this operation creates or updates a chain
-of nested dictionaries.
+of nested dictionaries. The updated dictionary value is returned.
.TP
\fBdict size \fIdictionaryValue\fR
.
@@ -216,7 +219,8 @@ dictionary value in that variable that does not contain a mapping for
the given key. Where multiple keys are present, this describes a path
through nested dictionaries to the mapping to remove. At least one key
must be specified, but the last key on the key-path need not exist.
-All other components on the path must exist.
+All other components on the path must exist. The updated dictionary
+value is returned.
.TP
\fBdict update \fIdictionaryVariable key varName \fR?\fIkey varName ...\fR? \fIbody\fR
.
diff --git a/doc/encoding.n b/doc/encoding.n
index 5269a18..50ad083 100644
--- a/doc/encoding.n
+++ b/doc/encoding.n
@@ -1,11 +1,11 @@
'\"
'\" Copyright (c) 1998 by Scriptics Corporation.
-'\"
+'\"
'\" See 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?
.
@@ -55,7 +67,12 @@ searchable directory, that element is ignored.
\fBencoding names\fR
.
Returns a list containing the names of all of the encodings that are
-currently available.
+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..c05f8b9 100644
--- a/doc/error.n
+++ b/doc/error.n
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -28,7 +28,7 @@ the Tcl interpreter adds information to the \fB\-errorinfo\fR
return option. If the \fIinfo\fR argument is present, it is
used to initialize the \fB\-errorinfo\fR return options and
the first increment of unwind information
-will not be added by the Tcl interpreter.
+will not be added by the Tcl interpreter.
In other
words, the command containing the \fBerror\fR command will not appear
in the stack trace; in its place will be \fIinfo\fR.
diff --git a/doc/eval.n b/doc/eval.n
index 13b54be..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
diff --git a/doc/exec.n b/doc/exec.n
index 5072d61..9d58d90 100644
--- a/doc/exec.n
+++ b/doc/exec.n
@@ -5,9 +5,9 @@
'\"
'\" See 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
@@ -220,7 +220,7 @@ discarded.
The Tk console text widget does not provide real standard IO capabilities.
Under Tk, when redirecting from standard input, all applications will see an
immediate end-of-file; information redirected to standard output or standard
-error will be discarded.
+error will be discarded.
.PP
Either forward or backward slashes are accepted as path separators for
arguments to Tcl commands. When executing an application, the path name
@@ -231,7 +231,7 @@ backslashes only in paths. Any arguments to an application that specify a
path name with forward slashes will not automatically be converted to use
the backslash character. If an argument contains forward slashes as the
path separator, it may or may not be recognized as a path name, depending on
-the program.
+the program.
.PP
Additionally, when calling a 16-bit DOS or Windows 3.X application, all path
names must use the short, cryptic, path format (e.g., using
@@ -269,17 +269,13 @@ present, as is done when launching applications under wish. It is desirable
to have console applications hidden and detached. This is a designed-in
limitation as \fBexec\fR wants to communicate over pipes. The Expect
extension addresses this issue when communicating with a TUI application.
-.RE
-.TP
-\fBWindows NT\fR
-.
+.PP
When attempting to execute an application, \fBexec\fR first searches for
the name as it was specified. Then, in order, \fB.com\fR, \fB.exe\fR, and
\fB.bat\fR are appended to the end of the specified name and it searches
for the longer name. If a directory name was not specified as part of the
application name, the following directories are automatically searched in
order when attempting to locate the application:
-.RS
.IP \(bu 3
The directory from which the Tcl executable was loaded.
.IP \(bu 3
@@ -299,67 +295,6 @@ the caller must prepend the desired command with
because built-in commands are not implemented using executables.
.RE
.TP
-\fBWindows 9x\fR
-.
-When attempting to execute an application, \fBexec\fR first searches for
-the name as it was specified. Then, in order, \fB.com\fR, \fB.exe\fR, and
-\fB.bat\fR are appended to the end of the specified name and it searches
-for the longer name. If a directory name was not specified as part of the
-application name, the following directories are automatically searched in
-order when attempting to locate the application:
-.RS
-.IP \(bu 3
-The directory from which the Tcl executable was loaded.
-.IP \(bu 3
-The current directory.
-.IP \(bu 3
-The Windows 9x system directory.
-.IP \(bu 3
-The Windows 9x home directory.
-.IP \(bu 3
-The directories listed in the path.
-.RE
-.RS
-.PP
-In order to execute shell built-in commands like \fBdir\fR and \fBcopy\fR,
-the caller must prepend the desired command with
-.QW "\fBcommand.com /c\0\fR"
-because built-in commands are not implemented using executables.
-.PP
-Once a 16-bit DOS application has read standard input from a console and
-then quit, all subsequently run 16-bit DOS applications will see the
-standard input as already closed. 32-bit applications do not have this
-problem and will run correctly, even after a 16-bit DOS application thinks
-that standard input is closed. There is no known workaround for this bug
-at this time.
-.PP
-Redirection between the \fBNUL:\fR device and a 16-bit application does not
-always work. When redirecting from \fBNUL:\fR, some applications may hang,
-others will get an infinite stream of
-.QW 0x01
-bytes, and some will actually
-correctly get an immediate end-of-file; the behavior seems to depend upon
-something compiled into the application itself. When redirecting greater than
-4K or so to \fBNUL:\fR, some applications will hang. The above problems do not
-happen with 32-bit applications.
-.PP
-All DOS 16-bit applications are run synchronously. All standard input from
-a pipe to a 16-bit DOS application is collected into a temporary file; the
-other end of the pipe must be closed before the 16-bit DOS application
-begins executing. All standard output or error from a 16-bit DOS
-application to a pipe is collected into temporary files; the application
-must terminate before the temporary files are redirected to the next stage
-of the pipeline. This is due to a workaround for a Windows 95 bug in the
-implementation of pipes, and is how the standard Windows 95 DOS shell
-handles pipes itself.
-.PP
-Certain applications, such as \fBcommand.com\fR, should not be executed
-interactively. Applications which directly access the console window,
-rather than reading from their standard input and writing to their standard
-output may fail, hang Tcl, or even hang the system if their own private
-console window is not available to them.
-.RE
-.TP
\fBUnix\fR (including Mac OS X)
.
The \fBexec\fR command is fully functional and works as described.
diff --git a/doc/exit.n b/doc/exit.n
index ceb0529..9b4ad20 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
@@ -35,7 +35,7 @@ proc main {} {
if {[catch {main} msg options]} {
puts stderr "unexpected script error: $msg"
- if {[info exist env(DEBUG)]} {
+ if {[info exists env(DEBUG)]} {
puts stderr "---- BEGIN TRACE ----"
puts stderr [dict get $options -errorinfo]
puts stderr "---- END TRACE ----"
diff --git a/doc/expr.n b/doc/expr.n
index 8698f5c..b76b6a2 100644
--- a/doc/expr.n
+++ b/doc/expr.n
@@ -5,9 +5,9 @@
'\"
'\" See 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
@@ -398,7 +398,7 @@ Most expressions do not require a second round of substitutions.
Either they are enclosed in braces or, if not,
their variable and command substitutions yield numbers or strings
that do not themselves require substitutions.
-However, because a few unbraced expressions
+However, because a few unbraced expressions
need two rounds of substitutions,
the bytecode compiler must emit
additional instructions to handle this situation.
diff --git a/doc/fconfigure.n b/doc/fconfigure.n
index 550d071..8da76c6 100644
--- a/doc/fconfigure.n
+++ b/doc/fconfigure.n
@@ -1,11 +1,11 @@
-'\"
+'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-.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
@@ -125,7 +125,7 @@ generate an error.
.TP
\fB\-translation\fR \fImode\fR
.TP
-\fB\-translation\fR \fB{\fIinMode outMode\fB}\fR
+\fB\-translation\fR \fB{\fIinMode outMode\fB}\fR
.
In Tcl scripts the end of a line is always represented using a single
newline character (\en). However, in actual files and devices the end of
@@ -163,7 +163,7 @@ Tcl chooses \fBcrlf\fR, for all Unix flavors, it chooses \fBlf\fR, and
for the various flavors of Windows it chooses \fBcrlf\fR. The default
setting for \fB\-translation\fR is \fBauto\fR for both input and output.
.TP
-\fBbinary\fR
+\fBbinary\fR
.
No end-of-line translations are performed. This is nearly identical to
\fBlf\fR mode, except that in addition \fBbinary\fR mode also sets the
diff --git a/doc/fcopy.n b/doc/fcopy.n
index 6a4bf1a..e5dd1d6 100644
--- a/doc/fcopy.n
+++ b/doc/fcopy.n
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -23,9 +23,9 @@ avoid extra copies and to avoid buffering too much data in
main memory when copying large files to slow destinations like
network sockets.
.PP
-The \fBfcopy\fR
+The \fBfcopy\fR
command transfers data from \fIinchan\fR until end of file
-or \fIsize\fR bytes have been
+or \fIsize\fR bytes have been
transferred. If no \fB\-size\fR argument is given,
then the copy goes until end of file.
All the data read from \fIinchan\fR is copied to \fIoutchan\fR.
@@ -36,7 +36,7 @@ The \fB\-command\fR argument makes \fBfcopy\fR work in the background.
In this case it returns immediately and the \fIcallback\fR is invoked
later when the copy completes.
The \fIcallback\fR is called with
-one or two additional
+one or two additional
arguments that indicates how many bytes were written to \fIoutchan\fR.
If an error occurred during the background copy, the second argument is the
error string associated with the error.
@@ -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
@@ -106,7 +109,7 @@ fconfigure $out -translation binary
This second example shows how the callback gets
passed the number of bytes transferred.
It also uses vwait to put the application into the event loop.
-Of course, this simplified example could be done without the command
+Of course, this simplified example could be done without the command
callback.
.PP
.CS
@@ -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 0b0ee9d..8e765da 100644
--- a/doc/file.n
+++ b/doc/file.n
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -23,7 +23,7 @@ substitution is done before executing the command (see the manual entry for
file name. Any unique abbreviation for \fIoption\fR is acceptable. The
valid options are:
.TP
-\fBfile atime \fIname\fR ?\fBtime\fR?
+\fBfile atime \fIname\fR ?\fItime\fR?
.
Returns a decimal string giving the time at which file \fIname\fR was last
accessed. If \fItime\fR is specified, it is an access time to set
@@ -34,9 +34,9 @@ generated. On Windows, FAT file systems do not support access time.
.TP
\fBfile attributes \fIname\fR
.TP
-\fBfile attributes \fIname\fR ?\fBoption\fR?
+\fBfile attributes \fIname\fR ?\fIoption\fR?
.TP
-\fBfile attributes \fIname\fR ?\fBoption value option value...\fR?
+\fBfile attributes \fIname\fR ?\fIoption value option value...\fR?
.
This subcommand returns or sets platform specific values associated
with a file. The first form returns a list of the platform specific
@@ -80,7 +80,7 @@ set to the value 0, which results in the resource fork being stripped
off the file.
.RE
.TP
-\fBfile channels ?\fIpattern\fR?
+\fBfile channels\fR ?\fIpattern\fR?
.
If \fIpattern\fR is not specified, returns a list of names of all
registered open channels in this interpreter. If \fIpattern\fR is
@@ -141,7 +141,7 @@ returned. For example,
\fBfile dirname\fR c:/
.CE
.PP
-returns \fBc:/\fR.
+returns \fBc:/\fR.
.PP
Note that tilde substitution will only be
performed if it is necessary to complete the command. For example,
@@ -162,7 +162,7 @@ returns \fB/home\fR (or something similar).
\fBfile executable \fIname\fR
.
Returns \fB1\fR if file \fIname\fR is executable by the current user,
-\fB0\fR otherwise.
+\fB0\fR otherwise.
.TP
\fBfile exists \fIname\fR
.
@@ -203,7 +203,7 @@ is always canonical for the current platform: \fB/\fR for Unix and
Windows.
.RE
.TP
-\fBfile link ?\fI\-linktype\fR? \fIlinkName\fR ?\fItarget\fR?
+\fBfile link\fR ?\fI\-linktype\fR? \fIlinkName\fR ?\fItarget\fR?
.
If only one argument is given, that argument is assumed to be
\fIlinkName\fR, and this command returns the value of the link given by
@@ -241,11 +241,9 @@ as relative to the cwd). Furthermore,
paths are always expanded
to absolute form. When creating links on filesystems that either do not
support any links, or do not support the specific type requested, an
-error message will be returned. In particular Windows 95, 98 and ME do
-not support any links at present, but most Unix platforms support both
-symbolic and hard links (the latter for files only) and Windows
-NT/2000/XP (on NTFS drives) support symbolic
-directory links and hard file links.
+error message will be returned. Most Unix platforms support both
+symbolic and hard links (the latter for files only). Windows
+supports symbolic directory links and hard file links on NTFS drives.
.RE
.TP
\fBfile lstat \fIname varName\fR
@@ -257,7 +255,7 @@ is for the link rather than the file it refers to. On systems that
do not support symbolic links this option behaves exactly the same
as the \fBstat\fR option.
.TP
-\fBfile mkdir ?\fIdir\fR ...?
+\fBfile mkdir\fR ?\fIdir\fR ...?
.
Creates each directory specified. For each pathname \fIdir\fR specified,
this command will create all non-existing parent directories as
@@ -302,7 +300,7 @@ operate on the actual symbolic link itself (for example \fBfile delete\fR,
\fBfile rename\fR, \fBfile copy\fR are defined to operate on symbolic
links, not on the things that they point to).
.TP
-\fBfile owned \fIname\fR
+\fBfile owned \fIname\fR
.
Returns \fB1\fR if file \fIname\fR is owned by the current user, \fB0\fR
otherwise.
@@ -320,7 +318,7 @@ type is \fBvolumerelative\fR.
\fBfile readable \fIname\fR
.
Returns \fB1\fR if file \fIname\fR is readable by the current user,
-\fB0\fR otherwise.
+\fB0\fR otherwise.
.TP
\fBfile readlink \fIname\fR
.
@@ -358,7 +356,7 @@ component of \fIname\fR does not contain a dot, then returns \fIname\fR.
.TP
\fBfile separator\fR ?\fIname\fR?
.
-If no argument is given, returns the character which is used to separate
+If no argument is given, returns the character which is used to separate
path segments for native files on this platform. If a path is given,
the filesystem responsible for that path is asked to return its
separator character. If no file system accepts \fIname\fR, an error
@@ -429,7 +427,7 @@ If the file does not belong to any filesystem, an error is generated.
.
Returns all of the characters in the last filesystem component of
\fIname\fR. Any trailing directory separator in \fIname\fR is ignored.
-If \fIname\fR contains no separators then returns \fIname\fR. So,
+If \fIname\fR contains no separators then returns \fIname\fR. So,
\fBfile tail a/b\fR, \fBfile tail a/b/\fR and \fBfile tail b\fR all
return \fBb\fR.
.TP
@@ -459,7 +457,7 @@ Returns a string giving the type of file \fIname\fR, which will be one of
\fBfifo\fR, \fBlink\fR, or \fBsocket\fR.
.TP
\fBfile volumes\fR
-.
+.
Returns the absolute paths to the volumes mounted on the system, as a
proper Tcl list. Without any virtual filesystems mounted as root
volumes, on UNIX, the command will always return
@@ -480,11 +478,11 @@ Returns \fB1\fR if file \fIname\fR is writable by the current user,
\fBUnix\fR\0\0\0\0\0\0\0
.
These commands always operate using the real user and group identifiers,
-not the effective ones.
+not the effective ones.
.TP
\fBWindows\fR\0\0\0\0
.
-The \fbfile owned\fR subcommand currently always reports that the current user
+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.
diff --git a/doc/fileevent.n b/doc/fileevent.n
index e453748..2751040 100644
--- a/doc/fileevent.n
+++ b/doc/fileevent.n
@@ -5,9 +5,9 @@
'\"
'\" See 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
@@ -112,7 +112,7 @@ buggy handlers.
In this setup \fBGetData\fR will be called with the channel as an
argument whenever $chan becomes readable. The \fBread\fR call will
read whatever binary data is currently available without blocking.
-Here the channel has the fileevent removed when an end of file
+Here the channel has the fileevent removed when an end of file
occurs to avoid being continually called (see above). Alternatively
the channel may be closed on this condition.
.PP
diff --git a/doc/filename.n b/doc/filename.n
index d481fc9..87ba467 100644
--- a/doc/filename.n
+++ b/doc/filename.n
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -29,7 +29,7 @@ File names are grouped into three general types based on the starting point
for the path used to specify the file: absolute, relative, and
volume-relative. Absolute names are completely qualified, giving a path to
the file relative to a particular volume and the root directory on that
-volume. Relative names are unqualified, giving a path to the file relative
+volume. Relative names are unqualified, giving a path to the file relative
to the current working directory. Volume-relative names are partially
qualified, either giving the path relative to the root directory on the
current volume, or relative to the current directory of the specified
@@ -75,7 +75,7 @@ current directory.
.TP 15
\fB\&../foo\fR
Relative path to the file \fBfoo\fR in the directory above the current
-directory.
+directory.
.RE
.TP
\fBWindows\fR
@@ -84,7 +84,7 @@ style names. Both \fB/\fR and \fB\e\fR may be used as directory separators
in either type of name. Drive-relative names consist of an optional drive
specifier followed by an absolute or relative path. UNC paths follow the
general form \fB\e\eservername\esharename\epath\efile\fR, but must at
-the very least contain the server and share components, i.e.
+the very least contain the server and share components, i.e.
\fB\e\eservername\esharename\fR. In both forms,
the file names \fB.\fR and \fB..\fR are special and refer to the current
directory and the parent of the current directory respectively. The
@@ -154,7 +154,7 @@ native path names). Also Windows 3.1 only supports file
names with a root of no more than 8 characters and an extension of no
more than 3 characters.
.PP
-On Windows platforms there are file and path length restrictions.
+On Windows platforms there are file and path length restrictions.
Complete paths or filenames longer than about 260 characters will lead
to errors in most file operations.
.PP
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..9a3235f 100644
--- a/doc/for.n
+++ b/doc/for.n
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -49,7 +49,7 @@ each loop iteration), so changes in the variables will be visible.
See below for an example:
.SH EXAMPLES
.PP
-Print a line for each of the integers from 0 to 10:
+Print a line for each of the integers from 0 to 9:
.PP
.CS
\fBfor\fR {set x 0} {$x<10} {incr x} {
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..ba044f2 100644
--- a/doc/format.n
+++ b/doc/format.n
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -25,14 +25,14 @@ arguments, if any, provide values to be substituted into the result.
The return value from \fBformat\fR is the formatted string.
.SH "DETAILS ON FORMATTING"
.PP
-The command operates by scanning \fIformatString\fR from left to right.
+The command operates by scanning \fIformatString\fR from left to right.
Each character from the format string is appended to the result
string unless it is a percent sign.
If the character is a \fB%\fR then it is not copied to the result string.
Instead, the characters following the \fB%\fR character are treated as
a conversion specifier.
The conversion specifier controls the conversion of the next successive
-\fIarg\fR to a particular format and the result is appended to
+\fIarg\fR to a particular format and the result is appended to
the result string in place of the conversion specifier.
If there are multiple conversion specifiers in the format string,
then each one controls the conversion of one additional \fIarg\fR.
@@ -66,12 +66,12 @@ The second portion of a conversion specifier may contain any of the
following flag characters, in any order:
.TP 10
\fB\-\fR
-Specifies that the converted argument should be left-justified
-in its field (numbers are normally right-justified with leading
+Specifies that the converted argument should be left-justified
+in its field (numbers are normally right-justified with leading
spaces if needed).
.TP 10
\fB+\fR
-Specifies that a number should always be printed with a sign,
+Specifies that a number should always be printed with a sign,
even if positive.
.TP 10
\fIspace\fR
@@ -79,7 +79,7 @@ Specifies that a space should be added to the beginning of the
number if the first character is not a sign.
.TP 10
\fB0\fR
-Specifies that the number should be padded on the left with
+Specifies that the number should be padded on the left with
zeroes instead of spaces.
.TP 10
\fB#\fR
@@ -90,9 +90,9 @@ will be added to the beginning of the result unless it is zero.
For \fBb\fR conversions, \fB0b\fR
will be added to the beginning of the result unless it is zero.
For all floating-point conversions (\fBe\fR, \fBE\fR, \fBf\fR,
-\fBg\fR, and \fBG\fR) it guarantees that the result always
+\fBg\fR, and \fBG\fR) it guarantees that the result always
has a decimal point.
-For \fBg\fR and \fBG\fR conversions it specifies that
+For \fBg\fR and \fBG\fR conversions it specifies that
trailing zeroes should not be removed.
.SS "OPTIONAL FIELD WIDTH"
.PP
@@ -103,7 +103,7 @@ If the converted argument contains fewer characters than the
minimum field width then it will be padded so that it is as wide
as the minimum field width.
Padding normally occurs by adding extra spaces on the left of the
-converted argument, but the \fB0\fR and \fB\-\fR flags
+converted argument, but the \fB0\fR and \fB\-\fR flags
may be used to specify padding with zeroes on the left or with
spaces on the right, respectively.
If the minimum field width is specified as \fB*\fR rather than
@@ -122,7 +122,7 @@ point (however, trailing zeroes after the decimal point will still
be omitted unless the \fB#\fR flag has been specified).
For integer conversions, it specifies a minimum number of digits
to print (leading zeroes will be added if necessary).
-For \fBs\fR conversions it specifies the maximum number of characters to be
+For \fBs\fR conversions it specifies the maximum number of characters to be
printed; if the string is longer than this then the trailing characters will be dropped.
If the precision is specified with \fB*\fR rather than a number
then the next argument to the \fBformat\fR command determines the precision;
@@ -135,7 +135,7 @@ If it is \fBll\fR it specifies that an integer value is taken
without truncation for conversion to a formatted substring.
If it is \fBh\fR it specifies that an integer value is
truncated to a 16-bit range before converting. This option is rarely useful.
-If it is \fBl\fR it specifies that the integer value is
+If it is \fBl\fR it specifies that the integer value is
truncated to the same range as that produced by the \fBwide()\fR
function of the \fBexpr\fR command (at least a 64-bit range).
If neither \fBh\fR nor \fBl\fR are present, the integer value is
@@ -178,22 +178,22 @@ Convert integer to the Unicode character it represents.
No conversion; just insert string.
.TP 10
\fBf\fR
-Convert number to signed decimal string of
-the form \fIxx.yyy\fR, where the number of \fIy\fR's is determined by
+Convert number to signed decimal string of
+the form \fIxx.yyy\fR, where the number of \fIy\fR's is determined by
the precision (default: 6).
If the precision is 0 then no decimal point is output.
.TP 10
\fBe\fR or \fBE\fR
-Convert number to scientific notation in the
-form \fIx.yyy\fBe\(+-\fIzz\fR, where the number of \fIy\fR's is determined
+Convert number to scientific notation in the
+form \fIx.yyy\fBe\(+-\fIzz\fR, where the number of \fIy\fR's is determined
by the precision (default: 6).
If the precision is 0 then no decimal point is output.
-If the \fBE\fR form is used then \fBE\fR is
+If the \fBE\fR form is used then \fBE\fR is
printed instead of \fBe\fR.
.TP 10
\fBg\fR or \fBG\fR
-If the exponent is less than \-4 or greater than or equal to the
-precision, then convert number as for \fB%e\fR or
+If the exponent is less than \-4 or greater than or equal to the
+precision, then convert number as for \fB%e\fR or
\fB%E\fR.
Otherwise convert as for \fB%f\fR.
Trailing zeroes and a trailing decimal point are omitted.
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..a2cbce2 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
@@ -204,13 +204,7 @@ of the form
it refers to the home
directory of the user whose account information resides on the specified NT
domain server. Otherwise, user account information is obtained from
-the local computer. On Windows 95 and 98, \fBglob\fR accepted patterns
-like
-.QW .../
-and
-.QW ..../
-for successively higher up parent directories, but later versions of
-Windows do not accept these forms.
+the local computer.
.PP
Since the backslash character has a special meaning to the glob
command, glob patterns containing Windows style path separators need
diff --git a/doc/global.n b/doc/global.n
index c17c370..9848817 100644
--- a/doc/global.n
+++ b/doc/global.n
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -24,7 +24,7 @@ in the list returned by \fBinfo locals\fR).
.PP
If \fIvarname\fR contains namespace qualifiers, the local variable's name is
the unqualified name of the global variable, as determined by the
-\fBnamespace tail\fR command.
+\fBnamespace tail\fR command.
.PP
\fIvarname\fR is always treated as the name of a variable, not an
array element. An error is returned if the name looks like an array element,
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..80ae044 100644
--- a/doc/http.n
+++ b/doc/http.n
@@ -5,9 +5,9 @@
'\"
'\" See 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
@@ -60,7 +60,7 @@ a custom \fBsocket\fR command, via \fB::http::register\fR.
.PP
The \fB::http::geturl\fR procedure does a HTTP transaction.
Its \fIoptions \fR determine whether a GET, POST, or HEAD transaction
-is performed.
+is performed.
The return value of \fB::http::geturl\fR is a token for the transaction.
The value is also the name of an array in the ::http namespace
that contains state information about the transaction. The elements
@@ -90,7 +90,7 @@ flags and values that define the configuration:
\fB\-accept\fR \fImimetypes\fR
.
The Accept header of the request. The default is */*, which means that
-all types of documents are accepted. Otherwise you can supply a
+all types of documents are accepted. Otherwise you can supply a
comma-separated list of mime type patterns that you are
willing to receive. For example,
.QW "image/gif, image/jpeg, text/*" .
@@ -132,7 +132,7 @@ The value of the User-Agent header in the HTTP request. The default is
.QW "\fBTcl http client package 2.7\fR" .
.RE
.TP
-\fB::http::geturl\fR \fIurl\fR ?\fIoptions\fR?
+\fB::http::geturl\fR \fIurl\fR ?\fIoptions\fR?
.
The \fB::http::geturl\fR command is the main procedure in the package.
The \fB\-query\fR option causes a POST operation and
@@ -210,7 +210,8 @@ proc httpHandlerCallback {socket token} {
.TP
\fB\-headers\fR \fIkeyvaluelist\fR
.
-This option is used to add extra headers to the HTTP request. The
+This option is used to add headers not already specified
+by \fB::http::config\fR to the HTTP request. The
\fIkeyvaluelist\fR argument must be a list with an even number of
elements that alternate between keys and values. The keys become
header field names. Newlines are stripped from the values so the
@@ -274,7 +275,7 @@ do the formatting.
\fB\-queryblocksize\fR \fIsize\fR
.
The block size used when posting query data to the URL.
-At most
+At most
\fIsize\fR
bytes are written at once. After each block, a call to the
\fB\-queryprogress\fR
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 14a9e50..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
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 98dcb35..6f8f265 100644
--- a/doc/library.n
+++ b/doc/library.n
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -19,7 +19,7 @@ auto_execok, auto_import, auto_load, auto_mkindex, auto_qualify, auto_reset, tcl
\fBauto_qualify \fIcommand namespace\fR
\fBauto_reset\fR
\fBtcl_findLibrary \fIbasename version patch initScript enVarName varName\fR
-\fBparray \fIarrayName\fR
+\fBparray \fIarrayName\fR ?\fIpattern\fR?
\fBtcl_endOfWord \fIstr start\fR
\fBtcl_startOfNextWord \fIstr start\fR
\fBtcl_startOfPreviousWord \fIstr start\fR
@@ -139,7 +139,7 @@ as its first characters then it is assumed to be a procedure
definition and the next word of the line is taken as the
procedure's name.
Procedure definitions that do not appear in this way (e.g.\ they
-have spaces before the \fBproc\fR) will not be indexed. If your
+have spaces before the \fBproc\fR) will not be indexed. If your
script contains
.QW dangerous
code, such as global initialization
@@ -178,7 +178,7 @@ performing the actual auto-loading of functions at runtime.
This is a standard search procedure for use by extensions during
their initialization. They call this procedure to look for their
script library in several standard directories.
-The last component of the name of the library directory is
+The last component of the name of the library directory is
normally \fIbasenameversion\fR
(e.g., tk8.0), but it might be
.QW library
@@ -196,9 +196,11 @@ bin or bin/\fIarch\fR directory;
relative to the executable file in the current build tree;
relative to the executable file in a parallel build tree.
.TP
-\fBparray \fIarrayName\fR
-Prints on standard output the names and values of all the elements
-in the array \fIarrayName\fR.
+\fBparray \fIarrayName\fR ?\fIpattern\fR?
+Prints on standard output the names and values of all the elements in the
+array \fIarrayName\fR, or just the names that match \fIpattern\fR (using the
+matching rules of \fBstring match\fR) and their values if \fIpattern\fR is
+given.
\fIArrayName\fR must be an array accessible to the caller of \fBparray\fR.
It may be either local or global.
.TP
@@ -283,7 +285,7 @@ a default value is used.
.TP
\fBenv(TCLLIBPATH)\fR
If set, then it must contain a valid Tcl list giving directories to
-search during auto-load operations. Directories must be specified in
+search during auto-load operations. Directories must be specified in
Tcl format, using
.QW /
as the path separator, regardless of platform.
@@ -312,7 +314,7 @@ Unix, words are comprised of numbers, letters or underscores.
.SH "SEE ALSO"
env(n), info(n), re_syntax(n)
.SH KEYWORDS
-auto-exec, auto-load, library, unknown, word, whitespace
+auto-exec, auto-load, library, unknown, word, whitespace
'\"Local Variables:
'\"mode: nroff
'\"End:
diff --git a/doc/lindex.n b/doc/lindex.n
index bb272a6..d5605bc 100644
--- a/doc/lindex.n
+++ b/doc/lindex.n
@@ -5,9 +5,9 @@
'\"
'\" See 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
@@ -48,7 +48,7 @@ substitution and command substitution do not occur.
If \fIindex\fR is negative or greater than or equal to the number
of elements in \fIvalue\fR, then an empty
string is returned.
-The interpretation of each simple \fIindex\fR value is the same as
+The interpretation of each simple \fIindex\fR value is the same as
for the command \fBstring index\fR, supporting simple index
arithmetic and indices relative to the end of the list.
.PP
@@ -115,7 +115,7 @@ set idx 3
\fI\(-> f\fR
.CE
.SH "SEE ALSO"
-list(n), lappend(n), linsert(n), llength(n), lsearch(n),
+list(n), lappend(n), linsert(n), llength(n), lsearch(n),
lset(n), lsort(n), lrange(n), lreplace(n),
string(n)
.SH KEYWORDS
diff --git a/doc/linsert.n b/doc/linsert.n
index c722e4f..91db726 100644
--- a/doc/linsert.n
+++ b/doc/linsert.n
@@ -5,9 +5,9 @@
'\"
'\" See 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
@@ -45,7 +45,7 @@ set newList [\fBlinsert\fR $midList end-1 lazy]
set newerList [\fBlinsert\fR [\fBlinsert\fR $oldList end-1 quick] 1 lazy]
.CE
.SH "SEE ALSO"
-list(n), lappend(n), lindex(n), llength(n), lsearch(n),
+list(n), lappend(n), lindex(n), llength(n), lsearch(n),
lset(n), lsort(n), lrange(n), lreplace(n),
string(n)
.SH KEYWORDS
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..79f93c0 100644
--- a/doc/llength.n
+++ b/doc/llength.n
@@ -5,9 +5,9 @@
'\"
'\" See 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
@@ -49,7 +49,7 @@ An empty list is not necessarily an empty string:
1,0
.CE
.SH "SEE ALSO"
-list(n), lappend(n), lindex(n), linsert(n), lsearch(n),
+list(n), lappend(n), lindex(n), linsert(n), lsearch(n),
lset(n), lsort(n), lrange(n), lreplace(n)
.SH KEYWORDS
element, list, length
diff --git a/doc/lmap.n b/doc/lmap.n
index 880b05a..1a7858d 100644
--- a/doc/lmap.n
+++ b/doc/lmap.n
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -51,7 +51,7 @@ Zip lists together:
.CS
set list1 {a b c d}
set list2 {1 2 3 4}
-set zipped [\fBlmap\fR a $list1 b $list2 {list $a $b}]
+set zipped [\fBlmap\fR a $list1 b $list2 {list $a $b}]
# The value of zipped is "{a 1} {b 2} {c 3} {d 4}"
.CE
.PP
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..ffa6dba 100644
--- a/doc/lrange.n
+++ b/doc/lrange.n
@@ -5,9 +5,9 @@
'\"
'\" See 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
@@ -71,7 +71,7 @@ elements to
{elements to}
.CE
.SH "SEE ALSO"
-list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
+list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
lset(n), lreplace(n), lsort(n),
string(n)
.SH KEYWORDS
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..d19f0cd 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
@@ -35,7 +35,7 @@ by \fIfirst\fR must exist or \fIfirst\fR must indicate before the
start of the list.
.PP
If \fIlast\fR is less than \fIfirst\fR, then any specified elements
-will be inserted into the list at the point specified by \fIfirst\fR
+will be inserted into the list before the point specified by \fIfirst\fR
with no elements being deleted.
.PP
The \fIelement\fR arguments specify zero or more new arguments to
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..c2644b8 100644
--- a/doc/lsearch.n
+++ b/doc/lsearch.n
@@ -1,4 +1,4 @@
-'\"
+'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>. All rights reserved.
@@ -6,9 +6,9 @@
'\"
'\" See 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
@@ -111,7 +111,7 @@ The list elements are to be compared as integers.
\fB\-nocase\fR
.
Causes comparisons to be handled in a case-insensitive manner. Has no
-effect if combined with the \fB\-dictionary\fR, \fB\-integer\fR, or
+effect if combined with the \fB\-dictionary\fR, \fB\-integer\fR, or
\fB\-real\fR options.
.TP
\fB\-real\fR
@@ -209,7 +209,7 @@ It is also possible to search inside elements:
\fI\(-> {a abc} {b bcd}\fR
.CE
.SH "SEE ALSO"
-foreach(n), list(n), lappend(n), lindex(n), linsert(n), llength(n),
+foreach(n), list(n), lappend(n), lindex(n), linsert(n), llength(n),
lset(n), lsort(n), lrange(n), lreplace(n),
string(n)
.SH KEYWORDS
diff --git a/doc/lset.n b/doc/lset.n
index 805de16..e425274 100755
--- a/doc/lset.n
+++ b/doc/lset.n
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -16,7 +16,7 @@ lset \- Change an element in a list
.SH DESCRIPTION
.PP
The \fBlset\fR command accepts a parameter, \fIvarName\fR, which
-it interprets as the name of a variable containing a Tcl list.
+it interprets as the name of a variable containing a Tcl list.
It also accepts zero or more \fIindices\fR into
the list. The indices may be presented either consecutively on the
command line, or grouped in a
@@ -40,7 +40,7 @@ In this case, \fInewValue\fR replaces the old value of the variable
.PP
When presented with a single index, the \fBlset\fR command
treats the content of the \fIvarName\fR variable as a Tcl list.
-It addresses the \fIindex\fR'th element in it
+It addresses the \fIindex\fR'th element in it
(0 refers to the first element of the list).
When interpreting the list, \fBlset\fR observes the same rules
concerning braces and quotes and backslashes as the Tcl command
@@ -136,7 +136,7 @@ The indicated return value also becomes the new value of \fIx\fR.
\fI\(-> {{a b} {c d}} {{e f} {j h}}\fR
.CE
.SH "SEE ALSO"
-list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
+list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
lsort(n), lrange(n), lreplace(n),
string(n)
.SH KEYWORDS
diff --git a/doc/lsort.n b/doc/lsort.n
index 312048e..b0f7973 100644
--- a/doc/lsort.n
+++ b/doc/lsort.n
@@ -6,9 +6,9 @@
'\"
'\" See 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
@@ -153,14 +153,14 @@ returns
\fB\-nocase\fR
.
Causes comparisons to be handled in a case-insensitive manner. Has no
-effect if combined with the \fB\-dictionary\fR, \fB\-integer\fR, or
+effect if combined with the \fB\-dictionary\fR, \fB\-integer\fR, or
\fB\-real\fR options.
.TP
\fB\-unique\fR
.
If this option is specified, then only the last set of duplicate
elements found in the list will be retained. Note that duplicates are
-determined relative to the comparison used in the sort. Thus if
+determined relative to the comparison used in the sort. Thus if
\fB\-index 0\fR is used, \fB{1 a}\fR and \fB{1 b}\fR would be
considered duplicates and only the second element, \fB{1 b}\fR, would
be retained.
@@ -265,7 +265,7 @@ More complex sorting using a comparison function:
{1 dingo} {2 banana} {0x2 carrot} {3 apple}
.CE
.SH "SEE ALSO"
-list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
+list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
lset(n), lrange(n), lreplace(n)
.SH KEYWORDS
element, list, order, sort
diff --git a/doc/mathfunc.n b/doc/mathfunc.n
index 14b448e..7233d46 100644
--- a/doc/mathfunc.n
+++ b/doc/mathfunc.n
@@ -5,9 +5,9 @@
'\"
'\" See 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
@@ -142,7 +142,7 @@ than \fI0\fR, this is equivalent to
\fBbool \fIarg\fR
.
Accepts any numeric value, or any string acceptable to
-\fBstring is boolean\fR, and returns the corresponding
+\fBstring is boolean\fR, and returns the corresponding
boolean value \fB0\fR or \fB1\fR. Non-zero numbers are true.
Other numbers are false. Non-numeric strings produce boolean value in
agreement with \fBstring is true\fR and \fBstring is false\fR.
@@ -243,7 +243,7 @@ is negative, \fIy\fR must be an integer value.
.TP
\fBrand\fR
.
-Returns a pseudo-random floating-point value in the range (\fI0\fR,\fI1\fR).
+Returns a pseudo-random floating-point value in the range (\fI0\fR,\fI1\fR).
The generator algorithm is a simple linear congruential generator that
is not cryptographically secure. Each result from \fBrand\fR completely
determines all future results from subsequent calls to \fBrand\fR, so
@@ -290,7 +290,7 @@ Returns the hyperbolic tangent of \fIarg\fR.
.
The argument may be any numeric value. The integer part of \fIarg\fR
is determined, and then the low order 64 bits of that integer value
-are returned as an integer value.
+are returned as an integer value.
.SH "SEE ALSO"
expr(n), mathop(n), namespace(n)
.SH "COPYRIGHT"
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..c8cdb21 100644
--- a/doc/memory.n
+++ b/doc/memory.n
@@ -2,9 +2,9 @@
'\" Copyright (c) 1992-1999 by Karl Lehenbauer and Mark Diekhans
'\" 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
@@ -33,9 +33,9 @@ command mode.
.TP
\fBmemory info\fR
.
-Returns a report containing the total allocations and frees since
+Returns a report containing the total allocations and frees since
Tcl began, the current packets allocated (the current
-number of calls to \fBckalloc\fR not met by a corresponding call
+number of calls to \fBckalloc\fR not met by a corresponding call
to \fBckfree\fR), the current bytes allocated, and the maximum number
of packets and bytes allocated.
.TP
@@ -64,7 +64,7 @@ with it a string-valued tag. In the lists of allocated memory generated
by \fBmemory active\fR and \fBmemory onexit\fR, the tag for each packet
is printed along with other information about the packet. The
\fBmemory tag\fR command sets the tag value for subsequent calls
-to \fBckalloc\fR to be \fIstring\fR.
+to \fBckalloc\fR to be \fIstring\fR.
.TP
\fBmemory trace \fR[\fBon\fR|\fBoff\fR]
.
@@ -91,7 +91,7 @@ being displayed for all allocations and frees. Since there can be a lot
of memory activity before a problem occurs, judicious use of this option
can reduce the slowdown caused by tracing (and the amount of trace information
produced), if you can identify a number of allocations that occur before
-the problem sets in. The current number of memory allocations that have
+the problem sets in. The current number of memory allocations that have
occurred since Tcl started is printed on a guard zone failure.
.TP
\fBmemory validate \fR[\fBon\fR|\fBoff\fR]
diff --git a/doc/msgcat.n b/doc/msgcat.n
index bfd94ae..2fc1eee 100644
--- a/doc/msgcat.n
+++ b/doc/msgcat.n
@@ -3,9 +3,9 @@
'\"
'\" See 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,29 +13,43 @@ msgcat \- Tcl message catalog
.SH SYNOPSIS
\fBpackage require Tcl 8.5\fR
.sp
-\fBpackage require msgcat 1.5\fR
+\fBpackage require msgcat 1.6\fR
.sp
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
.sp
\fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR?
.sp
+.VS "TIP 412"
+\fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? \fIsrc-string\fR
+.VE "TIP 412"
+.sp
\fB::msgcat::mclocale \fR?\fInewLocale\fR?
.sp
\fB::msgcat::mcpreferences\fR
.sp
+.VS "TIP 412"
+\fB::msgcat::mcloadedlocales subcommand\fR ?\fIlocale\fR?
+.VE "TIP 412"
+.sp
\fB::msgcat::mcload \fIdirname\fR
.sp
\fB::msgcat::mcset \fIlocale src-string \fR?\fItranslate-string\fR?
.sp
\fB::msgcat::mcmset \fIlocale src-trans-list\fR
.sp
-.VS "TIP 404"
\fB::msgcat::mcflset \fIsrc-string \fR?\fItranslate-string\fR?
.sp
\fB::msgcat::mcflmset \fIsrc-trans-list\fR
-.VE "TIP 404"
.sp
\fB::msgcat::mcunknown \fIlocale src-string\fR ?\fIarg arg ...\fR?
+.sp
+.VS "TIP 412"
+\fB::msgcat::mcpackagelocale subcommand\fR ?\fIlocale\fR?
+.sp
+\fB::msgcat::mcpackageconfig subcommand\fR \fIoption\fR ?\fIvalue\fR?
+.sp
+\fB::msgcat::mcforgetpackage\fR
+.VE "TIP 412"
.BE
.SH DESCRIPTION
.PP
@@ -46,18 +60,23 @@ Text strings are defined in a
which is independent from the application, and
which can be edited or localized without modifying
the application source code. New languages
-or locales are provided by adding a new file to
+or locales may be provided by adding a new file to
the message catalog.
.PP
-Use of the message catalog is optional by any application
-or package, but is encouraged if the application or package
-wishes to be enabled for multi-lingual applications.
+\fBmsgcat\fR distinguises packages by its namespace.
+Each package has its own message catalog and configuration settings in \fBmsgcat\fR.
+.PP
+A \fIlocale\fR is a specification string describing a user language like \fBde_ch\fR for Swiss German.
+In \fBmsgcat\fR, there is a global locale initialized by the system locale of the current system.
+Each package may decide to use the global locale or to use a package specific locale.
+.PP
+The global locale may be changed on demand, for example by a user initiated language change or within a multi user application like a web server.
.SH COMMANDS
.TP
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
.
Returns a translation of \fIsrc-string\fR according to the
-user's current locale. If additional arguments past \fIsrc-string\fR
+current locale. If additional arguments past \fIsrc-string\fR
are given, the \fBformat\fR command is used to substitute the
additional arguments in the translation of \fIsrc-string\fR.
.RS
@@ -84,6 +103,18 @@ of the longest translated string. This is useful when designing
localized GUIs, which may require that all buttons, for example, be a
fixed width (which will be the width of the widest button).
.TP
+\fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? \fIsrc-string\fR
+.
+.VS "TIP 412"
+Return true, if there is a translation for the given \fIsrc-string\fR.
+.PP
+.RS
+The search may be limited by the option \fB\-exactnamespace\fR to only check the current namespace and not any parent namespaces.
+.PP
+It may also be limited by the option \fB\-exactlocale\fR to only check the first prefered locale (e.g. first element returned by \fB::msgcat::mcpreferences\fR if global locale is used).
+.RE
+.VE "TIP 412"
+.TP
\fB::msgcat::mclocale \fR?\fInewLocale\fR?
.
This function sets the locale to \fInewLocale\fR. If \fInewLocale\fR
@@ -93,6 +124,13 @@ case-insensitive manner, and returns locales in lowercase.
The initial locale is determined by the locale specified in
the user's environment. See \fBLOCALE SPECIFICATION\fR
below for a description of the locale string format.
+.RS
+.PP
+.VS "TIP 412"
+If the locale is set, the preference list of locales is evaluated.
+Locales in this list are loaded now, if not jet loaded.
+.VE "TIP 412"
+.RE
.TP
\fB::msgcat::mcpreferences\fR
.
@@ -103,13 +141,26 @@ preference. The list is derived from the current
locale set in msgcat by \fB::msgcat::mclocale\fR, and
cannot be set independently. For example, if the
current locale is en_US_funky, then \fB::msgcat::mcpreferences\fR
-returns \fB{en_US_funky en_US en {}}\fR.
+returns \fB{en_us_funky en_us en {}}\fR.
+.TP
+\fB::msgcat:mcloadedlocales subcommand\fR ?\fIlocale\fR?
+.
+This group of commands manage the list of loaded locales for packages not setting a package locale.
+.PP
+.RS
+The subcommand \fBget\fR returns the list of currently loaded locales.
+.PP
+The subcommand \fBpresent\fR requires the argument \fIlocale\fR and returns true, if this locale is loaded.
+.PP
+The subcommand \fBclear\fR removes all locales and their data, which are not in the current preference list.
+.RE
.TP
\fB::msgcat::mcload \fIdirname\fR
.
+.VS "TIP 412"
Searches the specified directory for files that match
-the language specifications returned by \fB::msgcat::mcpreferences\fR
-(note that these are all lowercase), extended by the file extension
+the language specifications returned by \fB::msgcat::mcloadedlocales get\fR
+(or \fBmsgcat::mcpackagelocale preferences\fR if a package locale is set) (note that these are all lowercase), extended by the file extension
.QW .msg .
Each matching file is
read in order, assuming a UTF-8 encoding. The file contents are
@@ -118,6 +169,11 @@ may be present in the message file either directly in their UTF-8
encoded form, or by use of the backslash-u quoting recognized by Tcl
evaluation. The number of message files which matched the specification
and were loaded is returned.
+.RS
+.PP
+In addition, the given folder is stored in the \fBmsgcat\fR package configuration option \fImcfolder\fR to eventually load message catalog files required by a locale change.
+.VE "TIP 412"
+.RE
.TP
\fB::msgcat::mcset \fIlocale src-string \fR?\fItranslate-string\fR?
.
@@ -138,16 +194,13 @@ faster than multiple invocations of \fB::msgcat::mcset\fR. The function
returns the number of translations set.
.TP
\fB::msgcat::mcflset \fIsrc-string \fR?\fItranslate-string\fR?
-.VS "TIP 404"
Sets the translation for \fIsrc-string\fR to \fItranslate-string\fR in the
current namespace for the locale implied by the name of the message catalog
being loaded via \fB::msgcat::mcload\fR. If \fItranslate-string\fR is not
specified, \fIsrc-string\fR is used for both. The function returns
\fItranslate-string\fR.
-.VE "TIP 404"
.TP
\fB::msgcat::mcflmset \fIsrc-trans-list\fR
-.VS "TIP 404"
Sets the translation for multiple source strings in \fIsrc-trans-list\fR in
the current namespace for the locale implied by the name of the message
catalog being loaded via \fB::msgcat::mcload\fR. \fIsrc-trans-list\fR must
@@ -155,7 +208,6 @@ have an even number of elements and is in the form {\fIsrc-string
translate-string\fR ?\fIsrc-string translate-string ...\fR?}
\fB::msgcat::mcflmset\fR can be significantly faster than multiple invocations
of \fB::msgcat::mcflset\fR. The function returns the number of translations set.
-.VE "TIP 404"
.TP
\fB::msgcat::mcunknown \fIlocale src-string\fR ?\fIarg arg ...\fR?
.
@@ -168,7 +220,18 @@ 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
of \fB::msgcat::mcunknown\fR is used as the return value for the call
-to \fB::msgcat::mc\fR.
+to \fB::msgcat::mc\fR.
+.VS "TIP 412"
+.RS
+.PP
+Note that this routine is only called if the concerned package did not set a package locale unknown command name.
+.RE
+.TP
+\fB::msgcat::mcforgetpackage\fR
+.
+The calling package clears all its state within the \fBmsgcat\fR package including all settings and translations.
+.VE "TIP 412"
+.PP
.SH "LOCALE SPECIFICATION"
.PP
The locale is specified to \fBmsgcat\fR by a locale string
@@ -196,7 +259,7 @@ language[_country][.codeset][@modifier]
.CE
.PP
to extract its parts. The initial locale is then set by calling
-\fB::msgcat::mclocale\fR with the argument
+\fB::msgcat::mclocale\fR with the argument
.PP
.CS
language[_country][_modifier]
@@ -217,15 +280,15 @@ When a locale is specified by the user, a
search is performed during string translation. For example, if a user
specifies
en_GB_Funky, the locales
-.QW en_GB_Funky ,
-.QW en_GB ,
+.QW en_gb_funky ,
+.QW en_gb ,
.QW en
and
.MT
(the empty string)
are searched in order until a matching translation
string is found. If no translation string is available, then
-\fB::msgcat::mcunknown\fR is called.
+the unknown handler is called.
.SH "NAMESPACES AND MESSAGE CATALOGS"
.PP
Strings stored in the message catalog are stored relative
@@ -321,7 +384,7 @@ the package. For example, a short \fBes.msg\fR might contain:
.PP
.CS
namespace eval ::mypackage {
- \fB::msgcat::mcflset\fR "Free Beer!" "Cerveza Gracias!"
+ \fB::msgcat::mcflset\fR "Free Beer" "Cerveza Gratis"
}
.CE
.SH "RECOMMENDED MESSAGE SETUP FOR PACKAGES"
@@ -373,6 +436,209 @@ formatting substitution is done directly.
# ... where that key is mapped to one of the
# human-oriented versions by \fBmsgcat::mcset\fR
.CE
+.VS "TIP 412"
+.SH Package private locale
+.PP
+A package using \fBmsgcat\fR may choose to use its own package private
+locale and its own set of loaded locales, independent to the global
+locale set by \fB::msgcat::mclocale\fR.
+.PP
+This allows a package to change its locale without causing any locales load or removal in other packages and not to invoke the global locale change callback (see below).
+.PP
+This action is controled by the following ensemble:
+.TP
+\fB::msgcat::mcpackagelocale set\fR ?\fIlocale\fR?
+.
+Set or change a package private locale.
+The package private locale is set to the given \fIlocale\fR if the \fIlocale\fR is given.
+If the option \fIlocale\fR is not given, the package is set to package private locale mode, but no locale is changed (e.g. if the global locale was valid for the package before, it is copied to the package private locale).
+.PP
+.RS
+This command may cause the load of locales.
+.RE
+.TP
+\fB::msgcat::mcpackagelocale get\fR
+.
+Return the package private locale or the global locale, if no package private locale is set.
+.TP
+\fB::msgcat::mcpackagelocale preferences\fR
+.
+Return the package private preferences or the global preferences,
+if no package private locale is set.
+.TP
+\fB::msgcat::mcpackagelocale loaded\fR
+.
+Return the list of locales loaded for this package.
+.TP
+\fB::msgcat::mcpackagelocale isset\fR
+.
+Returns true, if a package private locale is set.
+.TP
+\fB::msgcat::mcpackagelocale unset\fR
+.
+Unset the package private locale and use the globale locale.
+Load and remove locales to adjust the list of loaded locales for the
+package to the global loaded locales list.
+.TP
+\fB::msgcat::mcpackagelocale present\fR \fIlocale\fR
+.
+Returns true, if the given locale is loaded for the package.
+.TP
+\fB::msgcat::mcpackagelocale clear\fR
+.
+Clear any loaded locales of the package not present in the package preferences.
+.PP
+.SH Changing package options
+.PP
+Each package using msgcat has a set of options within \fBmsgcat\fR.
+The package options are described in the next sectionPackage options.
+Each package option may be set or unset individually using the following ensemble:
+.TP
+\fB::msgcat::mcpackageconfig get\fR \fIoption\fR
+.
+Return the current value of the given \fIoption\fR.
+This call returns an error if the option is not set for the package.
+.TP
+\fB::msgcat::mcpackageconfig isset\fR \fIoption\fR
+.
+Returns 1, if the given \fIoption\fR is set for the package, 0 otherwise.
+.TP
+\fB::msgcat::mcpackageconfig set\fR \fIoption\fR \fIvalue\fR
+.
+Set the given \fIoption\fR to the given \fIvalue\fR.
+This may invoke additional actions in dependency of the \fIoption\fR.
+The return value is 0 or the number of loaded packages for the option \fBmcfolder\fR.
+.TP
+\fB::msgcat::mcpackageconfig unset\fR \fIoption\fR
+.
+Unsets the given \fIoption\fR for the package.
+No action is taken if the \fIoption\fR is not set for the package.
+The empty string is returned.
+.SS Package options
+.PP
+The following package options are available for each package:
+.TP
+\fBmcfolder\fR
+.
+This is the message folder of the package. This option is set by mcload and by the subcommand set. Both are identical and both return the number of loaded message catalog files.
+.RS
+.PP
+Setting or changing this value will load all locales contained in the preferences valid for the package. This implies also to invoke any set loadcmd (see below).
+.PP
+Unsetting this value will disable message file load for the package.
+.RE
+.TP
+\fBloadcmd\fR
+.
+This callback is invoked before a set of message catalog files are loaded for the package which has this property set.
+.PP
+.RS
+This callback may be used to do any preparation work for message file load or to get the message data from another source like a data base. In this case, no message files are used (mcfolder is unset).
+.PP
+See section \fBcallback invocation\fR below.
+The parameter list appended to this callback is the list of locales to load.
+.PP
+If this callback is changed, it is called with the preferences valid for the package.
+.RE
+.TP
+\fBchangecmd\fR
+.
+This callback is invoked when a default local change was performed. Its purpose is to allow a package to update any dependency on the default locale like showing the GUI in another language.
+.PP
+.RS
+See the callback invocation section below.
+The parameter list appended to this callback is \fBmcpreferences\fR.
+The registered callbacks are invoked in no particular order.
+.RE
+.TP
+\fBunknowncmd\fR
+.
+Use a package locale mcunknown procedure instead of the standard version supplied by the msgcat package (msgcat::mcunknown).
+.PP
+.RS
+The called procedure must return the formatted message which will finally be returned by msgcat::mc.
+.PP
+A generic unknown handler is used if set to the empty string. This consists in returning the key if no arguments are given. With given arguments, format is used to process the arguments.
+.PP
+See section \fBcallback invocation\fR below.
+The appended arguments are identical to \fB::msgcat::mcunknown\fR.
+.RE
+.SS Callback invocation
+A package may decide to register one or multiple callbacks, as described above.
+.PP
+Callbacks are invoked, if:
+.PP
+1. the callback command is set,
+.PP
+2. the command is not the empty string,
+.PP
+3. the registering namespace exists.
+.PP
+If a called routine fails with an error, the \fBbgerror\fR routine for the interpreter is invoked after command completion.
+Only exception is the callback \fBunknowncmd\fR, where an error causes the invoking \fBmc\fR-command to fail with that error.
+.PP
+.SS Examples
+Packages which display a GUI may update their widgets when the global locale changes.
+To register to a callback, use:
+.CS
+namespace eval gui {
+ msgcat::mcpackageconfig changecmd updateGUI
+
+ proc updateGui args {
+ puts "New locale is '[lindex $args 0]'."
+ }
+}
+% msgcat::mclocale fr
+fr
+% New locale is 'fr'.
+.CE
+.PP
+If locales (or additional locales) are contained in another source like a data base, a package may use the load callback and not mcload:
+.CS
+namespace eval db {
+ msgcat::mcpackageconfig loadcmd loadMessages
+
+ proc loadMessages args {
+ foreach locale $args {
+ if {[LocaleInDB $locale]} {
+ msgcat::mcmset $locale [GetLocaleList $locale]
+ }
+ }
+ }
+}
+.CE
+.PP
+The \fBclock\fR command implementation uses \fBmsgcat\fR with a package locale to implement the command line parameter \fB-locale\fR.
+Here are some sketches of the implementation:
+.PP
+First, a package locale is initialized and the generic unknown function is desactivated:
+.CS
+msgcat::mcpackagelocale set
+msgcat::mcpackageconfig unknowncmd ""
+.CE
+As an example, the user requires the week day in a certain locale as follows:
+.CS
+clock format clock seconds -format %A -locale fr
+.CE
+\fBclock\fR sets the package locale to \fBfr\fR and looks for the day name as follows:
+.CS
+msgcat::mcpackagelocale set $locale
+return [lindex [msgcat::mc DAYS_OF_WEEK_FULL] $day]
+### Returns "mercredi"
+.CE
+Within \fBclock\fR, some message-catalog items are heavy in computation and thus are dynamically cached using:
+.CS
+proc ::tcl::clock::LocalizeFormat { locale format } {
+ set key FORMAT_$format
+ if { [::msgcat::mcexists -exactlocale -exactnamespace $key] } {
+ return [mc $key]
+ }
+ #...expensive computation of format clipped...
+ mcset $locale $key $format
+ return $format
+}
+.CE
+.VE "TIP 412"
.SH CREDITS
.PP
The message catalog code was developed by Mark Harrison.
diff --git a/doc/my.n b/doc/my.n
index b5afc67..2a9769b 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
@@ -37,7 +37,7 @@ the \fBoo::object\fR class, which is not publicly visible by default:
oo::class create c {
method count {} {
\fBmy\fR variable counter
- print [incr counter]
+ puts [incr counter]
}
}
c create o
diff --git a/doc/namespace.n b/doc/namespace.n
index f2812b2..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
diff --git a/doc/next.n b/doc/next.n
index 0ad752a..62782e5 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
@@ -93,9 +96,11 @@ forward to the proper implementation of the method (which it does by invoking
the \fBnext\fR command as filters are inserted into the front of the method
call chain) and is responsible for returning the result of \fBnext\fR.
.PP
-Filters are not invoked when processing an invocation of the \fBunknown\fR
-method because of a failure to locate a method implementation, or when
-invoking either constructors or destructors.
+Filters are invoked when processing an invokation of the \fBunknown\fR
+method because of a failure to locate a method implementation, but \fInot\fR
+when invoking either constructors or destructors. (Note however that the
+\fBdestroy\fR method is a conventional method, and filters are invoked as
+normal when it is called.)
.SH EXAMPLES
.PP
This example demonstrates how to use the \fBnext\fR command to call the
@@ -117,7 +122,7 @@ oo::class create theSubclass {
}
}
theSubclass create obj
-oo::define obj method example args {
+oo::objdefine obj method example args {
puts "per-object method, args = $args"
\fBnext\fR x {*}$args y
\fBnext\fR
@@ -171,7 +176,7 @@ oo::class create cache {
}
oo::object create demo
-oo::define demo {
+oo::objdefine demo {
mixin cache
method compute {a b c} {
after 3000 \fI;# Simulate deep thought\fR
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..1cccc0a 100644
--- a/doc/open.n
+++ b/doc/open.n
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -68,7 +68,7 @@ Set the initial access position to the end of the file.
All of the legal \fIaccess\fR values above may have the character
\fBb\fR added as the second or third character in the value to
indicate that the opened channel should be configured as if with the
-\fBfconfigure\fR \fB\-translation binary\fR option, making the channel suitable for
+\fBfconfigure\fR \fB\-translation binary\fR option, making the channel suitable for
reading or writing of binary data.
.PP
In the second form, \fIaccess\fR consists of a list of any of the
@@ -361,63 +361,28 @@ may cause this error.
A BREAK condition has been detected by your UART (see above).
.SH "PORTABILITY ISSUES"
.TP
-\fBWindows \fR(all versions)
+\fBWindows \fR
.
Valid values for \fIfileName\fR to open a serial port are of the form
-\fBcom\fIX\fB:\fR, where \fIX\fR is a number, generally from 1 to 4.
-This notation only works for serial ports from 1 to 9, if the system
-happens to have more than four. An attempt to open a serial port that
+\fBcom\fIX\fB\fR, where \fIX\fR is a number, generally from 1 to 9.
+A legacy form accepted as well is \fBcom\fIX\fB:\fR. This notation only
+works for serial ports from 1 to 9. An attempt to open a serial port that
does not exist or has a number greater than 9 will fail. An alternate
-form of opening serial ports is to use the filename \fB\e\e.\ecomX\fR,
-where X is any number that corresponds to a serial port; please note
-that this method is considerably slower on Windows 95 and Windows 98.
-.TP
-\fBWindows NT\fR
-.
+form of opening serial ports is to use the filename \fB//./comX\fR,
+where X is any number that corresponds to a serial port.
+.PP
+.RS
When running Tcl interactively, there may be some strange interactions
between the real console, if one is present, and a command pipeline that uses
standard input or output. If a command pipeline is opened for reading, some
of the lines entered at the console will be sent to the command pipeline and
some will be sent to the Tcl evaluator. If a command pipeline is opened for
writing, keystrokes entered into the console are not visible until the
-pipe is closed. This behavior occurs whether the command pipeline is
-executing 16-bit or 32-bit applications. These problems only occur because
-both Tcl and the child application are competing for the console at
-the same time. If the command pipeline is started from a script, so that Tcl
-is not accessing the console, or if the command pipeline does not use
-standard input or output, but is redirected from or to a file, then the
-above problems do not occur.
-.TP
-\fBWindows 95\fR
-.
-A command pipeline that executes a 16-bit DOS application cannot be opened
-for both reading and writing, since 16-bit DOS applications that receive
-standard input from a pipe and send standard output to a pipe run
-synchronously. Command pipelines that do not execute 16-bit DOS
-applications run asynchronously and can be opened for both reading and
-writing.
-.RS
-.PP
-When running Tcl interactively, there may be some strange interactions
-between the real console, if one is present, and a command pipeline that uses
-standard input or output. If a command pipeline is opened for reading from
-a 32-bit application, some of the keystrokes entered at the console will be
-sent to the command pipeline and some will be sent to the Tcl evaluator. If
-a command pipeline is opened for writing to a 32-bit application, no output
-is visible on the console until the pipe is closed. These problems only
-occur because both Tcl and the child application are competing for the
-console at the same time. If the command pipeline is started from a script,
-so that Tcl is not accessing the console, or if the command pipeline does
-not use standard input or output, but is redirected from or to a file, then
-the above problems do not occur.
-.PP
-Whether or not Tcl is running interactively, if a command pipeline is opened
-for reading from a 16-bit DOS application, the call to \fBopen\fR will not
-return until end-of-file has been received from the command pipeline's
-standard output. If a command pipeline is opened for writing to a 16-bit DOS
-application, no data will be sent to the command pipeline's standard output
-until the pipe is actually closed. This problem occurs because 16-bit DOS
-applications are run synchronously, as described above.
+pipe is closed. These problems only occur because both Tcl and the child
+application are competing for the console at the same time. If the command
+pipeline is started from a script, so that Tcl is not accessing the console,
+or if the command pipeline does not use standard input or output, but is
+redirected from or to a file, then the above problems do not occur.
.RE
.TP
\fBUnix\fR\0\0\0\0\0\0\0
@@ -437,7 +402,7 @@ some will be sent to the Tcl evaluator. This problem only occurs because
both Tcl and the child application are competing for the console at the
same time. If the command pipeline is started from a script, so that Tcl is
not accessing the console, or if the command pipeline does not use standard
-input, but is redirected from a file, then the above problem does not occur.
+input, but is redirected from a file, then the above problem does not occur.
.RE
.PP
See the \fBPORTABILITY ISSUES\fR section of the \fBexec\fR command for
diff --git a/doc/package.n b/doc/package.n
index 6cf8991..a6a972f 100644
--- a/doc/package.n
+++ b/doc/package.n
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -95,7 +95,7 @@ provided by a previous \fBpackage provide\fR command.
If the \fIversion\fR argument is omitted, then the command
returns the version number that is currently provided, or an
empty string if no \fBpackage provide\fR command has been
-invoked for \fIpackage\fR in this interpreter.
+invoked for \fIpackage\fR in this interpreter.
.TP
\fBpackage require \fR\fIpackage \fR?\fIrequirement...\fR?
.
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..ec39be9 100644
--- a/doc/pkgMkIndex.n
+++ b/doc/pkgMkIndex.n
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -47,7 +47,7 @@ interpreter and seeing what packages
and new commands appear (this is why it is essential to have
\fBpackage provide\fR commands or \fBTcl_PkgProvide\fR calls
in the files, as described above).
-If you have a package split among scripts and binary files,
+If you have a package split among scripts and binary files,
or if you have dependencies among files,
you may have to use the \fB\-load\fR option
or adjust the order in which \fBpkg_mkIndex\fR processes
@@ -132,7 +132,7 @@ version control: several versions of a package can be made available
in the index files, with different applications using different
versions based on \fBpackage require\fR commands.
In contrast, \fBauto_mkindex\fR does not understand versions so
-it can only handle a single version of each package.
+it can only handle a single version of each package.
It is probably not a good idea to index a given package with both
\fBpkg_mkIndex\fR and \fBauto_mkindex\fR.
If you use \fBpkg_mkIndex\fR to index a package, its commands cannot
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..129f4df 100644
--- a/doc/proc.n
+++ b/doc/proc.n
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -32,10 +32,10 @@ elements specifies
one argument. Each argument specifier is also a list with either
one or two fields. If there is only a single field in the specifier
then it is the name of the argument; if there are two fields, then
-the first is the argument name and the second is its default value.
+the first is the argument name and the second is its default value.
Arguments with default values that are followed by non-defaulted
-arguments become required arguments. In 8.6 this will be considered an
-error.
+arguments become required arguments. In 8.6 this will be considered an
+error.
.PP
When \fIname\fR is invoked a local variable
will be created for each of the formal arguments to the procedure; its
@@ -46,9 +46,9 @@ Arguments with default values need not be
specified in a procedure invocation. However, there must be enough
actual arguments for all the
formal arguments that do not have defaults, and there must not be any extra
-actual arguments.
+actual arguments.
Arguments with default values that are followed by non-defaulted
-arguments become required arguments (in 8.6 it will be considered an
+arguments become required arguments (in 8.6 it will be considered an
error).
There is one special case to permit procedures with
variable numbers of arguments. If the last formal argument has the name
@@ -62,7 +62,7 @@ When \fIbody\fR is being executed, variable names normally refer to
local variables, which are created automatically when referenced and
deleted when the procedure returns. One local variable is automatically
created for each of the procedure's arguments.
-Other variables can only be accessed by invoking one of the \fBglobal\fR,
+Other variables can only be accessed by invoking one of the \fBglobal\fR,
\fBvariable\fR, \fBupvar\fR or \fBnamespace upvar\fR commands.
The current namespace when \fIbody\fR is executed will be the
namespace that the procedure's name exists in, which will be the
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/re_syntax.n b/doc/re_syntax.n
index 46a180d..7988071 100644
--- a/doc/re_syntax.n
+++ b/doc/re_syntax.n
@@ -683,9 +683,33 @@ earlier in the RE taking priority over ones starting later. Note that
outer subexpressions thus take priority over their component
subexpressions.
.PP
-Note that the quantifiers \fB{1,1}\fR and \fB{1,1}?\fR can be used to
+The quantifiers \fB{1,1}\fR and \fB{1,1}?\fR can be used to
force longest and shortest preference, respectively, on a
subexpression or a whole RE.
+.RS
+.PP
+\fBNOTE:\fR This means that you can usually make a RE be non-greedy overall by
+putting \fB{1,1}?\fR after one of the first non-constraint atoms or
+parenthesized sub-expressions in it. \fIIt pays to experiment\fR with the
+placing of this non-greediness override on a suitable range of input texts
+when you are writing a RE if you are using this level of complexity.
+.PP
+For example, this regular expression is non-greedy, and will match the
+shortest substring possible given that
+.QW \fBabc\fR
+will be matched as early as possible (the quantifier does not change that):
+.PP
+.CS
+ab{1,1}?c.*x.*cba
+.CE
+.PP
+The atom
+.QW \fBa\fR
+has no greediness preference, we explicitly give one for
+.QW \fBb\fR ,
+and the remaining quantifiers are overridden to be non-greedy by the preceding
+non-greedy quantifier.
+.RE
.PP
Match lengths are measured in characters, not collating elements. An
empty string is considered longer than no match at all. For example,
diff --git a/doc/read.n b/doc/read.n
index 007c0ac..9a9a7e8 100644
--- a/doc/read.n
+++ b/doc/read.n
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -58,12 +58,12 @@ configured to be nonblocking: \fBfconfigure\fI channelId \fB\-blocking
\fI0\fR. Then \fBread\fR behaves much like described above. Care
must be taken when using \fBread\fR on blocking serial ports:
.TP
-\fBread \fIchannelId numChars\fR
+\fBread \fIchannelId numChars\fR
.
In this form \fBread\fR blocks until \fInumChars\fR have been received
from the serial port.
.TP
-\fBread \fIchannelId\fR
+\fBread \fIchannelId\fR
.
In this form \fBread\fR blocks until the reception of the end-of-file
character, see \fBfconfigure\fR \fB\-eofchar\fR. If there no end-of-file
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..6f303a4 100644
--- a/doc/regexp.n
+++ b/doc/regexp.n
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -51,7 +51,7 @@ the \fB(?x)\fR embedded option (see the \fBre_syntax\fR manual page).
.TP 15
\fB\-indices\fR
.
-Changes what is stored in the \fIsubMatchVar\fRs.
+Changes what is stored in the \fImatchVar\fR and \fIsubMatchVar\fRs.
Instead of storing the matching characters from \fIstring\fR,
each variable
will contain a list of two decimal strings giving the indices
@@ -133,7 +133,7 @@ regular expression. Examples are:
\fB\-start\fR \fIindex\fR
.
Specifies a character index offset into the string to start
-matching the regular expression at.
+matching the regular expression at.
The \fIindex\fR value is interpreted in the same manner
as the \fIindex\fR argument to \fBstring index\fR.
When using this switch,
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..a5b79de 100644
--- a/doc/regsub.n
+++ b/doc/regsub.n
@@ -5,9 +5,9 @@
'\"
'\" See 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
@@ -123,7 +123,7 @@ by \fIsubSpec\fR use the original unconverted form of \fIstring\fR.
\fB\-start\fR \fIindex\fR
.
Specifies a character index offset into the string to start
-matching the regular expression at.
+matching the regular expression at.
The \fIindex\fR value is interpreted in the same manner
as the \fIindex\fR argument to \fBstring index\fR.
When using this switch,
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 a1abccf..ea590ea 100644
--- a/doc/return.n
+++ b/doc/return.n
@@ -5,9 +5,9 @@
'\"
'\" See 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
@@ -24,7 +24,7 @@ return \- Return from a procedure, or set return code of a script
In its simplest usage, the \fBreturn\fR command is used without options
in the body of a procedure to immediately return control to the caller
of the procedure. If a \fIresult\fR argument is provided, its value
-becomes the result of the procedure passed back to the caller.
+becomes the result of the procedure passed back to the caller.
If \fIresult\fR is not specified then an empty string will be returned
to the caller as the result of the procedure.
.PP
@@ -114,7 +114,7 @@ is meant to be additional information about the error,
presented as a Tcl list for further processing by programs.
If no \fB\-errorcode\fR option is provided to \fBreturn\fR when
the \fB\-code error\fR option is provided, Tcl will set the value
-of the \fB\-errorcode\fR entry in the return options dictionary
+of the \fB\-errorcode\fR entry in the return options dictionary
to the default value of \fBNONE\fR. The \fB\-errorcode\fR return
option will also be stored in the global variable \fBerrorCode\fR.
.TP
@@ -124,7 +124,7 @@ The \fB\-errorinfo\fR option receives special treatment only when the value
of the \fB\-code\fR option is \fBTCL_ERROR\fR. Then \fIinfo\fR is the initial
stack trace, meant to provide to a human reader additional information
about the context in which the error occurred. The stack trace will
-also be stored in the global variable \fBerrorInfo\fR.
+also be stored in the global variable \fBerrorInfo\fR.
If no \fB\-errorinfo\fR option is provided to \fBreturn\fR when
the \fB\-code error\fR option is provided, Tcl will provide its own
initial stack trace value in the entry for \fB\-errorinfo\fR. Tcl's
@@ -198,7 +198,7 @@ their documented interpretation in loops.
.PP
Procedure invocation also involves evaluation of a script, the body
of the procedure. Procedure invocation provides special treatment
-when evaluation of the procedure body returns the return code
+when evaluation of the procedure body returns the return code
\fBTCL_RETURN\fR. In that circumstance, the \fB\-level\fR entry in the
return options dictionary is decremented. If after decrementing,
the value of the \fB\-level\fR entry is 0, then the value of
@@ -231,7 +231,7 @@ procedure, interrupting the procedure body.
.CS
proc printOneLine {} {
puts "line 1" ;# This line will be printed.
- \fBreturn\fR
+ \fBreturn\fR
puts "line 2" ;# This line will not be printed.
}
.CE
diff --git a/doc/safe.n b/doc/safe.n
index ebd9b4d..b39f2c2 100644
--- a/doc/safe.n
+++ b/doc/safe.n
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -53,8 +53,8 @@ No knowledge of the file system structure is leaked to the
safe interpreter, because it has access only to a virtualized path
containing tokens. When the safe interpreter requests to source a file, it
uses the token in the virtual path as part of the file name to source; the
-master interpreter transparently
-translates the token into a real directory name and executes the
+master interpreter transparently
+translates the token into a real directory name and executes the
requested operation (see the section \fBSECURITY\fR below for details).
Different levels of security can be selected by using the optional flags
of the commands described below.
@@ -81,7 +81,7 @@ other means, like \fBinterp create\fR \fB\-safe\fR.
\fB::safe::interpConfigure\fR \fIslave\fR ?\fIoptions...\fR?
If no \fIoptions\fR are given, returns the settings for all options for the
named safe interpreter as a list of options and their current values
-for that \fIslave\fR.
+for that \fIslave\fR.
If a single additional argument is provided,
it will return a list of 2 elements \fIname\fR and \fIvalue\fR where
\fIname\fR is the full name of that option and \fIvalue\fR the current value
@@ -106,7 +106,7 @@ safe::interpConfigure $i0 \-delete {foo bar} \-statics 0
.RE
.TP
\fB::safe::interpDelete\fR \fIslave\fR
-Deletes the safe interpreter and cleans up the corresponding
+Deletes the safe interpreter and cleans up the corresponding
master interpreter data structures.
If a \fIdeleteHook\fR script was specified for this interpreter it is
evaluated before the interpreter is deleted, with the name of the
@@ -175,26 +175,26 @@ ERROR for slave interp10 : /foo/bar/init.tcl: no such file or directory
.CE
.RE
.SS OPTIONS
-The following options are common to
-\fB::safe::interpCreate\fR, \fB::safe::interpInit\fR,
+The following options are common to
+\fB::safe::interpCreate\fR, \fB::safe::interpInit\fR,
and \fB::safe::interpConfigure\fR.
-Any option name can be abbreviated to its minimal
+Any option name can be abbreviated to its minimal
non-ambiguous name.
Option names are not case sensitive.
-.TP
+.TP
\fB\-accessPath\fR \fIdirectoryList\fR
This option sets the list of directories from which the safe interpreter
can \fBsource\fR and \fBload\fR files.
If this option is not specified, or if it is given as the
empty list, the safe interpreter will use the same directories as its
master for auto-loading.
-See the section \fBSECURITY\fR below for more detail about virtual paths,
+See the section \fBSECURITY\fR below for more detail about virtual paths,
tokens and access control.
.TP
\fB\-statics\fR \fIboolean\fR
This option specifies if the safe interpreter will be allowed
to load statically linked packages (like \fBload {} Tk\fR).
-The default value is \fBtrue\fR :
+The default value is \fBtrue\fR :
safe interpreters are allowed to load statically linked packages.
.TP
\fB\-noStatics\fR
@@ -205,7 +205,7 @@ to load statically linked packages.
\fB\-nested\fR \fIboolean\fR
This option specifies if the safe interpreter will be allowed
to load packages into its own sub-interpreters.
-The default value is \fBfalse\fR :
+The default value is \fBfalse\fR :
safe interpreters are not allowed to load packages into
their own sub-interpreters.
.TP
@@ -213,7 +213,7 @@ their own sub-interpreters.
This option is a convenience shortcut for \fB\-nested true\fR and
thus specifies the safe interpreter will be allowed
to load packages into its own sub-interpreters.
-.TP
+.TP
\fB\-deleteHook\fR \fIscript\fR
When this option is given a non-empty \fIscript\fR, it will be
evaluated in the master with the name of
@@ -286,17 +286,17 @@ This virtual path system is maintained in the master interpreter for each safe
interpreter created by \fB::safe::interpCreate\fR or initialized by
\fB::safe::interpInit\fR and
the path maps tokens accessible in the safe interpreter into real path
-names on the local file system thus preventing safe interpreters
+names on the local file system thus preventing safe interpreters
from gaining knowledge about the
structure of the file system of the host on which the interpreter is
executing.
The only valid file names arguments
for the \fBsource\fR and \fBload\fR aliases provided to the slave
-are path in the form of
+are path in the form of
\fB[file join \fItoken filename\fB]\fR (i.e. when using the
native file path formats: \fItoken\fB/\fIfilename\fR
on Unix and \fItoken\fB\e\fIfilename\fR on Windows),
-where \fItoken\fR is representing one of the directories
+where \fItoken\fR is representing one of the directories
of the \fIaccessPath\fR list and \fIfilename\fR is
one file in that directory (no sub directories access are allowed).
.PP
@@ -323,25 +323,25 @@ list will be assigned a token that will be set in
the slave \fBauto_path\fR and the first element of that list will be set as
the \fBtcl_library\fR for that slave.
.PP
-If the access path argument is not given or is the empty list,
+If the access path argument is not given or is the empty list,
the default behavior is to let the slave access the same packages
-as the master has access to (Or to be more precise:
+as the master has access to (Or to be more precise:
only packages written in Tcl (which by definition cannot be dangerous
as they run in the slave interpreter) and C extensions that
-provides a _SafeInit entry point). For that purpose, the master's
-\fBauto_path\fR will be used to construct the slave access path.
+provides a _SafeInit entry point). For that purpose, the master's
+\fBauto_path\fR will be used to construct the slave access path.
In order that the slave successfully loads the Tcl library files
(which includes the auto-loading mechanism itself) the \fBtcl_library\fR will be
-added or moved to the first position if necessary, in the
+added or moved to the first position if necessary, in the
slave access path, so the slave
\fBtcl_library\fR will be the same as the master's (its real
-path will still be invisible to the slave though).
+path will still be invisible to the slave though).
In order that auto-loading works the same for the slave and
the master in this by default case, the first-level
sub directories of each directory in the master \fBauto_path\fR will
also be added (if not already included) to the slave access path.
You can always specify a more
-restrictive path for which sub directories will never be searched by
+restrictive path for which sub directories will never be searched by
explicitly specifying your directory list with the \fB\-accessPath\fR flag
instead of relying on this default mechanism.
.PP
diff --git a/doc/scan.n b/doc/scan.n
index cc5ed79..d963d6c 100644
--- a/doc/scan.n
+++ b/doc/scan.n
@@ -5,9 +5,9 @@
'\"
'\" See 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
@@ -37,7 +37,7 @@ performed.
If the next character in \fIformat\fR is a blank or tab then it
matches any number of white space characters in \fIstring\fR (including
zero).
-Otherwise, if it is not a \fB%\fR character then it
+Otherwise, if it is not a \fB%\fR character then it
must match the next character of \fIstring\fR.
When a \fB%\fR is encountered in \fIformat\fR, it indicates
the start of a conversion specifier.
@@ -52,7 +52,7 @@ The fields that are present must appear in the order given above.
When \fBscan\fR finds a conversion specifier in \fIformat\fR, it
first skips any white-space characters in \fIstring\fR (unless the
conversion character is \fB[\fR or \fBc\fR).
-Then it converts the next input characters according to the
+Then it converts the next input characters according to the
conversion specifier and stores the result in the variable given
by the next argument to \fBscan\fR.
.SS "OPTIONAL POSITIONAL SPECIFIER"
@@ -95,11 +95,11 @@ truncated as required by the size modifier value.
.TP
\fBo\fR
.
-The input substring must be an octal integer. It is read in and the
+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,
@@ -130,22 +130,22 @@ truncated as required by the size modifier value.
.TP
\fBc\fR
.
-A single character is read in and its Unicode value is stored in
+A single character is read in and its Unicode value is stored in
the variable as an integer value.
Initial white space is not skipped in this case, so the input
substring may be a white-space character.
.TP
\fBs\fR
.
-The input substring consists of all the characters up to the next
+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
+The input substring must be a floating-point number consisting
of an optional sign, a string of decimal digits possibly
-containing a decimal point, and an optional exponent consisting
-of an \fBe\fR or \fBE\fR followed by an optional sign and a string of
+containing a decimal point, and an optional exponent consisting
+of an \fBe\fR or \fBE\fR followed by an optional sign and a string of
decimal digits.
It is read in and stored in the variable as a floating-point value.
.TP
@@ -166,8 +166,8 @@ it is treated as part of \fIchars\fR rather than indicating a range.
.
The input substring consists of one or more characters not in \fIchars\fR.
The matching string is stored in the variable.
-If the character immediately following the \fB^\fR is a \fB]\fR then it is
-treated as part of the set rather than the closing bracket for
+If the character immediately following the \fB^\fR is a \fB]\fR then it is
+treated as part of the set rather than the closing bracket for
the set.
If \fIchars\fR
contains a sequence of the form \fIa\fB\-\fIb\fR then any
@@ -183,12 +183,12 @@ of characters scanned from the input string so far is stored in the variable.
.PP
The number of characters read from the input for a conversion is the
largest number that makes sense for that particular conversion (e.g.
-as many decimal digits as possible for \fB%d\fR, as
+as many decimal digits as possible for \fB%d\fR, as
many octal digits as possible for \fB%o\fR, and so on).
The input substring for a given conversion terminates either when a
-white-space character is encountered or when the maximum substring
+white-space character is encountered or when the maximum substring
width has been reached, whichever comes first.
-If a \fB*\fR is present in the conversion specifier
+If a \fB*\fR is present in the conversion specifier
then no variable is assigned and the next scan argument is not consumed.
.SH "DIFFERENCES FROM ANSI SSCANF"
.PP
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..f065087 100644
--- a/doc/set.n
+++ b/doc/set.n
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -29,14 +29,14 @@ Otherwise \fIvarName\fR refers to a scalar variable.
If \fIvarName\fR includes namespace qualifiers
(in the array name if it refers to an array element), or if \fIvarName\fR
is unqualified (does not include the names of any containing namespaces)
-but no procedure is active,
+but no procedure is active,
\fIvarName\fR refers to a namespace variable
resolved according to the rules described under \fBNAME RESOLUTION\fR in
the \fBnamespace\fR manual page.
.PP
If a procedure is active and \fIvarName\fR is unqualified, then
\fIvarName\fR refers to a parameter or local variable of the procedure,
-unless \fIvarName\fR was declared to resolve differently through one of the
+unless \fIvarName\fR was declared to resolve differently through one of the
\fBglobal\fR, \fBvariable\fR or \fBupvar\fR commands.
.SH EXAMPLES
.PP
diff --git a/doc/socket.n b/doc/socket.n
index 0a60457..3efdb37 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
@@ -97,6 +97,10 @@ writable channel event on the socket to get notified when the
asynchronous connection has succeeded or failed. See the \fBvwait\fR
and the \fBchan\fR commands for more details on the event loop and
channel events.
+.PP
+The \fBchan configure\fR option \fB-connecting\fR may be used to check if the connect is still running. To verify a successful connect, the option \fB-error\fR may be checked when \fB-connecting\fR returned 0.
+.PP
+Operation without the event queue requires at the moment calls to \fBchan configure\fR to advance the internal state machine.
.RE
.SH "SERVER SOCKETS"
.PP
@@ -186,6 +190,10 @@ sockets, this option returns a list of three elements; these are the
address, the host name and the port to which the peer socket is connected
or bound. If the host name cannot be computed, the second element of the
list is identical to the address, its first element.
+.TP
+\fB\-connecting\fR
+.
+This option is not supported by server sockets. For client sockets, this option returns 1 if an asyncroneous connect is still in progress, 0 otherwise.
.PP
.SH "EXAMPLES"
.PP
diff --git a/doc/source.n b/doc/source.n
index 57a9fa2..67d4b6b 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
@@ -43,6 +43,8 @@ or
which will be safely substituted by the Tcl interpreter into
.QW ^Z .
.PP
+A leading BOM (Byte order mark) contained in the file is ignored for unicode encodings (utf-8, unicode).
+.PP
The \fB\-encoding\fR option is used to specify the encoding of
the data stored in \fIfileName\fR. When the \fB\-encoding\fR option
is omitted, the system encoding is assumed.
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 351c865..00ce85c 100644
--- a/doc/string.n
+++ b/doc/string.n
@@ -4,9 +4,9 @@
.\"
.\" See 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,6 +19,21 @@ string \- Manipulate strings
Performs one of several string operations, depending on \fIoption\fR.
The legal \fIoption\fRs (which may be abbreviated) are:
.TP
+\fBstring cat\fR ?\fIstring1\fR? ?\fIstring2...\fR?
+.VS 8.6.2
+Concatenate the given \fIstring\fRs just like placing them directly
+next to each other and return the resulting compound string. If no
+\fIstring\fRs are present, the result is an empty string.
+.RS
+.PP
+This primitive is occasionally handier than juxtaposition of strings
+when mixed quoting is wanted, or when the aim is to return the result
+of a concatenation without resorting to \fBreturn\fR \fB\-level 0\fR,
+and is more efficient than building a list of arguments and using
+\fBjoin\fR with an empty join string.
+.RE
+.VE
+.TP
\fBstring compare\fR ?\fB\-nocase\fR? ?\fB\-length\fI length\fR? \fIstring1 string2\fR
.
Perform a character-by-character comparison of strings \fIstring1\fR
@@ -131,8 +146,9 @@ Any Unicode printing character, including space.
.IP \fBpunct\fR 12
Any Unicode punctuation character.
.IP \fBspace\fR 12
-Any Unicode whitespace character, zero width space (U+200b),
-word joiner (U+2060) and zero width no-break space (U+feff) (=BOM).
+Any Unicode whitespace character, mongolian vowel separator
+(U+180e), zero width space (U+200b), word joiner (U+2060) or
+zero width no-break space (U+feff) (=BOM).
.IP \fBtrue\fR 12
Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is
true.
@@ -343,10 +359,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 +373,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
@@ -407,7 +443,7 @@ would refer to the
in
.QW abcd ).
.IP \fIM\fB+\fIN\fR 10
-The char specified at the integral index that is the sum of
+The char specified at the integral index that is the sum of
integer values \fIM\fR and \fIN\fR (e.g.,
.QW \fB1+1\fR
would refer to the
@@ -415,7 +451,7 @@ would refer to the
in
.QW abcd ).
.IP \fIM\fB\-\fIN\fR 10
-The char specified at the integral index that is the difference of
+The char specified at the integral index that is the difference of
integer values \fIM\fR and \fIN\fR (e.g.,
.QW \fB2\-1\fR
would refer to the
diff --git a/doc/subst.n b/doc/subst.n
index aba2bc9..4518140 100644
--- a/doc/subst.n
+++ b/doc/subst.n
@@ -5,9 +5,9 @@
'\"
'\" See 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
@@ -33,7 +33,7 @@ For example, if \fB\-nocommands\fR is specified, command substitution
is not performed: open and close brackets are treated as ordinary characters
with no special interpretation.
.PP
-Note that the substitution of one kind can include substitution of
+Note that the substitution of one kind can include substitution of
other kinds. For example, even when the \fB\-novariables\fR option
is specified, command substitution is performed without restriction.
This means that any variable substitution necessary to complete the
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 dfc2635..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
diff --git a/doc/tcltest.n b/doc/tcltest.n
index 731bed7..05c1922 100644
--- a/doc/tcltest.n
+++ b/doc/tcltest.n
@@ -7,9 +7,9 @@
'\"
'\" See 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
@@ -118,7 +118,7 @@ all \fIoption\fRs begin with
.TP
\fBloadTestedCommands\fR
.
-Evaluates in the caller's context the script specified by
+Evaluates in the caller's context the script specified by
\fBconfigure \-load\fR or \fBconfigure \-loadfile\fR.
Returns the result of that script evaluation, including any error
raised by the script. Use this command and the related
@@ -486,7 +486,7 @@ test, typically test failure messages. Good \fIdescription\fR values
should briefly explain the purpose of the test to users of a test suite.
The name of a Tcl or C function being tested should be included in the
description for regression tests. If the test case exists to reproduce
-a bug, include the bug ID in the description.
+a bug, include the bug ID in the description.
.PP
Valid attributes and associated values are:
.TP
@@ -508,8 +508,8 @@ should be accomplished by the \fB\-constraints\fR option, not by
conditional evaluation of \fBtest\fR. In that way, the same
number of tests are always reported by the test suite, though
the number skipped may change based on the testing environment.
-The default value is an empty list.
-See \fBTEST CONSTRAINTS\fR below for a list of built-in constraints
+The default value is an empty list.
+See \fBTEST CONSTRAINTS\fR below for a list of built-in constraints
and information on how to add your own constraints.
.TP
\fB\-setup \fIscript\fR
@@ -521,7 +521,7 @@ is an empty script.
.TP
\fB\-body \fIscript\fR
.
-The \fB\-body\fR attribute indicates the \fIscript\fR to run to carry out the
+The \fB\-body\fR attribute indicates the \fIscript\fR to run to carry out the
test, which must return a result that can be checked for correctness.
If evaluation of \fIscript\fR raises an error, the test will fail
(unless the \fB\-returnCodes\fR option is used to state that an error
@@ -561,7 +561,7 @@ processed for comparison.
\fB\-errorOutput \fIexpectedValue\fR
.
The \fB\-errorOutput\fR attribute supplies the \fIexpectedValue\fR against
-which any output sent to \fBstderr\fR or \fBerrorChannel\fR during
+which any output sent to \fBstderr\fR or \fBerrorChannel\fR during
evaluation of the script(s) will be compared. Note that only output
printed using the global \fBputs\fR command is used for comparison. If
\fB\-errorOutput\fR is not specified, output sent to \fBstderr\fR and
@@ -642,14 +642,6 @@ This test can only be run on any Windows platform.
.
This test can only be run on any Windows NT platform.
.TP
-\fI95\fR
-.
-This test can only be run on any Windows 95 platform.
-.TP
-\fI98\fR
-.
-This test can only be run on any Windows 98 platform.
-.TP
\fImac\fR
.
This test can only be run on any Mac platform.
@@ -669,7 +661,7 @@ This test can only be run on a Mac or Unix platform.
\fItempNotWin\fR
.
This test can not be run on Windows. This flag is used to temporarily
-disable a test.
+disable a test.
.TP
\fItempNotMac\fR
.
@@ -679,17 +671,17 @@ to temporarily disable a test.
\fIunixCrash\fR
.
This test crashes if it is run on Unix. This flag is used to temporarily
-disable a test.
+disable a test.
.TP
\fIwinCrash\fR
.
This test crashes if it is run on Windows. This flag is used to temporarily
-disable a test.
+disable a test.
.TP
\fImacCrash\fR
.
This test crashes if it is run on a Mac. This flag is used to temporarily
-disable a test.
+disable a test.
.TP
\fIemptyTest\fR
.
@@ -710,17 +702,17 @@ This test can only be run in some known development environment.
Some tests are inherently non-portable because they depend on things
like word length, file system configuration, window manager, etc.
This constraint has value false to cause tests to be skipped unless
-the user specifies otherwise.
+the user specifies otherwise.
.TP
\fIuserInteraction\fR
.
This test requires interaction from the user. This constraint has
value false to causes tests to be skipped unless the user specifies
-otherwise.
+otherwise.
.TP
\fIinteractive\fR
.
-This test can only be run in if the interpreter is in interactive mode
+This test can only be run in if the interpreter is in interactive mode
(when the global tcl_interactive variable is set to 1).
.TP
\fInonBlockFiles\fR
@@ -800,7 +792,7 @@ and sorted. Then each file will be evaluated in turn. If
be \fBsource\fRd in the caller's context. If it is false,
then a copy of \fBinterpreter\fR will be \fBexec\fR'd to
evaluate each file. The multi-process operation is useful
-when testing can cause errors so severe that a process
+when testing can cause errors so severe that a process
terminates. Although such an error may terminate a child
process evaluating one file, the master process can continue
with the rest of the test suite. In multi-process operation,
@@ -880,10 +872,10 @@ harness are doing.
.
Sets the type of output verbosity desired to \fIlevel\fR,
a list of zero or more of the elements \fBbody\fR, \fBpass\fR,
-\fBskip\fR, \fBstart\fR, \fBerror\fR and \fBline\fR. Default value
-is
+\fBskip\fR, \fBstart\fR, \fBerror\fR, \fBline\fR, \fBmsec\fR and \fBusec\fR.
+Default value is
.QW "\fBbody error\fR" .
-Levels are defined as:
+Levels are defined as:
.RS
.IP "body (\fBb\fR)"
Display the body of failed tests
@@ -898,6 +890,16 @@ Print errorInfo and errorCode, if they exist, when a test return code
does not match its expected return code
.IP "line (\fBl\fR)"
Print source file line information of failed tests
+.IP "msec (\fBm\fR)"
+Print each test's execution time in milliseconds
+.IP "usec (\fBu\fR)"
+Print each test's execution time in microseconds
+.PP
+Note that the \fBmsec\fR and \fBusec\fR verbosity levels are provided as
+indicative measures only. They do not tackle the problem of repeatibility which
+should be considered in performance tests or benchmarks. To use these verbosity
+levels to thoroughly track performance degradations, consider wrapping your
+test bodies with \fBtime\fR commands.
.PP
The single letter abbreviations noted above are also recognized
so that
@@ -919,7 +921,7 @@ test files have been evaluated.
.IP 1
Also check for core files at the end of each \fBtest\fR command.
.IP 2
-Check for core files at all times described above, and save a
+Check for core files at all times described above, and save a
copy of each core file produced in \fBconfigure \-tmpdir\fR.
.RE
.TP
@@ -996,7 +998,7 @@ Sets the filename from which to read a script to be evaluated
by \fBloadTestedCommands\fR. This is an alternative to
\fB\-load\fR. They cannot be used together.
.TP
-\fB\-outfile \fIfilename\fR
+\fB\-outfile \fIfilename\fR
.
Sets the file to which all output produced by tcltest should be
written. A file named \fIfilename\fR will be \fBopen\fRed for writing,
@@ -1073,7 +1075,7 @@ used by \fBrunAllTests\fR to find test files. It is a good rule of
thumb to have one test file for each source code file of your project.
It is good practice to edit the test file and the source code file
together, keeping tests synchronized with code changes.
-.PP
+.PP
Most of the code in the test file should be the \fBtest\fR commands.
Use constraints to skip tests, rather than conditional evaluation
of \fBtest\fR.
@@ -1207,7 +1209,7 @@ to establish a configuration from command line arguments.
There are two known issues related to nested evaluations of \fBtest\fR.
The first issue relates to the stack level in which test scripts are
executed. Tests nested within other tests may be executed at the same
-stack level as the outermost test. For example, in the following code:
+stack level as the outermost test. For example, in the following code:
.PP
.CS
\fBtest\fR level-1.1 {level 1} {
@@ -1219,7 +1221,7 @@ stack level as the outermost test. For example, in the following code:
.CE
.PP
any script executed in level-2.1 may be executed at the same stack
-level as the script defined for level-1.1.
+level as the script defined for level-1.1.
.PP
In addition, while two \fBtest\fRs have been run, results will only
be reported by \fBcleanupTests\fR for tests at the same level as
@@ -1249,7 +1251,7 @@ script is being run. Errors thrown by C procedures or printed
directly from C applications will not be caught by the \fBtest\fR command.
Therefore, usage of the \fB\-output\fR and \fB\-errorOutput\fR
options to \fBtest\fR is useful only for pure Tcl applications
-that use \fBputs\fR to produce output.
+that use \fBputs\fR to produce output.
.SH KEYWORDS
test, test harness, test suite
.\" Local Variables:
diff --git a/doc/tclvars.n b/doc/tclvars.n
index 44a8e11..adefe40 100644
--- a/doc/tclvars.n
+++ b/doc/tclvars.n
@@ -4,13 +4,13 @@
'\"
'\" See 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
@@ -94,7 +94,7 @@ Note that this environment variable should \fInot\fR normally be set.
\fBenv(TCLLIBPATH)\fR
.
If set, then it must contain a valid Tcl list giving directories to
-search during auto-load operations. Directories must be specified in
+search during auto-load operations. Directories must be specified in
Tcl format, using
.QW /
as the path separator, regardless of platform.
@@ -229,7 +229,7 @@ nested Tcl commands that had been invoked at the time of the error.
This variable holds the name of a directory containing the
system library of Tcl scripts, such as those used for auto-loading.
The value of this variable is returned by the \fBinfo library\fR command.
-See the \fBlibrary\fR manual entry for details of the facilities
+See the \fBlibrary\fR manual entry for details of the facilities
provided by the Tcl script library.
Normally each application or package will have its own application-specific
script library in addition to the Tcl script library;
@@ -289,7 +289,7 @@ predefined elements are:
\fBbyteOrder\fR
.
The native byte order of this machine: either \fBlittleEndian\fR or
-\fBbigEndian\fR.
+\fBbigEndian\fR.
.TP
\fBdebug\fR
.
@@ -299,6 +299,11 @@ so extension writers can specify which package to load depending on the
C run-time library that is in use. This is not an indication that this core
contains symbols.
.TP
+\fBengine\fR
+.
+The name of the Tcl language implementation. When the interpreter is first
+created, this is always set to the string \fBTcl\fR.
+.TP
\fBmachine\fR
.
The instruction set executed by this machine, such as
@@ -308,18 +313,13 @@ is the value returned by \fBuname -m\fR.
\fBos\fR
.
The name of the operating system running on this machine,
-such as \fBWindows 95\fR, \fBWindows NT\fR, or \fBSunOS\fR.
+such as \fBWindows NT\fR or \fBSunOS\fR.
On UNIX machines, this is the value returned by \fBuname -s\fR.
-On Windows 95 and Windows 98, the value returned will be \fBWindows
-95\fR to provide better backwards compatibility to Windows 95; to
-distinguish between the two, check the \fBosVersion\fR.
.TP
\fBosVersion\fR
.
The version number for the operating system running on this machine.
-On UNIX machines, this is the value returned by \fBuname -r\fR. On
-Windows 95, the version will be 4.0; on Windows 98, the version will
-be 4.10.
+On UNIX machines, this is the value returned by \fBuname -r\fR.
.TP
\fBpathSeparator\fR
.VS 8.6
@@ -347,8 +347,8 @@ was compiled with threads enabled.
.
This identifies the
current user based on the login information available on the platform.
-This comes from the USER or LOGNAME environment variable on Unix,
-and the value from GetUserName on Windows.
+This value comes from the getuid() and getpwuid() system calls on Unix,
+and the value from the GetUserName() system call on Windows.
.TP
\fBwordSize\fR
.
@@ -376,7 +376,7 @@ binary number.
.PP
.RS
If \fBtcl_precision\fR is not zero, then when Tcl converts a floating
-point number, it creates a decimal representation of at most
+point number, it creates a decimal representation of at most
\fBtcl_precision\fR significant digits; the result may be shorter if
the shorter result represents the original number exactly. If no
result of at most \fBtcl_precision\fR digits is an exact representation
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 b28f2e4..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
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..5482e59 100644
--- a/doc/trace.n
+++ b/doc/trace.n
@@ -5,9 +5,9 @@
'\"
'\" See 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..4da74f2 100644
--- a/doc/transchan.n
+++ b/doc/transchan.n
@@ -1,11 +1,11 @@
-'\"
+'\"
'\" Copyright (c) 2008 Donal K. Fellows
'\"
'\" See 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 78a006d..eae4dc7 100644
--- a/doc/try.n
+++ b/doc/try.n
@@ -3,9 +3,9 @@
'\"
'\" See 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
diff --git a/doc/unknown.n b/doc/unknown.n
index fc2a5a1..82dcefc 100644
--- a/doc/unknown.n
+++ b/doc/unknown.n
@@ -4,9 +4,9 @@
'\"
'\" See 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
@@ -21,14 +21,14 @@ tries to invoke a command that does not exist. The default implementation
of \fBunknown\fR is a library procedure defined when Tcl initializes an
interpreter. You can override the default \fBunknown\fR to change its
functionality, or you can register a new handler for individual namespaces
-using the \fBnamespace unknown\fR command. Note that there is no default
+using the \fBnamespace unknown\fR command. Note that there is no default
implementation of \fBunknown\fR in a safe interpreter.
.PP
If the Tcl interpreter encounters a command name for which there
-is not a defined command (in either the current namespace, or the
+is not a defined command (in either the current namespace, or the
global namespace), then Tcl checks for the existence of
an unknown handler for the current namespace. By default, this
-handler is a command named \fB::unknown\fR. If there is no such
+handler is a command named \fB::unknown\fR. If there is no such
command, then the interpreter returns an error.
If the \fBunknown\fR command exists (or a new handler has been
registered for the current namespace), then it is invoked with
diff --git a/doc/unload.n b/doc/unload.n
index 4c0b292..0a8e99b 100644
--- a/doc/unload.n
+++ b/doc/unload.n
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -45,7 +45,7 @@ never report an error.
\fB\-keeplibrary\fR
.
This switch will prevent \fBunload\fR from issuing the operating system call
-that will unload the library from the process.
+that will unload the library from the process.
.TP
\fB\-\|\-\fR
.
@@ -109,7 +109,7 @@ the library is used by other interpreters),
\fBTCL_UNLOAD_DETACH_FROM_INTERPRETER\fR will be defined. However, if the
library is used only by the target interpreter and the library will be
detached from the application as soon as the unload procedure returns,
-the \fIflags\fR argument will be set to \fBTCL_UNLOAD_DETACH_FROM_PROCESS\fR.
+the \fIflags\fR argument will be set to \fBTCL_UNLOAD_DETACH_FROM_PROCESS\fR.
.SS NOTES
.PP
The \fBunload\fR command cannot unload libraries that are statically
diff --git a/doc/unset.n b/doc/unset.n
index 64b334d..2cfc63e 100644
--- a/doc/unset.n
+++ b/doc/unset.n
@@ -5,9 +5,9 @@
'\"
'\" See 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..ce0fb25 100644
--- a/doc/update.n
+++ b/doc/update.n
@@ -4,9 +4,9 @@
'\"
'\" See 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..4decc6d 100644
--- a/doc/uplevel.n
+++ b/doc/uplevel.n
@@ -4,9 +4,9 @@
'\"
'\" See 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..91defe6 100644
--- a/doc/upvar.n
+++ b/doc/upvar.n
@@ -4,9 +4,9 @@
'\"
'\" See 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..a6e545f 100644
--- a/doc/variable.n
+++ b/doc/variable.n
@@ -4,9 +4,9 @@
'\"
'\" See 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..f64d39c 100644
--- a/doc/vwait.n
+++ b/doc/vwait.n
@@ -3,9 +3,9 @@
'\"
'\" See 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..961260c 100644
--- a/doc/while.n
+++ b/doc/while.n
@@ -4,9 +4,9 @@
'\"
'\" See 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..9f3078d 100644
--- a/doc/zlib.n
+++ b/doc/zlib.n
@@ -3,9 +3,9 @@
'\"
'\" See 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
@@ -81,7 +81,7 @@ named by the \fBfilename\fR field was modified. Suitable for use with
The type of the uncompressed data (\fBbinary\fR or \fBtext\fR) if known.
.RE
.TP
-\fBzlib gzip\fI string\fR ?\fB\-level \fIlevel\fR? ?\fB\-header \fIdict\fR?
+\fBzlib gzip\fI string\fR ?\fB\-level \fIlevel\fR? ?\fB\-header \fIdict\fR?
.
Return the compressed contents of binary string \fIstring\fR in gzip format.
If \fB\-level\fR is given, \fIlevel\fR gives the compression level to use
diff --git a/generic/regc_color.c b/generic/regc_color.c
index f5d6dfd..92e0aad 100644
--- a/generic/regc_color.c
+++ b/generic/regc_color.c
@@ -259,7 +259,7 @@ newcolor(
return COLORLESS; /* too many colors */
}
n = cm->ncds * 2;
- if (n < MAX_COLOR + 1) {
+ if (n > MAX_COLOR + 1) {
n = MAX_COLOR + 1;
}
if (cm->cd == cm->cdspace) {
@@ -777,18 +777,19 @@ dumpcolors(
}
/*
- * It's hard to do this more efficiently.
+ * Unfortunately, it's hard to do this next bit more efficiently.
+ *
+ * Spencer's original coding has the loop iterating from CHR_MIN
+ * to CHR_MAX, but that's utterly unusable for 32-bit chr, or
+ * even 16-bit. For debugging purposes it seems fine to print
+ * only chr codes up to 1000 or so.
*/
- for (c=CHR_MIN ; c<CHR_MAX ; c++) {
+ for (c=CHR_MIN ; c<1000 ; c++) {
if (GETCOLOR(cm, c) == co) {
dumpchr(c, f);
}
}
- assert(c == CHR_MAX);
- if (GETCOLOR(cm, c) == co) {
- dumpchr(c, f);
- }
fprintf(f, "\n");
}
}
diff --git a/generic/regc_cvec.c b/generic/regc_cvec.c
index 0247521..d450d3e 100644
--- a/generic/regc_cvec.c
+++ b/generic/regc_cvec.c
@@ -81,6 +81,7 @@ addchr(
struct cvec *cv, /* character vector */
pchr c) /* character to add */
{
+ assert(cv->nchrs < cv->chrspace);
cv->chrs[cv->nchrs++] = (chr)c;
}
diff --git a/generic/regc_lex.c b/generic/regc_lex.c
index 132e757..affcb48 100644
--- a/generic/regc_lex.c
+++ b/generic/regc_lex.c
@@ -256,20 +256,33 @@ static const chr brbacks[] = { /* \s within brackets */
CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
CHR(':'), CHR(']')
};
+
+#define PUNCT_CONN \
+ CHR('_'), \
+ 0x203f /* UNDERTIE */, \
+ 0x2040 /* CHARACTER TIE */,\
+ 0x2054 /* INVERTED UNDERTIE */,\
+ 0xfe33 /* PRESENTATION FORM FOR VERTICAL LOW LINE */, \
+ 0xfe34 /* PRESENTATION FORM FOR VERTICAL WAVY LOW LINE */, \
+ 0xfe4d /* DASHED LOW LINE */, \
+ 0xfe4e /* CENTRELINE LOW LINE */, \
+ 0xfe4f /* WAVY LOW LINE */, \
+ 0xff3f /* FULLWIDTH LOW LINE */
+
static const chr backw[] = { /* \w */
CHR('['), CHR('['), CHR(':'),
CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
- CHR(':'), CHR(']'), CHR('_'), CHR(']')
+ CHR(':'), CHR(']'), PUNCT_CONN, CHR(']')
};
static const chr backW[] = { /* \W */
CHR('['), CHR('^'), CHR('['), CHR(':'),
CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
- CHR(':'), CHR(']'), CHR('_'), CHR(']')
+ CHR(':'), CHR(']'), PUNCT_CONN, CHR(']')
};
static const chr brbackw[] = { /* \w within brackets */
CHR('['), CHR(':'),
CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
- CHR(':'), CHR(']'), CHR('_')
+ CHR(':'), CHR(']'), PUNCT_CONN
};
/*
@@ -1139,24 +1152,6 @@ newline(void)
}
/*
- - ch - return the chr sequence for regc_locale.c's fake collating element ch
- * This helps confine use of CHR to this source file. Beware that the caller
- * knows how long the sequence is.
- ^ #ifdef REG_DEBUG
- ^ static const chr *ch(NOPARMS);
- ^ #endif
- */
-#ifdef REG_DEBUG
-static const chr *
-ch(void)
-{
- static const chr chstr[] = { CHR('c'), CHR('h'), CHR('\0') };
-
- return chstr;
-}
-#endif
-
-/*
- chrnamed - return the chr known by a given (chr string) name
* The code is a bit clumsy, but this routine gets only such specialized
* use that it hardly matters.
diff --git a/generic/regc_locale.c b/generic/regc_locale.c
index e79dff8..3c10cb6 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;
@@ -137,21 +137,21 @@ static const crange alphaRangeTable[] = {
{0x41, 0x5a}, {0x61, 0x7a}, {0xc0, 0xd6}, {0xd8, 0xf6},
{0xf8, 0x2c1}, {0x2c6, 0x2d1}, {0x2e0, 0x2e4}, {0x370, 0x374},
{0x37a, 0x37d}, {0x388, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x3f5},
- {0x3f7, 0x481}, {0x48a, 0x527}, {0x531, 0x556}, {0x561, 0x587},
+ {0x3f7, 0x481}, {0x48a, 0x52f}, {0x531, 0x556}, {0x561, 0x587},
{0x5d0, 0x5ea}, {0x5f0, 0x5f2}, {0x620, 0x64a}, {0x671, 0x6d3},
{0x6fa, 0x6fc}, {0x712, 0x72f}, {0x74d, 0x7a5}, {0x7ca, 0x7ea},
- {0x800, 0x815}, {0x840, 0x858}, {0x8a2, 0x8ac}, {0x904, 0x939},
- {0x958, 0x961}, {0x971, 0x977}, {0x979, 0x97f}, {0x985, 0x98c},
- {0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9df, 0x9e1},
- {0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa59, 0xa5c},
- {0xa72, 0xa74}, {0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8},
- {0xaaa, 0xab0}, {0xab5, 0xab9}, {0xb05, 0xb0c}, {0xb13, 0xb28},
- {0xb2a, 0xb30}, {0xb35, 0xb39}, {0xb5f, 0xb61}, {0xb85, 0xb8a},
- {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa}, {0xbae, 0xbb9},
- {0xc05, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc33},
- {0xc35, 0xc39}, {0xc85, 0xc8c}, {0xc8e, 0xc90}, {0xc92, 0xca8},
- {0xcaa, 0xcb3}, {0xcb5, 0xcb9}, {0xd05, 0xd0c}, {0xd0e, 0xd10},
- {0xd12, 0xd3a}, {0xd7a, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1},
+ {0x800, 0x815}, {0x840, 0x858}, {0x8a0, 0x8b4}, {0x904, 0x939},
+ {0x958, 0x961}, {0x971, 0x980}, {0x985, 0x98c}, {0x993, 0x9a8},
+ {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9df, 0x9e1}, {0xa05, 0xa0a},
+ {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa59, 0xa5c}, {0xa72, 0xa74},
+ {0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8}, {0xaaa, 0xab0},
+ {0xab5, 0xab9}, {0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30},
+ {0xb35, 0xb39}, {0xb5f, 0xb61}, {0xb85, 0xb8a}, {0xb8e, 0xb90},
+ {0xb92, 0xb95}, {0xba8, 0xbaa}, {0xbae, 0xbb9}, {0xc05, 0xc0c},
+ {0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc39}, {0xc58, 0xc5a},
+ {0xc85, 0xc8c}, {0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3},
+ {0xcb5, 0xcb9}, {0xd05, 0xd0c}, {0xd0e, 0xd10}, {0xd12, 0xd3a},
+ {0xd5f, 0xd61}, {0xd7a, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1},
{0xdb3, 0xdbb}, {0xdc0, 0xdc6}, {0xe01, 0xe30}, {0xe40, 0xe46},
{0xe94, 0xe97}, {0xe99, 0xe9f}, {0xea1, 0xea3}, {0xead, 0xeb0},
{0xec0, 0xec4}, {0xedc, 0xedf}, {0xf40, 0xf47}, {0xf49, 0xf6c},
@@ -160,95 +160,113 @@ static const crange alphaRangeTable[] = {
{0x10fc, 0x1248}, {0x124a, 0x124d}, {0x1250, 0x1256}, {0x125a, 0x125d},
{0x1260, 0x1288}, {0x128a, 0x128d}, {0x1290, 0x12b0}, {0x12b2, 0x12b5},
{0x12b8, 0x12be}, {0x12c2, 0x12c5}, {0x12c8, 0x12d6}, {0x12d8, 0x1310},
- {0x1312, 0x1315}, {0x1318, 0x135a}, {0x1380, 0x138f}, {0x13a0, 0x13f4},
- {0x1401, 0x166c}, {0x166f, 0x167f}, {0x1681, 0x169a}, {0x16a0, 0x16ea},
- {0x1700, 0x170c}, {0x170e, 0x1711}, {0x1720, 0x1731}, {0x1740, 0x1751},
- {0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17b3}, {0x1820, 0x1877},
- {0x1880, 0x18a8}, {0x18b0, 0x18f5}, {0x1900, 0x191c}, {0x1950, 0x196d},
- {0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19c1, 0x19c7}, {0x1a00, 0x1a16},
- {0x1a20, 0x1a54}, {0x1b05, 0x1b33}, {0x1b45, 0x1b4b}, {0x1b83, 0x1ba0},
- {0x1bba, 0x1be5}, {0x1c00, 0x1c23}, {0x1c4d, 0x1c4f}, {0x1c5a, 0x1c7d},
- {0x1ce9, 0x1cec}, {0x1cee, 0x1cf1}, {0x1d00, 0x1dbf}, {0x1e00, 0x1f15},
- {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57},
- {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fbc}, {0x1fc2, 0x1fc4},
- {0x1fc6, 0x1fcc}, {0x1fd0, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fe0, 0x1fec},
- {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffc}, {0x2090, 0x209c}, {0x210a, 0x2113},
- {0x2119, 0x211d}, {0x212a, 0x212d}, {0x212f, 0x2139}, {0x213c, 0x213f},
- {0x2145, 0x2149}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2ce4},
- {0x2ceb, 0x2cee}, {0x2d00, 0x2d25}, {0x2d30, 0x2d67}, {0x2d80, 0x2d96},
- {0x2da0, 0x2da6}, {0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe},
- {0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde},
- {0x3031, 0x3035}, {0x3041, 0x3096}, {0x309d, 0x309f}, {0x30a1, 0x30fa},
- {0x30fc, 0x30ff}, {0x3105, 0x312d}, {0x3131, 0x318e}, {0x31a0, 0x31ba},
- {0x31f0, 0x31ff}, {0x3400, 0x4db5}, {0x4e00, 0x9fcc}, {0xa000, 0xa48c},
- {0xa4d0, 0xa4fd}, {0xa500, 0xa60c}, {0xa610, 0xa61f}, {0xa640, 0xa66e},
- {0xa67f, 0xa697}, {0xa6a0, 0xa6e5}, {0xa717, 0xa71f}, {0xa722, 0xa788},
- {0xa78b, 0xa78e}, {0xa790, 0xa793}, {0xa7a0, 0xa7aa}, {0xa7f8, 0xa801},
- {0xa803, 0xa805}, {0xa807, 0xa80a}, {0xa80c, 0xa822}, {0xa840, 0xa873},
- {0xa882, 0xa8b3}, {0xa8f2, 0xa8f7}, {0xa90a, 0xa925}, {0xa930, 0xa946},
- {0xa960, 0xa97c}, {0xa984, 0xa9b2}, {0xaa00, 0xaa28}, {0xaa40, 0xaa42},
- {0xaa44, 0xaa4b}, {0xaa60, 0xaa76}, {0xaa80, 0xaaaf}, {0xaab9, 0xaabd},
+ {0x1312, 0x1315}, {0x1318, 0x135a}, {0x1380, 0x138f}, {0x13a0, 0x13f5},
+ {0x13f8, 0x13fd}, {0x1401, 0x166c}, {0x166f, 0x167f}, {0x1681, 0x169a},
+ {0x16a0, 0x16ea}, {0x16f1, 0x16f8}, {0x1700, 0x170c}, {0x170e, 0x1711},
+ {0x1720, 0x1731}, {0x1740, 0x1751}, {0x1760, 0x176c}, {0x176e, 0x1770},
+ {0x1780, 0x17b3}, {0x1820, 0x1877}, {0x1880, 0x18a8}, {0x18b0, 0x18f5},
+ {0x1900, 0x191e}, {0x1950, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab},
+ {0x19b0, 0x19c9}, {0x1a00, 0x1a16}, {0x1a20, 0x1a54}, {0x1b05, 0x1b33},
+ {0x1b45, 0x1b4b}, {0x1b83, 0x1ba0}, {0x1bba, 0x1be5}, {0x1c00, 0x1c23},
+ {0x1c4d, 0x1c4f}, {0x1c5a, 0x1c7d}, {0x1ce9, 0x1cec}, {0x1cee, 0x1cf1},
+ {0x1d00, 0x1dbf}, {0x1e00, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45},
+ {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4},
+ {0x1fb6, 0x1fbc}, {0x1fc2, 0x1fc4}, {0x1fc6, 0x1fcc}, {0x1fd0, 0x1fd3},
+ {0x1fd6, 0x1fdb}, {0x1fe0, 0x1fec}, {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffc},
+ {0x2090, 0x209c}, {0x210a, 0x2113}, {0x2119, 0x211d}, {0x212a, 0x212d},
+ {0x212f, 0x2139}, {0x213c, 0x213f}, {0x2145, 0x2149}, {0x2c00, 0x2c2e},
+ {0x2c30, 0x2c5e}, {0x2c60, 0x2ce4}, {0x2ceb, 0x2cee}, {0x2d00, 0x2d25},
+ {0x2d30, 0x2d67}, {0x2d80, 0x2d96}, {0x2da0, 0x2da6}, {0x2da8, 0x2dae},
+ {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce},
+ {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x3031, 0x3035}, {0x3041, 0x3096},
+ {0x309d, 0x309f}, {0x30a1, 0x30fa}, {0x30fc, 0x30ff}, {0x3105, 0x312d},
+ {0x3131, 0x318e}, {0x31a0, 0x31ba}, {0x31f0, 0x31ff}, {0x3400, 0x4db5},
+ {0x4e00, 0x9fd5}, {0xa000, 0xa48c}, {0xa4d0, 0xa4fd}, {0xa500, 0xa60c},
+ {0xa610, 0xa61f}, {0xa640, 0xa66e}, {0xa67f, 0xa69d}, {0xa6a0, 0xa6e5},
+ {0xa717, 0xa71f}, {0xa722, 0xa788}, {0xa78b, 0xa7ad}, {0xa7b0, 0xa7b7},
+ {0xa7f7, 0xa801}, {0xa803, 0xa805}, {0xa807, 0xa80a}, {0xa80c, 0xa822},
+ {0xa840, 0xa873}, {0xa882, 0xa8b3}, {0xa8f2, 0xa8f7}, {0xa90a, 0xa925},
+ {0xa930, 0xa946}, {0xa960, 0xa97c}, {0xa984, 0xa9b2}, {0xa9e0, 0xa9e4},
+ {0xa9e6, 0xa9ef}, {0xa9fa, 0xa9fe}, {0xaa00, 0xaa28}, {0xaa40, 0xaa42},
+ {0xaa44, 0xaa4b}, {0xaa60, 0xaa76}, {0xaa7e, 0xaaaf}, {0xaab9, 0xaabd},
{0xaadb, 0xaadd}, {0xaae0, 0xaaea}, {0xaaf2, 0xaaf4}, {0xab01, 0xab06},
{0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26}, {0xab28, 0xab2e},
- {0xabc0, 0xabe2}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb},
- {0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
- {0xfb1f, 0xfb28}, {0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1},
- {0xfbd3, 0xfd3d}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb},
- {0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff21, 0xff3a}, {0xff41, 0xff5a},
- {0xff66, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7},
- {0xffda, 0xffdc}
+ {0xab30, 0xab5a}, {0xab5c, 0xab65}, {0xab70, 0xabe2}, {0xac00, 0xd7a3},
+ {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xdc00, 0xdc3e}, {0xdc40, 0xdc7e},
+ {0xde80, 0xdebe}, {0xdec0, 0xdefe}, {0xdf00, 0xdf3e}, {0xdf40, 0xdf7e},
+ {0xdf80, 0xdfbe}, {0xdfc0, 0xdffe}, {0xf900, 0xfa6d}, {0xfa70, 0xfad9},
+ {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1f, 0xfb28}, {0xfb2a, 0xfb36},
+ {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1}, {0xfbd3, 0xfd3d}, {0xfd50, 0xfd8f},
+ {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb}, {0xfe70, 0xfe74}, {0xfe76, 0xfefc},
+ {0xff21, 0xff3a}, {0xff41, 0xff5a}, {0xff66, 0xffbe}, {0xffc2, 0xffc7},
+ {0xffca, 0xffcf}, {0xffd2, 0xffd7}, {0xffda, 0xffdc}
#if TCL_UTF_MAX > 4
,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d},
{0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10280, 0x1029c}, {0x102a0, 0x102d0},
- {0x10300, 0x1031e}, {0x10330, 0x10340}, {0x10342, 0x10349}, {0x10380, 0x1039d},
- {0x103a0, 0x103c3}, {0x103c8, 0x103cf}, {0x10400, 0x1049d}, {0x10800, 0x10805},
- {0x1080a, 0x10835}, {0x1083f, 0x10855}, {0x10900, 0x10915}, {0x10920, 0x10939},
- {0x10980, 0x109b7}, {0x10a10, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33},
- {0x10a60, 0x10a7c}, {0x10b00, 0x10b35}, {0x10b40, 0x10b55}, {0x10b60, 0x10b72},
- {0x10c00, 0x10c48}, {0x11003, 0x11037}, {0x11083, 0x110af}, {0x110d0, 0x110e8},
- {0x11103, 0x11126}, {0x11183, 0x111b2}, {0x111c1, 0x111c4}, {0x11680, 0x116aa},
- {0x12000, 0x1236e}, {0x13000, 0x1342e}, {0x16800, 0x16a38}, {0x16f00, 0x16f44},
- {0x16f93, 0x16f9f}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac},
- {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a},
- {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e},
- {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d6c0},
- {0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6fa}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d734},
- {0x1d736, 0x1d74e}, {0x1d750, 0x1d76e}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d7a8},
- {0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7cb}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f},
+ {0x10300, 0x1031f}, {0x10330, 0x10340}, {0x10342, 0x10349}, {0x10350, 0x10375},
+ {0x10380, 0x1039d}, {0x103a0, 0x103c3}, {0x103c8, 0x103cf}, {0x10400, 0x1049d},
+ {0x10500, 0x10527}, {0x10530, 0x10563}, {0x10600, 0x10736}, {0x10740, 0x10755},
+ {0x10760, 0x10767}, {0x10800, 0x10805}, {0x1080a, 0x10835}, {0x1083f, 0x10855},
+ {0x10860, 0x10876}, {0x10880, 0x1089e}, {0x108e0, 0x108f2}, {0x10900, 0x10915},
+ {0x10920, 0x10939}, {0x10980, 0x109b7}, {0x10a10, 0x10a13}, {0x10a15, 0x10a17},
+ {0x10a19, 0x10a33}, {0x10a60, 0x10a7c}, {0x10a80, 0x10a9c}, {0x10ac0, 0x10ac7},
+ {0x10ac9, 0x10ae4}, {0x10b00, 0x10b35}, {0x10b40, 0x10b55}, {0x10b60, 0x10b72},
+ {0x10b80, 0x10b91}, {0x10c00, 0x10c48}, {0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2},
+ {0x11003, 0x11037}, {0x11083, 0x110af}, {0x110d0, 0x110e8}, {0x11103, 0x11126},
+ {0x11150, 0x11172}, {0x11183, 0x111b2}, {0x111c1, 0x111c4}, {0x11200, 0x11211},
+ {0x11213, 0x1122b}, {0x11280, 0x11286}, {0x1128a, 0x1128d}, {0x1128f, 0x1129d},
+ {0x1129f, 0x112a8}, {0x112b0, 0x112de}, {0x11305, 0x1130c}, {0x11313, 0x11328},
+ {0x1132a, 0x11330}, {0x11335, 0x11339}, {0x1135d, 0x11361}, {0x11480, 0x114af},
+ {0x11580, 0x115ae}, {0x115d8, 0x115db}, {0x11600, 0x1162f}, {0x11680, 0x116aa},
+ {0x11700, 0x11719}, {0x118a0, 0x118df}, {0x11ac0, 0x11af8}, {0x12000, 0x12399},
+ {0x12480, 0x12543}, {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38},
+ {0x16a40, 0x16a5e}, {0x16ad0, 0x16aed}, {0x16b00, 0x16b2f}, {0x16b40, 0x16b43},
+ {0x16b63, 0x16b77}, {0x16b7d, 0x16b8f}, {0x16f00, 0x16f44}, {0x16f93, 0x16f9f},
+ {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99},
+ {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9},
+ {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514},
+ {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544},
+ {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d6c0}, {0x1d6c2, 0x1d6da},
+ {0x1d6dc, 0x1d6fa}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d734}, {0x1d736, 0x1d74e},
+ {0x1d750, 0x1d76e}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d7a8}, {0x1d7aa, 0x1d7c2},
+ {0x1d7c4, 0x1d7cb}, {0x1e800, 0x1e8c4}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f},
{0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a},
{0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89},
{0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb},
- {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d}, {0x2f800, 0x2fa1d}
+ {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d}, {0x2b820, 0x2cea1},
+ {0x2f800, 0x2fa1d}
#endif
};
#define NUM_ALPHA_RANGE (sizeof(alphaRangeTable)/sizeof(crange))
static const chr alphaCharTable[] = {
- 0xaa, 0xb5, 0xba, 0x2ec, 0x2ee, 0x376, 0x377, 0x386, 0x38c,
- 0x559, 0x66e, 0x66f, 0x6d5, 0x6e5, 0x6e6, 0x6ee, 0x6ef, 0x6ff,
- 0x710, 0x7b1, 0x7f4, 0x7f5, 0x7fa, 0x81a, 0x824, 0x828, 0x8a0,
+ 0xaa, 0xb5, 0xba, 0x2ec, 0x2ee, 0x376, 0x377, 0x37f, 0x386,
+ 0x38c, 0x559, 0x66e, 0x66f, 0x6d5, 0x6e5, 0x6e6, 0x6ee, 0x6ef,
+ 0x6ff, 0x710, 0x7b1, 0x7f4, 0x7f5, 0x7fa, 0x81a, 0x824, 0x828,
0x93d, 0x950, 0x98f, 0x990, 0x9b2, 0x9bd, 0x9ce, 0x9dc, 0x9dd,
0x9f0, 0x9f1, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36, 0xa38,
- 0xa39, 0xa5e, 0xab2, 0xab3, 0xabd, 0xad0, 0xae0, 0xae1, 0xb0f,
- 0xb10, 0xb32, 0xb33, 0xb3d, 0xb5c, 0xb5d, 0xb71, 0xb83, 0xb99,
- 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4, 0xbd0, 0xc3d, 0xc58,
- 0xc59, 0xc60, 0xc61, 0xcbd, 0xcde, 0xce0, 0xce1, 0xcf1, 0xcf2,
- 0xd3d, 0xd4e, 0xd60, 0xd61, 0xdbd, 0xe32, 0xe33, 0xe81, 0xe82,
- 0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab,
- 0xeb2, 0xeb3, 0xebd, 0xec6, 0xf00, 0x103f, 0x1061, 0x1065, 0x1066,
- 0x108e, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x17d7, 0x17dc, 0x18aa, 0x1aa7,
- 0x1bae, 0x1baf, 0x1cf5, 0x1cf6, 0x1f59, 0x1f5b, 0x1f5d, 0x1fbe, 0x2071,
- 0x207f, 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x214e, 0x2183,
- 0x2184, 0x2cf2, 0x2cf3, 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, 0x3005, 0x3006,
- 0x303b, 0x303c, 0xa62a, 0xa62b, 0xa8fb, 0xa9cf, 0xaa7a, 0xaab1, 0xaab5,
- 0xaab6, 0xaac0, 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44
+ 0xa39, 0xa5e, 0xab2, 0xab3, 0xabd, 0xad0, 0xae0, 0xae1, 0xaf9,
+ 0xb0f, 0xb10, 0xb32, 0xb33, 0xb3d, 0xb5c, 0xb5d, 0xb71, 0xb83,
+ 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4, 0xbd0, 0xc3d,
+ 0xc60, 0xc61, 0xcbd, 0xcde, 0xce0, 0xce1, 0xcf1, 0xcf2, 0xd3d,
+ 0xd4e, 0xdbd, 0xe32, 0xe33, 0xe81, 0xe82, 0xe84, 0xe87, 0xe88,
+ 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab, 0xeb2, 0xeb3, 0xebd,
+ 0xec6, 0xf00, 0x103f, 0x1061, 0x1065, 0x1066, 0x108e, 0x10c7, 0x10cd,
+ 0x1258, 0x12c0, 0x17d7, 0x17dc, 0x18aa, 0x1aa7, 0x1bae, 0x1baf, 0x1cf5,
+ 0x1cf6, 0x1f59, 0x1f5b, 0x1f5d, 0x1fbe, 0x2071, 0x207f, 0x2102, 0x2107,
+ 0x2115, 0x2124, 0x2126, 0x2128, 0x214e, 0x2183, 0x2184, 0x2cf2, 0x2cf3,
+ 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, 0x3005, 0x3006, 0x303b, 0x303c, 0xa62a,
+ 0xa62b, 0xa8fb, 0xa8fd, 0xa9cf, 0xaa7a, 0xaab1, 0xaab5, 0xaab6, 0xaac0,
+ 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44
#if TCL_UTF_MAX > 4
- ,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x109be, 0x109bf, 0x10a00,
- 0x16f50, 0x1b000, 0x1b001, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb,
- 0x1d546, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47,
- 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d,
- 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e
+ ,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4, 0x108f5, 0x109be,
+ 0x109bf, 0x10a00, 0x11176, 0x111da, 0x111dc, 0x11288, 0x1130f, 0x11310, 0x11332,
+ 0x11333, 0x1133d, 0x11350, 0x114c4, 0x114c5, 0x114c7, 0x11644, 0x118ff, 0x16f50,
+ 0x1b000, 0x1b001, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546,
+ 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49,
+ 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f,
+ 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e
#endif
};
@@ -259,18 +277,19 @@ static const chr alphaCharTable[] = {
*/
static const crange controlRangeTable[] = {
- {0x0, 0x1f}, {0x7f, 0x9f}, {0x600, 0x604}, {0x200b, 0x200f},
- {0x202a, 0x202e}, {0x2060, 0x2064}, {0x206a, 0x206f}, {0xe000, 0xf8ff},
+ {0x0, 0x1f}, {0x7f, 0x9f}, {0x600, 0x605}, {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}
+ ,{0x1bca0, 0x1bca3}, {0x1d173, 0x1d17a}, {0xe0020, 0xe007f}, {0xf0000, 0xffffd},
+ {0x100000, 0x10fffd}
#endif
};
#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
@@ -286,15 +305,18 @@ static const crange digitRangeTable[] = {
{0x30, 0x39}, {0x660, 0x669}, {0x6f0, 0x6f9}, {0x7c0, 0x7c9},
{0x966, 0x96f}, {0x9e6, 0x9ef}, {0xa66, 0xa6f}, {0xae6, 0xaef},
{0xb66, 0xb6f}, {0xbe6, 0xbef}, {0xc66, 0xc6f}, {0xce6, 0xcef},
- {0xd66, 0xd6f}, {0xe50, 0xe59}, {0xed0, 0xed9}, {0xf20, 0xf29},
- {0x1040, 0x1049}, {0x1090, 0x1099}, {0x17e0, 0x17e9}, {0x1810, 0x1819},
- {0x1946, 0x194f}, {0x19d0, 0x19d9}, {0x1a80, 0x1a89}, {0x1a90, 0x1a99},
- {0x1b50, 0x1b59}, {0x1bb0, 0x1bb9}, {0x1c40, 0x1c49}, {0x1c50, 0x1c59},
- {0xa620, 0xa629}, {0xa8d0, 0xa8d9}, {0xa900, 0xa909}, {0xa9d0, 0xa9d9},
- {0xaa50, 0xaa59}, {0xabf0, 0xabf9}, {0xff10, 0xff19}
+ {0xd66, 0xd6f}, {0xde6, 0xdef}, {0xe50, 0xe59}, {0xed0, 0xed9},
+ {0xf20, 0xf29}, {0x1040, 0x1049}, {0x1090, 0x1099}, {0x17e0, 0x17e9},
+ {0x1810, 0x1819}, {0x1946, 0x194f}, {0x19d0, 0x19d9}, {0x1a80, 0x1a89},
+ {0x1a90, 0x1a99}, {0x1b50, 0x1b59}, {0x1bb0, 0x1bb9}, {0x1c40, 0x1c49},
+ {0x1c50, 0x1c59}, {0xa620, 0xa629}, {0xa8d0, 0xa8d9}, {0xa900, 0xa909},
+ {0xa9d0, 0xa9d9}, {0xa9f0, 0xa9f9}, {0xaa50, 0xaa59}, {0xabf0, 0xabf9},
+ {0xff10, 0xff19}
#if TCL_UTF_MAX > 4
,{0x104a0, 0x104a9}, {0x11066, 0x1106f}, {0x110f0, 0x110f9}, {0x11136, 0x1113f},
- {0x111d0, 0x111d9}, {0x116c0, 0x116c9}, {0x1d7ce, 0x1d7ff}
+ {0x111d0, 0x111d9}, {0x112f0, 0x112f9}, {0x114d0, 0x114d9}, {0x11650, 0x11659},
+ {0x116c0, 0x116c9}, {0x11730, 0x11739}, {0x118e0, 0x118e9}, {0x16a60, 0x16a69},
+ {0x16b50, 0x16b59}, {0x1d7ce, 0x1d7ff}
#endif
};
@@ -316,15 +338,19 @@ 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, 0x2e42},
+ {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}
+ ,{0x10100, 0x10102}, {0x10a50, 0x10a58}, {0x10af0, 0x10af6}, {0x10b39, 0x10b3f},
+ {0x10b99, 0x10b9c}, {0x11047, 0x1104d}, {0x110be, 0x110c1}, {0x11140, 0x11143},
+ {0x111c5, 0x111c9}, {0x111dd, 0x111df}, {0x11238, 0x1123d}, {0x115c1, 0x115d7},
+ {0x11641, 0x11643}, {0x1173c, 0x1173e}, {0x12470, 0x12474}, {0x16b37, 0x16b3b},
+ {0x1da87, 0x1da8b}
#endif
};
@@ -340,11 +366,13 @@ static const chr punctCharTable[] = {
0x1945, 0x1a1e, 0x1a1f, 0x1c7e, 0x1c7f, 0x1cd3, 0x207d, 0x207e, 0x208d,
0x208e, 0x2329, 0x232a, 0x27c5, 0x27c6, 0x29fc, 0x29fd, 0x2cfe, 0x2cff,
0x2d70, 0x3030, 0x303d, 0x30a0, 0x30fb, 0xa4fe, 0xa4ff, 0xa673, 0xa67e,
- 0xa8ce, 0xa8cf, 0xa92e, 0xa92f, 0xa95f, 0xa9de, 0xa9df, 0xaade, 0xaadf,
- 0xaaf0, 0xaaf1, 0xabeb, 0xfd3e, 0xfd3f, 0xfe63, 0xfe68, 0xfe6a, 0xfe6b,
- 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f, 0xff5b, 0xff5d
+ 0xa8ce, 0xa8cf, 0xa8fc, 0xa92e, 0xa92f, 0xa95f, 0xa9de, 0xa9df, 0xaade,
+ 0xaadf, 0xaaf0, 0xaaf1, 0xabeb, 0xfd3e, 0xfd3f, 0xfe63, 0xfe68, 0xfe6a,
+ 0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f, 0xff5b, 0xff5d
#if TCL_UTF_MAX > 4
- ,0x1039f, 0x103d0, 0x10857, 0x1091f, 0x1093f, 0x10a7f, 0x110bb, 0x110bc
+ ,0x1039f, 0x103d0, 0x1056f, 0x10857, 0x1091f, 0x1093f, 0x10a7f, 0x110bb, 0x110bc,
+ 0x11174, 0x11175, 0x111cd, 0x111db, 0x112a9, 0x114c6, 0x16a6e, 0x16a6f, 0x16af5,
+ 0x16b44, 0x1bc9f
#endif
};
@@ -375,22 +403,25 @@ static const crange lowerRangeTable[] = {
{0x61, 0x7a}, {0xdf, 0xf6}, {0xf8, 0xff}, {0x17e, 0x180},
{0x199, 0x19b}, {0x1bd, 0x1bf}, {0x233, 0x239}, {0x24f, 0x293},
{0x295, 0x2af}, {0x37b, 0x37d}, {0x3ac, 0x3ce}, {0x3d5, 0x3d7},
- {0x3ef, 0x3f3}, {0x430, 0x45f}, {0x561, 0x587}, {0x1d00, 0x1d2b},
- {0x1d6b, 0x1d77}, {0x1d79, 0x1d9a}, {0x1e95, 0x1e9d}, {0x1eff, 0x1f07},
- {0x1f10, 0x1f15}, {0x1f20, 0x1f27}, {0x1f30, 0x1f37}, {0x1f40, 0x1f45},
- {0x1f50, 0x1f57}, {0x1f60, 0x1f67}, {0x1f70, 0x1f7d}, {0x1f80, 0x1f87},
- {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7}, {0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4},
- {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7}, {0x1ff2, 0x1ff4}, {0x2146, 0x2149},
- {0x2c30, 0x2c5e}, {0x2c76, 0x2c7b}, {0x2d00, 0x2d25}, {0xa72f, 0xa731},
- {0xa771, 0xa778}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xff41, 0xff5a}
+ {0x3ef, 0x3f3}, {0x430, 0x45f}, {0x561, 0x587}, {0x13f8, 0x13fd},
+ {0x1d00, 0x1d2b}, {0x1d6b, 0x1d77}, {0x1d79, 0x1d9a}, {0x1e95, 0x1e9d},
+ {0x1eff, 0x1f07}, {0x1f10, 0x1f15}, {0x1f20, 0x1f27}, {0x1f30, 0x1f37},
+ {0x1f40, 0x1f45}, {0x1f50, 0x1f57}, {0x1f60, 0x1f67}, {0x1f70, 0x1f7d},
+ {0x1f80, 0x1f87}, {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7}, {0x1fb0, 0x1fb4},
+ {0x1fc2, 0x1fc4}, {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7}, {0x1ff2, 0x1ff4},
+ {0x2146, 0x2149}, {0x2c30, 0x2c5e}, {0x2c76, 0x2c7b}, {0x2d00, 0x2d25},
+ {0xa72f, 0xa731}, {0xa771, 0xa778}, {0xa793, 0xa795}, {0xab30, 0xab5a},
+ {0xab60, 0xab65}, {0xab70, 0xabbf}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
+ {0xff41, 0xff5a}
#if TCL_UTF_MAX > 4
- ,{0x10428, 0x1044f}, {0x1d41a, 0x1d433}, {0x1d44e, 0x1d454}, {0x1d456, 0x1d467},
- {0x1d482, 0x1d49b}, {0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf},
- {0x1d4ea, 0x1d503}, {0x1d51e, 0x1d537}, {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f},
- {0x1d5ba, 0x1d5d3}, {0x1d5ee, 0x1d607}, {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f},
- {0x1d68a, 0x1d6a5}, {0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6e1}, {0x1d6fc, 0x1d714},
- {0x1d716, 0x1d71b}, {0x1d736, 0x1d74e}, {0x1d750, 0x1d755}, {0x1d770, 0x1d788},
- {0x1d78a, 0x1d78f}, {0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7c9}
+ ,{0x10428, 0x1044f}, {0x10cc0, 0x10cf2}, {0x118c0, 0x118df}, {0x1d41a, 0x1d433},
+ {0x1d44e, 0x1d454}, {0x1d456, 0x1d467}, {0x1d482, 0x1d49b}, {0x1d4b6, 0x1d4b9},
+ {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf}, {0x1d4ea, 0x1d503}, {0x1d51e, 0x1d537},
+ {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f}, {0x1d5ba, 0x1d5d3}, {0x1d5ee, 0x1d607},
+ {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f}, {0x1d68a, 0x1d6a5}, {0x1d6c2, 0x1d6da},
+ {0x1d6dc, 0x1d6e1}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d71b}, {0x1d736, 0x1d74e},
+ {0x1d750, 0x1d755}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d78f}, {0x1d7aa, 0x1d7c2},
+ {0x1d7c4, 0x1d7c9}
#endif
};
@@ -426,39 +457,41 @@ static const chr lowerCharTable[] = {
0x4f1, 0x4f3, 0x4f5, 0x4f7, 0x4f9, 0x4fb, 0x4fd, 0x4ff, 0x501,
0x503, 0x505, 0x507, 0x509, 0x50b, 0x50d, 0x50f, 0x511, 0x513,
0x515, 0x517, 0x519, 0x51b, 0x51d, 0x51f, 0x521, 0x523, 0x525,
- 0x527, 0x1e01, 0x1e03, 0x1e05, 0x1e07, 0x1e09, 0x1e0b, 0x1e0d, 0x1e0f,
- 0x1e11, 0x1e13, 0x1e15, 0x1e17, 0x1e19, 0x1e1b, 0x1e1d, 0x1e1f, 0x1e21,
- 0x1e23, 0x1e25, 0x1e27, 0x1e29, 0x1e2b, 0x1e2d, 0x1e2f, 0x1e31, 0x1e33,
- 0x1e35, 0x1e37, 0x1e39, 0x1e3b, 0x1e3d, 0x1e3f, 0x1e41, 0x1e43, 0x1e45,
- 0x1e47, 0x1e49, 0x1e4b, 0x1e4d, 0x1e4f, 0x1e51, 0x1e53, 0x1e55, 0x1e57,
- 0x1e59, 0x1e5b, 0x1e5d, 0x1e5f, 0x1e61, 0x1e63, 0x1e65, 0x1e67, 0x1e69,
- 0x1e6b, 0x1e6d, 0x1e6f, 0x1e71, 0x1e73, 0x1e75, 0x1e77, 0x1e79, 0x1e7b,
- 0x1e7d, 0x1e7f, 0x1e81, 0x1e83, 0x1e85, 0x1e87, 0x1e89, 0x1e8b, 0x1e8d,
- 0x1e8f, 0x1e91, 0x1e93, 0x1e9f, 0x1ea1, 0x1ea3, 0x1ea5, 0x1ea7, 0x1ea9,
- 0x1eab, 0x1ead, 0x1eaf, 0x1eb1, 0x1eb3, 0x1eb5, 0x1eb7, 0x1eb9, 0x1ebb,
- 0x1ebd, 0x1ebf, 0x1ec1, 0x1ec3, 0x1ec5, 0x1ec7, 0x1ec9, 0x1ecb, 0x1ecd,
- 0x1ecf, 0x1ed1, 0x1ed3, 0x1ed5, 0x1ed7, 0x1ed9, 0x1edb, 0x1edd, 0x1edf,
- 0x1ee1, 0x1ee3, 0x1ee5, 0x1ee7, 0x1ee9, 0x1eeb, 0x1eed, 0x1eef, 0x1ef1,
- 0x1ef3, 0x1ef5, 0x1ef7, 0x1ef9, 0x1efb, 0x1efd, 0x1fb6, 0x1fb7, 0x1fbe,
- 0x1fc6, 0x1fc7, 0x1fd6, 0x1fd7, 0x1ff6, 0x1ff7, 0x210a, 0x210e, 0x210f,
- 0x2113, 0x212f, 0x2134, 0x2139, 0x213c, 0x213d, 0x214e, 0x2184, 0x2c61,
- 0x2c65, 0x2c66, 0x2c68, 0x2c6a, 0x2c6c, 0x2c71, 0x2c73, 0x2c74, 0x2c81,
- 0x2c83, 0x2c85, 0x2c87, 0x2c89, 0x2c8b, 0x2c8d, 0x2c8f, 0x2c91, 0x2c93,
- 0x2c95, 0x2c97, 0x2c99, 0x2c9b, 0x2c9d, 0x2c9f, 0x2ca1, 0x2ca3, 0x2ca5,
- 0x2ca7, 0x2ca9, 0x2cab, 0x2cad, 0x2caf, 0x2cb1, 0x2cb3, 0x2cb5, 0x2cb7,
- 0x2cb9, 0x2cbb, 0x2cbd, 0x2cbf, 0x2cc1, 0x2cc3, 0x2cc5, 0x2cc7, 0x2cc9,
- 0x2ccb, 0x2ccd, 0x2ccf, 0x2cd1, 0x2cd3, 0x2cd5, 0x2cd7, 0x2cd9, 0x2cdb,
- 0x2cdd, 0x2cdf, 0x2ce1, 0x2ce3, 0x2ce4, 0x2cec, 0x2cee, 0x2cf3, 0x2d27,
- 0x2d2d, 0xa641, 0xa643, 0xa645, 0xa647, 0xa649, 0xa64b, 0xa64d, 0xa64f,
- 0xa651, 0xa653, 0xa655, 0xa657, 0xa659, 0xa65b, 0xa65d, 0xa65f, 0xa661,
- 0xa663, 0xa665, 0xa667, 0xa669, 0xa66b, 0xa66d, 0xa681, 0xa683, 0xa685,
- 0xa687, 0xa689, 0xa68b, 0xa68d, 0xa68f, 0xa691, 0xa693, 0xa695, 0xa697,
- 0xa723, 0xa725, 0xa727, 0xa729, 0xa72b, 0xa72d, 0xa733, 0xa735, 0xa737,
- 0xa739, 0xa73b, 0xa73d, 0xa73f, 0xa741, 0xa743, 0xa745, 0xa747, 0xa749,
- 0xa74b, 0xa74d, 0xa74f, 0xa751, 0xa753, 0xa755, 0xa757, 0xa759, 0xa75b,
- 0xa75d, 0xa75f, 0xa761, 0xa763, 0xa765, 0xa767, 0xa769, 0xa76b, 0xa76d,
- 0xa76f, 0xa77a, 0xa77c, 0xa77f, 0xa781, 0xa783, 0xa785, 0xa787, 0xa78c,
- 0xa78e, 0xa791, 0xa793, 0xa7a1, 0xa7a3, 0xa7a5, 0xa7a7, 0xa7a9, 0xa7fa
+ 0x527, 0x529, 0x52b, 0x52d, 0x52f, 0x1e01, 0x1e03, 0x1e05, 0x1e07,
+ 0x1e09, 0x1e0b, 0x1e0d, 0x1e0f, 0x1e11, 0x1e13, 0x1e15, 0x1e17, 0x1e19,
+ 0x1e1b, 0x1e1d, 0x1e1f, 0x1e21, 0x1e23, 0x1e25, 0x1e27, 0x1e29, 0x1e2b,
+ 0x1e2d, 0x1e2f, 0x1e31, 0x1e33, 0x1e35, 0x1e37, 0x1e39, 0x1e3b, 0x1e3d,
+ 0x1e3f, 0x1e41, 0x1e43, 0x1e45, 0x1e47, 0x1e49, 0x1e4b, 0x1e4d, 0x1e4f,
+ 0x1e51, 0x1e53, 0x1e55, 0x1e57, 0x1e59, 0x1e5b, 0x1e5d, 0x1e5f, 0x1e61,
+ 0x1e63, 0x1e65, 0x1e67, 0x1e69, 0x1e6b, 0x1e6d, 0x1e6f, 0x1e71, 0x1e73,
+ 0x1e75, 0x1e77, 0x1e79, 0x1e7b, 0x1e7d, 0x1e7f, 0x1e81, 0x1e83, 0x1e85,
+ 0x1e87, 0x1e89, 0x1e8b, 0x1e8d, 0x1e8f, 0x1e91, 0x1e93, 0x1e9f, 0x1ea1,
+ 0x1ea3, 0x1ea5, 0x1ea7, 0x1ea9, 0x1eab, 0x1ead, 0x1eaf, 0x1eb1, 0x1eb3,
+ 0x1eb5, 0x1eb7, 0x1eb9, 0x1ebb, 0x1ebd, 0x1ebf, 0x1ec1, 0x1ec3, 0x1ec5,
+ 0x1ec7, 0x1ec9, 0x1ecb, 0x1ecd, 0x1ecf, 0x1ed1, 0x1ed3, 0x1ed5, 0x1ed7,
+ 0x1ed9, 0x1edb, 0x1edd, 0x1edf, 0x1ee1, 0x1ee3, 0x1ee5, 0x1ee7, 0x1ee9,
+ 0x1eeb, 0x1eed, 0x1eef, 0x1ef1, 0x1ef3, 0x1ef5, 0x1ef7, 0x1ef9, 0x1efb,
+ 0x1efd, 0x1fb6, 0x1fb7, 0x1fbe, 0x1fc6, 0x1fc7, 0x1fd6, 0x1fd7, 0x1ff6,
+ 0x1ff7, 0x210a, 0x210e, 0x210f, 0x2113, 0x212f, 0x2134, 0x2139, 0x213c,
+ 0x213d, 0x214e, 0x2184, 0x2c61, 0x2c65, 0x2c66, 0x2c68, 0x2c6a, 0x2c6c,
+ 0x2c71, 0x2c73, 0x2c74, 0x2c81, 0x2c83, 0x2c85, 0x2c87, 0x2c89, 0x2c8b,
+ 0x2c8d, 0x2c8f, 0x2c91, 0x2c93, 0x2c95, 0x2c97, 0x2c99, 0x2c9b, 0x2c9d,
+ 0x2c9f, 0x2ca1, 0x2ca3, 0x2ca5, 0x2ca7, 0x2ca9, 0x2cab, 0x2cad, 0x2caf,
+ 0x2cb1, 0x2cb3, 0x2cb5, 0x2cb7, 0x2cb9, 0x2cbb, 0x2cbd, 0x2cbf, 0x2cc1,
+ 0x2cc3, 0x2cc5, 0x2cc7, 0x2cc9, 0x2ccb, 0x2ccd, 0x2ccf, 0x2cd1, 0x2cd3,
+ 0x2cd5, 0x2cd7, 0x2cd9, 0x2cdb, 0x2cdd, 0x2cdf, 0x2ce1, 0x2ce3, 0x2ce4,
+ 0x2cec, 0x2cee, 0x2cf3, 0x2d27, 0x2d2d, 0xa641, 0xa643, 0xa645, 0xa647,
+ 0xa649, 0xa64b, 0xa64d, 0xa64f, 0xa651, 0xa653, 0xa655, 0xa657, 0xa659,
+ 0xa65b, 0xa65d, 0xa65f, 0xa661, 0xa663, 0xa665, 0xa667, 0xa669, 0xa66b,
+ 0xa66d, 0xa681, 0xa683, 0xa685, 0xa687, 0xa689, 0xa68b, 0xa68d, 0xa68f,
+ 0xa691, 0xa693, 0xa695, 0xa697, 0xa699, 0xa69b, 0xa723, 0xa725, 0xa727,
+ 0xa729, 0xa72b, 0xa72d, 0xa733, 0xa735, 0xa737, 0xa739, 0xa73b, 0xa73d,
+ 0xa73f, 0xa741, 0xa743, 0xa745, 0xa747, 0xa749, 0xa74b, 0xa74d, 0xa74f,
+ 0xa751, 0xa753, 0xa755, 0xa757, 0xa759, 0xa75b, 0xa75d, 0xa75f, 0xa761,
+ 0xa763, 0xa765, 0xa767, 0xa769, 0xa76b, 0xa76d, 0xa76f, 0xa77a, 0xa77c,
+ 0xa77f, 0xa781, 0xa783, 0xa785, 0xa787, 0xa78c, 0xa78e, 0xa791, 0xa797,
+ 0xa799, 0xa79b, 0xa79d, 0xa79f, 0xa7a1, 0xa7a3, 0xa7a5, 0xa7a7, 0xa7a9,
+ 0xa7b5, 0xa7b7, 0xa7fa
#if TCL_UTF_MAX > 4
,0x1d4bb, 0x1d7cb
#endif
@@ -475,19 +508,20 @@ static const crange upperRangeTable[] = {
{0x18e, 0x191}, {0x196, 0x198}, {0x1b1, 0x1b3}, {0x1f6, 0x1f8},
{0x243, 0x246}, {0x388, 0x38a}, {0x391, 0x3a1}, {0x3a3, 0x3ab},
{0x3d2, 0x3d4}, {0x3fd, 0x42f}, {0x531, 0x556}, {0x10a0, 0x10c5},
- {0x1f08, 0x1f0f}, {0x1f18, 0x1f1d}, {0x1f28, 0x1f2f}, {0x1f38, 0x1f3f},
- {0x1f48, 0x1f4d}, {0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb}, {0x1fc8, 0x1fcb},
- {0x1fd8, 0x1fdb}, {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb}, {0x210b, 0x210d},
- {0x2110, 0x2112}, {0x2119, 0x211d}, {0x212a, 0x212d}, {0x2130, 0x2133},
- {0x2c00, 0x2c2e}, {0x2c62, 0x2c64}, {0x2c6d, 0x2c70}, {0x2c7e, 0x2c80},
- {0xff21, 0xff3a}
+ {0x13a0, 0x13f5}, {0x1f08, 0x1f0f}, {0x1f18, 0x1f1d}, {0x1f28, 0x1f2f},
+ {0x1f38, 0x1f3f}, {0x1f48, 0x1f4d}, {0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb},
+ {0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb}, {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb},
+ {0x210b, 0x210d}, {0x2110, 0x2112}, {0x2119, 0x211d}, {0x212a, 0x212d},
+ {0x2130, 0x2133}, {0x2c00, 0x2c2e}, {0x2c62, 0x2c64}, {0x2c6d, 0x2c70},
+ {0x2c7e, 0x2c80}, {0xa7aa, 0xa7ad}, {0xa7b0, 0xa7b4}, {0xff21, 0xff3a}
#if TCL_UTF_MAX > 4
- ,{0x10400, 0x10427}, {0x1d400, 0x1d419}, {0x1d434, 0x1d44d}, {0x1d468, 0x1d481},
- {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a},
- {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544},
- {0x1d54a, 0x1d550}, {0x1d56c, 0x1d585}, {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed},
- {0x1d608, 0x1d621}, {0x1d63c, 0x1d655}, {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0},
- {0x1d6e2, 0x1d6fa}, {0x1d71c, 0x1d734}, {0x1d756, 0x1d76e}, {0x1d790, 0x1d7a8}
+ ,{0x10400, 0x10427}, {0x10c80, 0x10cb2}, {0x118a0, 0x118bf}, {0x1d400, 0x1d419},
+ {0x1d434, 0x1d44d}, {0x1d468, 0x1d481}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b5},
+ {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c},
+ {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d56c, 0x1d585},
+ {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed}, {0x1d608, 0x1d621}, {0x1d63c, 0x1d655},
+ {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0}, {0x1d6e2, 0x1d6fa}, {0x1d71c, 0x1d734},
+ {0x1d756, 0x1d76e}, {0x1d790, 0x1d7a8}
#endif
};
@@ -510,52 +544,53 @@ static const chr upperCharTable[] = {
0x20c, 0x20e, 0x210, 0x212, 0x214, 0x216, 0x218, 0x21a, 0x21c,
0x21e, 0x220, 0x222, 0x224, 0x226, 0x228, 0x22a, 0x22c, 0x22e,
0x230, 0x232, 0x23a, 0x23b, 0x23d, 0x23e, 0x241, 0x248, 0x24a,
- 0x24c, 0x24e, 0x370, 0x372, 0x376, 0x386, 0x38c, 0x38e, 0x38f,
- 0x3cf, 0x3d8, 0x3da, 0x3dc, 0x3de, 0x3e0, 0x3e2, 0x3e4, 0x3e6,
- 0x3e8, 0x3ea, 0x3ec, 0x3ee, 0x3f4, 0x3f7, 0x3f9, 0x3fa, 0x460,
- 0x462, 0x464, 0x466, 0x468, 0x46a, 0x46c, 0x46e, 0x470, 0x472,
- 0x474, 0x476, 0x478, 0x47a, 0x47c, 0x47e, 0x480, 0x48a, 0x48c,
- 0x48e, 0x490, 0x492, 0x494, 0x496, 0x498, 0x49a, 0x49c, 0x49e,
- 0x4a0, 0x4a2, 0x4a4, 0x4a6, 0x4a8, 0x4aa, 0x4ac, 0x4ae, 0x4b0,
- 0x4b2, 0x4b4, 0x4b6, 0x4b8, 0x4ba, 0x4bc, 0x4be, 0x4c0, 0x4c1,
- 0x4c3, 0x4c5, 0x4c7, 0x4c9, 0x4cb, 0x4cd, 0x4d0, 0x4d2, 0x4d4,
- 0x4d6, 0x4d8, 0x4da, 0x4dc, 0x4de, 0x4e0, 0x4e2, 0x4e4, 0x4e6,
- 0x4e8, 0x4ea, 0x4ec, 0x4ee, 0x4f0, 0x4f2, 0x4f4, 0x4f6, 0x4f8,
- 0x4fa, 0x4fc, 0x4fe, 0x500, 0x502, 0x504, 0x506, 0x508, 0x50a,
- 0x50c, 0x50e, 0x510, 0x512, 0x514, 0x516, 0x518, 0x51a, 0x51c,
- 0x51e, 0x520, 0x522, 0x524, 0x526, 0x10c7, 0x10cd, 0x1e00, 0x1e02,
- 0x1e04, 0x1e06, 0x1e08, 0x1e0a, 0x1e0c, 0x1e0e, 0x1e10, 0x1e12, 0x1e14,
- 0x1e16, 0x1e18, 0x1e1a, 0x1e1c, 0x1e1e, 0x1e20, 0x1e22, 0x1e24, 0x1e26,
- 0x1e28, 0x1e2a, 0x1e2c, 0x1e2e, 0x1e30, 0x1e32, 0x1e34, 0x1e36, 0x1e38,
- 0x1e3a, 0x1e3c, 0x1e3e, 0x1e40, 0x1e42, 0x1e44, 0x1e46, 0x1e48, 0x1e4a,
- 0x1e4c, 0x1e4e, 0x1e50, 0x1e52, 0x1e54, 0x1e56, 0x1e58, 0x1e5a, 0x1e5c,
- 0x1e5e, 0x1e60, 0x1e62, 0x1e64, 0x1e66, 0x1e68, 0x1e6a, 0x1e6c, 0x1e6e,
- 0x1e70, 0x1e72, 0x1e74, 0x1e76, 0x1e78, 0x1e7a, 0x1e7c, 0x1e7e, 0x1e80,
- 0x1e82, 0x1e84, 0x1e86, 0x1e88, 0x1e8a, 0x1e8c, 0x1e8e, 0x1e90, 0x1e92,
- 0x1e94, 0x1e9e, 0x1ea0, 0x1ea2, 0x1ea4, 0x1ea6, 0x1ea8, 0x1eaa, 0x1eac,
- 0x1eae, 0x1eb0, 0x1eb2, 0x1eb4, 0x1eb6, 0x1eb8, 0x1eba, 0x1ebc, 0x1ebe,
- 0x1ec0, 0x1ec2, 0x1ec4, 0x1ec6, 0x1ec8, 0x1eca, 0x1ecc, 0x1ece, 0x1ed0,
- 0x1ed2, 0x1ed4, 0x1ed6, 0x1ed8, 0x1eda, 0x1edc, 0x1ede, 0x1ee0, 0x1ee2,
- 0x1ee4, 0x1ee6, 0x1ee8, 0x1eea, 0x1eec, 0x1eee, 0x1ef0, 0x1ef2, 0x1ef4,
- 0x1ef6, 0x1ef8, 0x1efa, 0x1efc, 0x1efe, 0x1f59, 0x1f5b, 0x1f5d, 0x1f5f,
- 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x213e, 0x213f, 0x2145,
- 0x2183, 0x2c60, 0x2c67, 0x2c69, 0x2c6b, 0x2c72, 0x2c75, 0x2c82, 0x2c84,
- 0x2c86, 0x2c88, 0x2c8a, 0x2c8c, 0x2c8e, 0x2c90, 0x2c92, 0x2c94, 0x2c96,
- 0x2c98, 0x2c9a, 0x2c9c, 0x2c9e, 0x2ca0, 0x2ca2, 0x2ca4, 0x2ca6, 0x2ca8,
- 0x2caa, 0x2cac, 0x2cae, 0x2cb0, 0x2cb2, 0x2cb4, 0x2cb6, 0x2cb8, 0x2cba,
- 0x2cbc, 0x2cbe, 0x2cc0, 0x2cc2, 0x2cc4, 0x2cc6, 0x2cc8, 0x2cca, 0x2ccc,
- 0x2cce, 0x2cd0, 0x2cd2, 0x2cd4, 0x2cd6, 0x2cd8, 0x2cda, 0x2cdc, 0x2cde,
- 0x2ce0, 0x2ce2, 0x2ceb, 0x2ced, 0x2cf2, 0xa640, 0xa642, 0xa644, 0xa646,
- 0xa648, 0xa64a, 0xa64c, 0xa64e, 0xa650, 0xa652, 0xa654, 0xa656, 0xa658,
- 0xa65a, 0xa65c, 0xa65e, 0xa660, 0xa662, 0xa664, 0xa666, 0xa668, 0xa66a,
- 0xa66c, 0xa680, 0xa682, 0xa684, 0xa686, 0xa688, 0xa68a, 0xa68c, 0xa68e,
- 0xa690, 0xa692, 0xa694, 0xa696, 0xa722, 0xa724, 0xa726, 0xa728, 0xa72a,
- 0xa72c, 0xa72e, 0xa732, 0xa734, 0xa736, 0xa738, 0xa73a, 0xa73c, 0xa73e,
- 0xa740, 0xa742, 0xa744, 0xa746, 0xa748, 0xa74a, 0xa74c, 0xa74e, 0xa750,
- 0xa752, 0xa754, 0xa756, 0xa758, 0xa75a, 0xa75c, 0xa75e, 0xa760, 0xa762,
- 0xa764, 0xa766, 0xa768, 0xa76a, 0xa76c, 0xa76e, 0xa779, 0xa77b, 0xa77d,
- 0xa77e, 0xa780, 0xa782, 0xa784, 0xa786, 0xa78b, 0xa78d, 0xa790, 0xa792,
- 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7aa
+ 0x24c, 0x24e, 0x370, 0x372, 0x376, 0x37f, 0x386, 0x38c, 0x38e,
+ 0x38f, 0x3cf, 0x3d8, 0x3da, 0x3dc, 0x3de, 0x3e0, 0x3e2, 0x3e4,
+ 0x3e6, 0x3e8, 0x3ea, 0x3ec, 0x3ee, 0x3f4, 0x3f7, 0x3f9, 0x3fa,
+ 0x460, 0x462, 0x464, 0x466, 0x468, 0x46a, 0x46c, 0x46e, 0x470,
+ 0x472, 0x474, 0x476, 0x478, 0x47a, 0x47c, 0x47e, 0x480, 0x48a,
+ 0x48c, 0x48e, 0x490, 0x492, 0x494, 0x496, 0x498, 0x49a, 0x49c,
+ 0x49e, 0x4a0, 0x4a2, 0x4a4, 0x4a6, 0x4a8, 0x4aa, 0x4ac, 0x4ae,
+ 0x4b0, 0x4b2, 0x4b4, 0x4b6, 0x4b8, 0x4ba, 0x4bc, 0x4be, 0x4c0,
+ 0x4c1, 0x4c3, 0x4c5, 0x4c7, 0x4c9, 0x4cb, 0x4cd, 0x4d0, 0x4d2,
+ 0x4d4, 0x4d6, 0x4d8, 0x4da, 0x4dc, 0x4de, 0x4e0, 0x4e2, 0x4e4,
+ 0x4e6, 0x4e8, 0x4ea, 0x4ec, 0x4ee, 0x4f0, 0x4f2, 0x4f4, 0x4f6,
+ 0x4f8, 0x4fa, 0x4fc, 0x4fe, 0x500, 0x502, 0x504, 0x506, 0x508,
+ 0x50a, 0x50c, 0x50e, 0x510, 0x512, 0x514, 0x516, 0x518, 0x51a,
+ 0x51c, 0x51e, 0x520, 0x522, 0x524, 0x526, 0x528, 0x52a, 0x52c,
+ 0x52e, 0x10c7, 0x10cd, 0x1e00, 0x1e02, 0x1e04, 0x1e06, 0x1e08, 0x1e0a,
+ 0x1e0c, 0x1e0e, 0x1e10, 0x1e12, 0x1e14, 0x1e16, 0x1e18, 0x1e1a, 0x1e1c,
+ 0x1e1e, 0x1e20, 0x1e22, 0x1e24, 0x1e26, 0x1e28, 0x1e2a, 0x1e2c, 0x1e2e,
+ 0x1e30, 0x1e32, 0x1e34, 0x1e36, 0x1e38, 0x1e3a, 0x1e3c, 0x1e3e, 0x1e40,
+ 0x1e42, 0x1e44, 0x1e46, 0x1e48, 0x1e4a, 0x1e4c, 0x1e4e, 0x1e50, 0x1e52,
+ 0x1e54, 0x1e56, 0x1e58, 0x1e5a, 0x1e5c, 0x1e5e, 0x1e60, 0x1e62, 0x1e64,
+ 0x1e66, 0x1e68, 0x1e6a, 0x1e6c, 0x1e6e, 0x1e70, 0x1e72, 0x1e74, 0x1e76,
+ 0x1e78, 0x1e7a, 0x1e7c, 0x1e7e, 0x1e80, 0x1e82, 0x1e84, 0x1e86, 0x1e88,
+ 0x1e8a, 0x1e8c, 0x1e8e, 0x1e90, 0x1e92, 0x1e94, 0x1e9e, 0x1ea0, 0x1ea2,
+ 0x1ea4, 0x1ea6, 0x1ea8, 0x1eaa, 0x1eac, 0x1eae, 0x1eb0, 0x1eb2, 0x1eb4,
+ 0x1eb6, 0x1eb8, 0x1eba, 0x1ebc, 0x1ebe, 0x1ec0, 0x1ec2, 0x1ec4, 0x1ec6,
+ 0x1ec8, 0x1eca, 0x1ecc, 0x1ece, 0x1ed0, 0x1ed2, 0x1ed4, 0x1ed6, 0x1ed8,
+ 0x1eda, 0x1edc, 0x1ede, 0x1ee0, 0x1ee2, 0x1ee4, 0x1ee6, 0x1ee8, 0x1eea,
+ 0x1eec, 0x1eee, 0x1ef0, 0x1ef2, 0x1ef4, 0x1ef6, 0x1ef8, 0x1efa, 0x1efc,
+ 0x1efe, 0x1f59, 0x1f5b, 0x1f5d, 0x1f5f, 0x2102, 0x2107, 0x2115, 0x2124,
+ 0x2126, 0x2128, 0x213e, 0x213f, 0x2145, 0x2183, 0x2c60, 0x2c67, 0x2c69,
+ 0x2c6b, 0x2c72, 0x2c75, 0x2c82, 0x2c84, 0x2c86, 0x2c88, 0x2c8a, 0x2c8c,
+ 0x2c8e, 0x2c90, 0x2c92, 0x2c94, 0x2c96, 0x2c98, 0x2c9a, 0x2c9c, 0x2c9e,
+ 0x2ca0, 0x2ca2, 0x2ca4, 0x2ca6, 0x2ca8, 0x2caa, 0x2cac, 0x2cae, 0x2cb0,
+ 0x2cb2, 0x2cb4, 0x2cb6, 0x2cb8, 0x2cba, 0x2cbc, 0x2cbe, 0x2cc0, 0x2cc2,
+ 0x2cc4, 0x2cc6, 0x2cc8, 0x2cca, 0x2ccc, 0x2cce, 0x2cd0, 0x2cd2, 0x2cd4,
+ 0x2cd6, 0x2cd8, 0x2cda, 0x2cdc, 0x2cde, 0x2ce0, 0x2ce2, 0x2ceb, 0x2ced,
+ 0x2cf2, 0xa640, 0xa642, 0xa644, 0xa646, 0xa648, 0xa64a, 0xa64c, 0xa64e,
+ 0xa650, 0xa652, 0xa654, 0xa656, 0xa658, 0xa65a, 0xa65c, 0xa65e, 0xa660,
+ 0xa662, 0xa664, 0xa666, 0xa668, 0xa66a, 0xa66c, 0xa680, 0xa682, 0xa684,
+ 0xa686, 0xa688, 0xa68a, 0xa68c, 0xa68e, 0xa690, 0xa692, 0xa694, 0xa696,
+ 0xa698, 0xa69a, 0xa722, 0xa724, 0xa726, 0xa728, 0xa72a, 0xa72c, 0xa72e,
+ 0xa732, 0xa734, 0xa736, 0xa738, 0xa73a, 0xa73c, 0xa73e, 0xa740, 0xa742,
+ 0xa744, 0xa746, 0xa748, 0xa74a, 0xa74c, 0xa74e, 0xa750, 0xa752, 0xa754,
+ 0xa756, 0xa758, 0xa75a, 0xa75c, 0xa75e, 0xa760, 0xa762, 0xa764, 0xa766,
+ 0xa768, 0xa76a, 0xa76c, 0xa76e, 0xa779, 0xa77b, 0xa77d, 0xa77e, 0xa780,
+ 0xa782, 0xa784, 0xa786, 0xa78b, 0xa78d, 0xa790, 0xa792, 0xa796, 0xa798,
+ 0xa79a, 0xa79c, 0xa79e, 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7b6
#if TCL_UTF_MAX > 4
,0x1d49c, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d504, 0x1d505, 0x1d538,
0x1d539, 0x1d546, 0x1d7ca
@@ -569,141 +604,163 @@ static const chr upperCharTable[] = {
*/
static const crange graphRangeTable[] = {
- {0x21, 0x7e}, {0xa1, 0xac}, {0xae, 0x377}, {0x37a, 0x37e},
- {0x384, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x527}, {0x531, 0x556},
- {0x559, 0x55f}, {0x561, 0x587}, {0x591, 0x5c7}, {0x5d0, 0x5ea},
- {0x5f0, 0x5f4}, {0x606, 0x61b}, {0x61e, 0x6dc}, {0x6de, 0x70d},
- {0x710, 0x74a}, {0x74d, 0x7b1}, {0x7c0, 0x7fa}, {0x800, 0x82d},
- {0x830, 0x83e}, {0x840, 0x85b}, {0x8a2, 0x8ac}, {0x8e4, 0x8fe},
- {0x900, 0x977}, {0x979, 0x97f}, {0x981, 0x983}, {0x985, 0x98c},
- {0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9bc, 0x9c4},
- {0x9cb, 0x9ce}, {0x9df, 0x9e3}, {0x9e6, 0x9fb}, {0xa01, 0xa03},
- {0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa3e, 0xa42},
- {0xa4b, 0xa4d}, {0xa59, 0xa5c}, {0xa66, 0xa75}, {0xa81, 0xa83},
- {0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8}, {0xaaa, 0xab0},
- {0xab5, 0xab9}, {0xabc, 0xac5}, {0xac7, 0xac9}, {0xacb, 0xacd},
- {0xae0, 0xae3}, {0xae6, 0xaf1}, {0xb01, 0xb03}, {0xb05, 0xb0c},
- {0xb13, 0xb28}, {0xb2a, 0xb30}, {0xb35, 0xb39}, {0xb3c, 0xb44},
- {0xb4b, 0xb4d}, {0xb5f, 0xb63}, {0xb66, 0xb77}, {0xb85, 0xb8a},
- {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa}, {0xbae, 0xbb9},
- {0xbbe, 0xbc2}, {0xbc6, 0xbc8}, {0xbca, 0xbcd}, {0xbe6, 0xbfa},
- {0xc01, 0xc03}, {0xc05, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28},
- {0xc2a, 0xc33}, {0xc35, 0xc39}, {0xc3d, 0xc44}, {0xc46, 0xc48},
- {0xc4a, 0xc4d}, {0xc60, 0xc63}, {0xc66, 0xc6f}, {0xc78, 0xc7f},
- {0xc85, 0xc8c}, {0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3},
- {0xcb5, 0xcb9}, {0xcbc, 0xcc4}, {0xcc6, 0xcc8}, {0xcca, 0xccd},
- {0xce0, 0xce3}, {0xce6, 0xcef}, {0xd05, 0xd0c}, {0xd0e, 0xd10},
+ {0x21, 0x7e}, {0xa1, 0xac}, {0xae, 0x377}, {0x37a, 0x37f},
+ {0x384, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x52f}, {0x531, 0x556},
+ {0x559, 0x55f}, {0x561, 0x587}, {0x58d, 0x58f}, {0x591, 0x5c7},
+ {0x5d0, 0x5ea}, {0x5f0, 0x5f4}, {0x606, 0x61b}, {0x61e, 0x6dc},
+ {0x6de, 0x70d}, {0x710, 0x74a}, {0x74d, 0x7b1}, {0x7c0, 0x7fa},
+ {0x800, 0x82d}, {0x830, 0x83e}, {0x840, 0x85b}, {0x8a0, 0x8b4},
+ {0x8e3, 0x983}, {0x985, 0x98c}, {0x993, 0x9a8}, {0x9aa, 0x9b0},
+ {0x9b6, 0x9b9}, {0x9bc, 0x9c4}, {0x9cb, 0x9ce}, {0x9df, 0x9e3},
+ {0x9e6, 0x9fb}, {0xa01, 0xa03}, {0xa05, 0xa0a}, {0xa13, 0xa28},
+ {0xa2a, 0xa30}, {0xa3e, 0xa42}, {0xa4b, 0xa4d}, {0xa59, 0xa5c},
+ {0xa66, 0xa75}, {0xa81, 0xa83}, {0xa85, 0xa8d}, {0xa8f, 0xa91},
+ {0xa93, 0xaa8}, {0xaaa, 0xab0}, {0xab5, 0xab9}, {0xabc, 0xac5},
+ {0xac7, 0xac9}, {0xacb, 0xacd}, {0xae0, 0xae3}, {0xae6, 0xaf1},
+ {0xb01, 0xb03}, {0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30},
+ {0xb35, 0xb39}, {0xb3c, 0xb44}, {0xb4b, 0xb4d}, {0xb5f, 0xb63},
+ {0xb66, 0xb77}, {0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95},
+ {0xba8, 0xbaa}, {0xbae, 0xbb9}, {0xbbe, 0xbc2}, {0xbc6, 0xbc8},
+ {0xbca, 0xbcd}, {0xbe6, 0xbfa}, {0xc00, 0xc03}, {0xc05, 0xc0c},
+ {0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc39}, {0xc3d, 0xc44},
+ {0xc46, 0xc48}, {0xc4a, 0xc4d}, {0xc58, 0xc5a}, {0xc60, 0xc63},
+ {0xc66, 0xc6f}, {0xc78, 0xc7f}, {0xc81, 0xc83}, {0xc85, 0xc8c},
+ {0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9},
+ {0xcbc, 0xcc4}, {0xcc6, 0xcc8}, {0xcca, 0xccd}, {0xce0, 0xce3},
+ {0xce6, 0xcef}, {0xd01, 0xd03}, {0xd05, 0xd0c}, {0xd0e, 0xd10},
{0xd12, 0xd3a}, {0xd3d, 0xd44}, {0xd46, 0xd48}, {0xd4a, 0xd4e},
- {0xd60, 0xd63}, {0xd66, 0xd75}, {0xd79, 0xd7f}, {0xd85, 0xd96},
+ {0xd5f, 0xd63}, {0xd66, 0xd75}, {0xd79, 0xd7f}, {0xd85, 0xd96},
{0xd9a, 0xdb1}, {0xdb3, 0xdbb}, {0xdc0, 0xdc6}, {0xdcf, 0xdd4},
- {0xdd8, 0xddf}, {0xdf2, 0xdf4}, {0xe01, 0xe3a}, {0xe3f, 0xe5b},
- {0xe94, 0xe97}, {0xe99, 0xe9f}, {0xea1, 0xea3}, {0xead, 0xeb9},
- {0xebb, 0xebd}, {0xec0, 0xec4}, {0xec8, 0xecd}, {0xed0, 0xed9},
- {0xedc, 0xedf}, {0xf00, 0xf47}, {0xf49, 0xf6c}, {0xf71, 0xf97},
- {0xf99, 0xfbc}, {0xfbe, 0xfcc}, {0xfce, 0xfda}, {0x1000, 0x10c5},
- {0x10d0, 0x1248}, {0x124a, 0x124d}, {0x1250, 0x1256}, {0x125a, 0x125d},
- {0x1260, 0x1288}, {0x128a, 0x128d}, {0x1290, 0x12b0}, {0x12b2, 0x12b5},
- {0x12b8, 0x12be}, {0x12c2, 0x12c5}, {0x12c8, 0x12d6}, {0x12d8, 0x1310},
- {0x1312, 0x1315}, {0x1318, 0x135a}, {0x135d, 0x137c}, {0x1380, 0x1399},
- {0x13a0, 0x13f4}, {0x1400, 0x167f}, {0x1681, 0x169c}, {0x16a0, 0x16f0},
- {0x1700, 0x170c}, {0x170e, 0x1714}, {0x1720, 0x1736}, {0x1740, 0x1753},
- {0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17dd}, {0x17e0, 0x17e9},
- {0x17f0, 0x17f9}, {0x1800, 0x180d}, {0x1810, 0x1819}, {0x1820, 0x1877},
- {0x1880, 0x18aa}, {0x18b0, 0x18f5}, {0x1900, 0x191c}, {0x1920, 0x192b},
- {0x1930, 0x193b}, {0x1944, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab},
- {0x19b0, 0x19c9}, {0x19d0, 0x19da}, {0x19de, 0x1a1b}, {0x1a1e, 0x1a5e},
- {0x1a60, 0x1a7c}, {0x1a7f, 0x1a89}, {0x1a90, 0x1a99}, {0x1aa0, 0x1aad},
- {0x1b00, 0x1b4b}, {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3}, {0x1bfc, 0x1c37},
- {0x1c3b, 0x1c49}, {0x1c4d, 0x1c7f}, {0x1cc0, 0x1cc7}, {0x1cd0, 0x1cf6},
- {0x1d00, 0x1de6}, {0x1dfc, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45},
- {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4},
- {0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef},
- {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe}, {0x2010, 0x2027}, {0x2030, 0x205e},
- {0x2074, 0x208e}, {0x2090, 0x209c}, {0x20a0, 0x20ba}, {0x20d0, 0x20f0},
- {0x2100, 0x2189}, {0x2190, 0x23f3}, {0x2400, 0x2426}, {0x2440, 0x244a},
- {0x2460, 0x26ff}, {0x2701, 0x2b4c}, {0x2b50, 0x2b59}, {0x2c00, 0x2c2e},
- {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3}, {0x2cf9, 0x2d25}, {0x2d30, 0x2d67},
- {0x2d7f, 0x2d96}, {0x2da0, 0x2da6}, {0x2da8, 0x2dae}, {0x2db0, 0x2db6},
- {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6},
- {0x2dd8, 0x2dde}, {0x2de0, 0x2e3b}, {0x2e80, 0x2e99}, {0x2e9b, 0x2ef3},
- {0x2f00, 0x2fd5}, {0x2ff0, 0x2ffb}, {0x3001, 0x303f}, {0x3041, 0x3096},
- {0x3099, 0x30ff}, {0x3105, 0x312d}, {0x3131, 0x318e}, {0x3190, 0x31ba},
- {0x31c0, 0x31e3}, {0x31f0, 0x321e}, {0x3220, 0x32fe}, {0x3300, 0x4db5},
- {0x4dc0, 0x9fcc}, {0xa000, 0xa48c}, {0xa490, 0xa4c6}, {0xa4d0, 0xa62b},
- {0xa640, 0xa697}, {0xa69f, 0xa6f7}, {0xa700, 0xa78e}, {0xa790, 0xa793},
- {0xa7a0, 0xa7aa}, {0xa7f8, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877},
- {0xa880, 0xa8c4}, {0xa8ce, 0xa8d9}, {0xa8e0, 0xa8fb}, {0xa900, 0xa953},
- {0xa95f, 0xa97c}, {0xa980, 0xa9cd}, {0xa9cf, 0xa9d9}, {0xaa00, 0xaa36},
- {0xaa40, 0xaa4d}, {0xaa50, 0xaa59}, {0xaa5c, 0xaa7b}, {0xaa80, 0xaac2},
+ {0xdd8, 0xddf}, {0xde6, 0xdef}, {0xdf2, 0xdf4}, {0xe01, 0xe3a},
+ {0xe3f, 0xe5b}, {0xe94, 0xe97}, {0xe99, 0xe9f}, {0xea1, 0xea3},
+ {0xead, 0xeb9}, {0xebb, 0xebd}, {0xec0, 0xec4}, {0xec8, 0xecd},
+ {0xed0, 0xed9}, {0xedc, 0xedf}, {0xf00, 0xf47}, {0xf49, 0xf6c},
+ {0xf71, 0xf97}, {0xf99, 0xfbc}, {0xfbe, 0xfcc}, {0xfce, 0xfda},
+ {0x1000, 0x10c5}, {0x10d0, 0x1248}, {0x124a, 0x124d}, {0x1250, 0x1256},
+ {0x125a, 0x125d}, {0x1260, 0x1288}, {0x128a, 0x128d}, {0x1290, 0x12b0},
+ {0x12b2, 0x12b5}, {0x12b8, 0x12be}, {0x12c2, 0x12c5}, {0x12c8, 0x12d6},
+ {0x12d8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135a}, {0x135d, 0x137c},
+ {0x1380, 0x1399}, {0x13a0, 0x13f5}, {0x13f8, 0x13fd}, {0x1400, 0x167f},
+ {0x1681, 0x169c}, {0x16a0, 0x16f8}, {0x1700, 0x170c}, {0x170e, 0x1714},
+ {0x1720, 0x1736}, {0x1740, 0x1753}, {0x1760, 0x176c}, {0x176e, 0x1770},
+ {0x1780, 0x17dd}, {0x17e0, 0x17e9}, {0x17f0, 0x17f9}, {0x1800, 0x180d},
+ {0x1810, 0x1819}, {0x1820, 0x1877}, {0x1880, 0x18aa}, {0x18b0, 0x18f5},
+ {0x1900, 0x191e}, {0x1920, 0x192b}, {0x1930, 0x193b}, {0x1944, 0x196d},
+ {0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19b0, 0x19c9}, {0x19d0, 0x19da},
+ {0x19de, 0x1a1b}, {0x1a1e, 0x1a5e}, {0x1a60, 0x1a7c}, {0x1a7f, 0x1a89},
+ {0x1a90, 0x1a99}, {0x1aa0, 0x1aad}, {0x1ab0, 0x1abe}, {0x1b00, 0x1b4b},
+ {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3}, {0x1bfc, 0x1c37}, {0x1c3b, 0x1c49},
+ {0x1c4d, 0x1c7f}, {0x1cc0, 0x1cc7}, {0x1cd0, 0x1cf6}, {0x1d00, 0x1df5},
+ {0x1dfc, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d},
+ {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fc4},
+ {0x1fc6, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef}, {0x1ff2, 0x1ff4},
+ {0x1ff6, 0x1ffe}, {0x2010, 0x2027}, {0x2030, 0x205e}, {0x2074, 0x208e},
+ {0x2090, 0x209c}, {0x20a0, 0x20be}, {0x20d0, 0x20f0}, {0x2100, 0x218b},
+ {0x2190, 0x23fa}, {0x2400, 0x2426}, {0x2440, 0x244a}, {0x2460, 0x2b73},
+ {0x2b76, 0x2b95}, {0x2b98, 0x2bb9}, {0x2bbd, 0x2bc8}, {0x2bca, 0x2bd1},
+ {0x2bec, 0x2bef}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3},
+ {0x2cf9, 0x2d25}, {0x2d30, 0x2d67}, {0x2d7f, 0x2d96}, {0x2da0, 0x2da6},
+ {0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6},
+ {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x2de0, 0x2e42},
+ {0x2e80, 0x2e99}, {0x2e9b, 0x2ef3}, {0x2f00, 0x2fd5}, {0x2ff0, 0x2ffb},
+ {0x3001, 0x303f}, {0x3041, 0x3096}, {0x3099, 0x30ff}, {0x3105, 0x312d},
+ {0x3131, 0x318e}, {0x3190, 0x31ba}, {0x31c0, 0x31e3}, {0x31f0, 0x321e},
+ {0x3220, 0x32fe}, {0x3300, 0x4db5}, {0x4dc0, 0x9fd5}, {0xa000, 0xa48c},
+ {0xa490, 0xa4c6}, {0xa4d0, 0xa62b}, {0xa640, 0xa6f7}, {0xa700, 0xa7ad},
+ {0xa7b0, 0xa7b7}, {0xa7f7, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877},
+ {0xa880, 0xa8c4}, {0xa8ce, 0xa8d9}, {0xa8e0, 0xa8fd}, {0xa900, 0xa953},
+ {0xa95f, 0xa97c}, {0xa980, 0xa9cd}, {0xa9cf, 0xa9d9}, {0xa9de, 0xa9fe},
+ {0xaa00, 0xaa36}, {0xaa40, 0xaa4d}, {0xaa50, 0xaa59}, {0xaa5c, 0xaac2},
{0xaadb, 0xaaf6}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16},
- {0xab20, 0xab26}, {0xab28, 0xab2e}, {0xabc0, 0xabed}, {0xabf0, 0xabf9},
- {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xf900, 0xfa6d},
- {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1d, 0xfb36},
- {0xfb38, 0xfb3c}, {0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f}, {0xfd50, 0xfd8f},
- {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfd}, {0xfe00, 0xfe19}, {0xfe20, 0xfe26},
- {0xfe30, 0xfe52}, {0xfe54, 0xfe66}, {0xfe68, 0xfe6b}, {0xfe70, 0xfe74},
+ {0xab20, 0xab26}, {0xab28, 0xab2e}, {0xab30, 0xab65}, {0xab70, 0xabed},
+ {0xabf0, 0xabf9}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb},
+ {0xdc00, 0xdc3e}, {0xdc40, 0xdc7e}, {0xdc80, 0xdcbe}, {0xdcc0, 0xdcfe},
+ {0xdd00, 0xdd3e}, {0xdd40, 0xdd7e}, {0xdd80, 0xddbe}, {0xddc0, 0xddfe},
+ {0xde00, 0xde3e}, {0xde40, 0xde7e}, {0xde80, 0xdebe}, {0xdec0, 0xdefe},
+ {0xdf00, 0xdf3e}, {0xdf40, 0xdf7e}, {0xdf80, 0xdfbe}, {0xdfc0, 0xdffe},
+ {0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
+ {0xfb1d, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f},
+ {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfd}, {0xfe00, 0xfe19},
+ {0xfe20, 0xfe52}, {0xfe54, 0xfe66}, {0xfe68, 0xfe6b}, {0xfe70, 0xfe74},
{0xfe76, 0xfefc}, {0xff01, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf},
{0xffd2, 0xffd7}, {0xffda, 0xffdc}, {0xffe0, 0xffe6}, {0xffe8, 0xffee}
#if TCL_UTF_MAX > 4
,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d},
{0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10100, 0x10102}, {0x10107, 0x10133},
- {0x10137, 0x1018a}, {0x10190, 0x1019b}, {0x101d0, 0x101fd}, {0x10280, 0x1029c},
- {0x102a0, 0x102d0}, {0x10300, 0x1031e}, {0x10320, 0x10323}, {0x10330, 0x1034a},
- {0x10380, 0x1039d}, {0x1039f, 0x103c3}, {0x103c8, 0x103d5}, {0x10400, 0x1049d},
- {0x104a0, 0x104a9}, {0x10800, 0x10805}, {0x1080a, 0x10835}, {0x1083f, 0x10855},
- {0x10857, 0x1085f}, {0x10900, 0x1091b}, {0x1091f, 0x10939}, {0x10980, 0x109b7},
- {0x10a00, 0x10a03}, {0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33},
- {0x10a38, 0x10a3a}, {0x10a3f, 0x10a47}, {0x10a50, 0x10a58}, {0x10a60, 0x10a7f},
- {0x10b00, 0x10b35}, {0x10b39, 0x10b55}, {0x10b58, 0x10b72}, {0x10b78, 0x10b7f},
- {0x10c00, 0x10c48}, {0x10e60, 0x10e7e}, {0x11000, 0x1104d}, {0x11052, 0x1106f},
- {0x11080, 0x110bc}, {0x110be, 0x110c1}, {0x110d0, 0x110e8}, {0x110f0, 0x110f9},
- {0x11100, 0x11134}, {0x11136, 0x11143}, {0x11180, 0x111c8}, {0x111d0, 0x111d9},
- {0x11680, 0x116b7}, {0x116c0, 0x116c9}, {0x12000, 0x1236e}, {0x12400, 0x12462},
- {0x12470, 0x12473}, {0x13000, 0x1342e}, {0x16800, 0x16a38}, {0x16f00, 0x16f44},
- {0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f}, {0x1d000, 0x1d0f5}, {0x1d100, 0x1d126},
- {0x1d129, 0x1d172}, {0x1d17b, 0x1d1dd}, {0x1d200, 0x1d245}, {0x1d300, 0x1d356},
- {0x1d360, 0x1d371}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac},
- {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a},
- {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e},
- {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb},
- {0x1d7ce, 0x1d7ff}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32},
- {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72},
- {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b},
- {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b},
- {0x1f030, 0x1f093}, {0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0be}, {0x1f0c1, 0x1f0cf},
- {0x1f0d1, 0x1f0df}, {0x1f100, 0x1f10a}, {0x1f110, 0x1f12e}, {0x1f130, 0x1f16b},
- {0x1f170, 0x1f19a}, {0x1f1e6, 0x1f202}, {0x1f210, 0x1f23a}, {0x1f240, 0x1f248},
- {0x1f300, 0x1f320}, {0x1f330, 0x1f335}, {0x1f337, 0x1f37c}, {0x1f380, 0x1f393},
- {0x1f3a0, 0x1f3c4}, {0x1f3c6, 0x1f3ca}, {0x1f3e0, 0x1f3f0}, {0x1f400, 0x1f43e},
- {0x1f442, 0x1f4f7}, {0x1f4f9, 0x1f4fc}, {0x1f500, 0x1f53d}, {0x1f540, 0x1f543},
- {0x1f550, 0x1f567}, {0x1f5fb, 0x1f640}, {0x1f645, 0x1f64f}, {0x1f680, 0x1f6c5},
- {0x1f700, 0x1f773}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d},
- {0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef}
+ {0x10137, 0x1018c}, {0x10190, 0x1019b}, {0x101d0, 0x101fd}, {0x10280, 0x1029c},
+ {0x102a0, 0x102d0}, {0x102e0, 0x102fb}, {0x10300, 0x10323}, {0x10330, 0x1034a},
+ {0x10350, 0x1037a}, {0x10380, 0x1039d}, {0x1039f, 0x103c3}, {0x103c8, 0x103d5},
+ {0x10400, 0x1049d}, {0x104a0, 0x104a9}, {0x10500, 0x10527}, {0x10530, 0x10563},
+ {0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10800, 0x10805},
+ {0x1080a, 0x10835}, {0x1083f, 0x10855}, {0x10857, 0x1089e}, {0x108a7, 0x108af},
+ {0x108e0, 0x108f2}, {0x108fb, 0x1091b}, {0x1091f, 0x10939}, {0x10980, 0x109b7},
+ {0x109bc, 0x109cf}, {0x109d2, 0x10a03}, {0x10a0c, 0x10a13}, {0x10a15, 0x10a17},
+ {0x10a19, 0x10a33}, {0x10a38, 0x10a3a}, {0x10a3f, 0x10a47}, {0x10a50, 0x10a58},
+ {0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6}, {0x10aeb, 0x10af6}, {0x10b00, 0x10b35},
+ {0x10b39, 0x10b55}, {0x10b58, 0x10b72}, {0x10b78, 0x10b91}, {0x10b99, 0x10b9c},
+ {0x10ba9, 0x10baf}, {0x10c00, 0x10c48}, {0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2},
+ {0x10cfa, 0x10cff}, {0x10e60, 0x10e7e}, {0x11000, 0x1104d}, {0x11052, 0x1106f},
+ {0x1107f, 0x110bc}, {0x110be, 0x110c1}, {0x110d0, 0x110e8}, {0x110f0, 0x110f9},
+ {0x11100, 0x11134}, {0x11136, 0x11143}, {0x11150, 0x11176}, {0x11180, 0x111cd},
+ {0x111d0, 0x111df}, {0x111e1, 0x111f4}, {0x11200, 0x11211}, {0x11213, 0x1123d},
+ {0x11280, 0x11286}, {0x1128a, 0x1128d}, {0x1128f, 0x1129d}, {0x1129f, 0x112a9},
+ {0x112b0, 0x112ea}, {0x112f0, 0x112f9}, {0x11300, 0x11303}, {0x11305, 0x1130c},
+ {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339}, {0x1133c, 0x11344},
+ {0x1134b, 0x1134d}, {0x1135d, 0x11363}, {0x11366, 0x1136c}, {0x11370, 0x11374},
+ {0x11480, 0x114c7}, {0x114d0, 0x114d9}, {0x11580, 0x115b5}, {0x115b8, 0x115dd},
+ {0x11600, 0x11644}, {0x11650, 0x11659}, {0x11680, 0x116b7}, {0x116c0, 0x116c9},
+ {0x11700, 0x11719}, {0x1171d, 0x1172b}, {0x11730, 0x1173f}, {0x118a0, 0x118f2},
+ {0x11ac0, 0x11af8}, {0x12000, 0x12399}, {0x12400, 0x1246e}, {0x12470, 0x12474},
+ {0x12480, 0x12543}, {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38},
+ {0x16a40, 0x16a5e}, {0x16a60, 0x16a69}, {0x16ad0, 0x16aed}, {0x16af0, 0x16af5},
+ {0x16b00, 0x16b45}, {0x16b50, 0x16b59}, {0x16b5b, 0x16b61}, {0x16b63, 0x16b77},
+ {0x16b7d, 0x16b8f}, {0x16f00, 0x16f44}, {0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f},
+ {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99},
+ {0x1bc9c, 0x1bc9f}, {0x1d000, 0x1d0f5}, {0x1d100, 0x1d126}, {0x1d129, 0x1d172},
+ {0x1d17b, 0x1d1e8}, {0x1d200, 0x1d245}, {0x1d300, 0x1d356}, {0x1d360, 0x1d371},
+ {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9},
+ {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514},
+ {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544},
+ {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb}, {0x1d7ce, 0x1da8b},
+ {0x1da9b, 0x1da9f}, {0x1daa1, 0x1daaf}, {0x1e800, 0x1e8c4}, {0x1e8c7, 0x1e8d6},
+ {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37},
+ {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77},
+ {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3},
+ {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b}, {0x1f030, 0x1f093},
+ {0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf}, {0x1f0d1, 0x1f0f5},
+ {0x1f100, 0x1f10c}, {0x1f110, 0x1f12e}, {0x1f130, 0x1f16b}, {0x1f170, 0x1f19a},
+ {0x1f1e6, 0x1f202}, {0x1f210, 0x1f23a}, {0x1f240, 0x1f248}, {0x1f300, 0x1f579},
+ {0x1f57b, 0x1f5a3}, {0x1f5a5, 0x1f6d0}, {0x1f6e0, 0x1f6ec}, {0x1f6f0, 0x1f6f3},
+ {0x1f700, 0x1f773}, {0x1f780, 0x1f7d4}, {0x1f800, 0x1f80b}, {0x1f810, 0x1f847},
+ {0x1f850, 0x1f859}, {0x1f860, 0x1f887}, {0x1f890, 0x1f8ad}, {0x1f910, 0x1f918},
+ {0x1f980, 0x1f984}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d},
+ {0x2b820, 0x2cea1}, {0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef}
#endif
};
#define NUM_GRAPH_RANGE (sizeof(graphRangeTable)/sizeof(crange))
static const chr graphCharTable[] = {
- 0x38c, 0x589, 0x58a, 0x58f, 0x85e, 0x8a0, 0x98f, 0x990, 0x9b2,
- 0x9c7, 0x9c8, 0x9d7, 0x9dc, 0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33,
- 0xa35, 0xa36, 0xa38, 0xa39, 0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e,
- 0xab2, 0xab3, 0xad0, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb47, 0xb48,
- 0xb56, 0xb57, 0xb5c, 0xb5d, 0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c,
- 0xb9e, 0xb9f, 0xba3, 0xba4, 0xbd0, 0xbd7, 0xc55, 0xc56, 0xc58,
- 0xc59, 0xc82, 0xc83, 0xcd5, 0xcd6, 0xcde, 0xcf1, 0xcf2, 0xd02,
- 0xd03, 0xd57, 0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, 0xe81, 0xe82,
- 0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab,
- 0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940, 0x1f59,
- 0x1f5b, 0x1f5d, 0x2070, 0x2071, 0x2d27, 0x2d2d, 0x2d6f, 0x2d70, 0xa9de,
- 0xa9df, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfffc, 0xfffd
+ 0x38c, 0x589, 0x58a, 0x85e, 0x98f, 0x990, 0x9b2, 0x9c7, 0x9c8,
+ 0x9d7, 0x9dc, 0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36,
+ 0xa38, 0xa39, 0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e, 0xab2, 0xab3,
+ 0xad0, 0xaf9, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb47, 0xb48, 0xb56,
+ 0xb57, 0xb5c, 0xb5d, 0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e,
+ 0xb9f, 0xba3, 0xba4, 0xbd0, 0xbd7, 0xc55, 0xc56, 0xcd5, 0xcd6,
+ 0xcde, 0xcf1, 0xcf2, 0xd57, 0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6,
+ 0xe81, 0xe82, 0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7,
+ 0xeaa, 0xeab, 0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773,
+ 0x1940, 0x1cf8, 0x1cf9, 0x1f59, 0x1f5b, 0x1f5d, 0x2070, 0x2071, 0x2d27,
+ 0x2d2d, 0x2d6f, 0x2d70, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfffc,
+ 0xfffd
#if TCL_UTF_MAX > 4
- ,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x1093f, 0x109be, 0x109bf,
- 0x10a05, 0x10a06, 0x1b000, 0x1b001, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6,
- 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42,
- 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b,
- 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e, 0x1eef0, 0x1eef1, 0x1f250,
- 0x1f251, 0x1f440
+ ,0x1003c, 0x1003d, 0x101a0, 0x1056f, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4,
+ 0x108f5, 0x1093f, 0x10a05, 0x10a06, 0x11288, 0x1130f, 0x11310, 0x11332, 0x11333,
+ 0x11347, 0x11348, 0x11350, 0x11357, 0x118ff, 0x16a6e, 0x16a6f, 0x1b000, 0x1b001,
+ 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22,
+ 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51,
+ 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62,
+ 0x1ee64, 0x1ee7e, 0x1eef0, 0x1eef1, 0x1f250, 0x1f251, 0x1f9c0
#endif
};
diff --git a/generic/regc_nfa.c b/generic/regc_nfa.c
index 42489dd..088c6c0 100644
--- a/generic/regc_nfa.c
+++ b/generic/regc_nfa.c
@@ -34,6 +34,9 @@
#define NISERR() VISERR(nfa->v)
#define NERR(e) VERR(nfa->v, (e))
+#define STACK_TOO_DEEP(x) (0)
+#define CANCEL_REQUESTED(x) (0)
+#define REG_CANCEL 777
/*
- newnfa - set up an NFA
@@ -49,6 +52,7 @@ newnfa(
nfa = (struct nfa *) MALLOC(sizeof(struct nfa));
if (nfa == NULL) {
+ ERR(REG_ESPACE);
return NULL;
}
@@ -58,7 +62,6 @@ newnfa(
nfa->nstates = 0;
nfa->cm = cm;
nfa->v = v;
- nfa->size = 0;
nfa->bos[0] = nfa->bos[1] = COLORLESS;
nfa->eos[0] = nfa->eos[1] = COLORLESS;
nfa->parent = parent; /* Precedes newfstate so parent is valid. */
@@ -86,61 +89,6 @@ newnfa(
}
/*
- - TooManyStates - checks if the max states exceeds the compile-time value
- ^ static int TooManyStates(struct nfa *);
- */
-static int
-TooManyStates(
- struct nfa *nfa)
-{
- struct nfa *parent = nfa->parent;
- size_t sz = nfa->size;
-
- while (parent != NULL) {
- sz = parent->size;
- parent = parent->parent;
- }
- if (sz > REG_MAX_STATES) {
- return 1;
- }
- return 0;
-}
-
-/*
- - IncrementSize - increases the tracked size of the NFA and its parents.
- ^ static void IncrementSize(struct nfa *);
- */
-static void
-IncrementSize(
- struct nfa *nfa)
-{
- struct nfa *parent = nfa->parent;
-
- nfa->size++;
- while (parent != NULL) {
- parent->size++;
- parent = parent->parent;
- }
-}
-
-/*
- - DecrementSize - increases the tracked size of the NFA and its parents.
- ^ static void DecrementSize(struct nfa *);
- */
-static void
-DecrementSize(
- struct nfa *nfa)
-{
- struct nfa *parent = nfa->parent;
-
- nfa->size--;
- while (parent != NULL) {
- parent->size--;
- parent = parent->parent;
- }
-}
-
-/*
- freenfa - free an entire NFA
^ static void freenfa(struct nfa *);
*/
@@ -176,20 +124,20 @@ newstate(
{
struct state *s;
- if (TooManyStates(nfa)) {
- /* XXX: add specific error for this */
- NERR(REG_ETOOBIG);
- return NULL;
- }
if (nfa->free != NULL) {
s = nfa->free;
nfa->free = s->next;
} else {
+ if (nfa->v->spaceused >= REG_MAX_COMPILE_SPACE) {
+ NERR(REG_ETOOBIG);
+ return NULL;
+ }
s = (struct state *) MALLOC(sizeof(struct state));
if (s == NULL) {
NERR(REG_ESPACE);
return NULL;
}
+ nfa->v->spaceused += sizeof(struct state);
s->oas.next = NULL;
s->free = NULL;
s->noas = 0;
@@ -213,12 +161,6 @@ newstate(
}
s->prev = nfa->slast;
nfa->slast = s;
-
- /*
- * Track the current size and the parent size.
- */
-
- IncrementSize(nfa);
return s;
}
@@ -289,7 +231,6 @@ freestate(
s->prev = NULL;
s->next = nfa->free; /* don't delete it, put it on the free list */
nfa->free = s;
- DecrementSize(nfa);
}
/*
@@ -308,11 +249,13 @@ destroystate(
for (ab=s->oas.next ; ab!=NULL ; ab=abnext) {
abnext = ab->next;
FREE(ab);
+ nfa->v->spaceused -= sizeof(struct arcbatch);
}
s->ins = NULL;
s->outs = NULL;
s->next = NULL;
FREE(s);
+ nfa->v->spaceused -= sizeof(struct state);
}
/*
@@ -320,6 +263,10 @@ destroystate(
^ static void newarc(struct nfa *, int, pcolor, struct state *,
^ struct state *);
*/
+/*
+ * This function checks to make sure that no duplicate arcs are created.
+ * In general we never want duplicates.
+ */
static void
newarc(
struct nfa *nfa,
@@ -332,16 +279,42 @@ newarc(
assert(from != NULL && to != NULL);
- /*
- * Check for duplicates.
- */
-
- for (a=from->outs ; a!=NULL ; a=a->outchain) {
- if (a->to == to && a->co == co && a->type == t) {
- return;
+ /* check for duplicate arc, using whichever chain is shorter */
+ if (from->nouts <= to->nins) {
+ for (a = from->outs; a != NULL; a = a->outchain) {
+ if (a->to == to && a->co == co && a->type == t) {
+ return;
+ }
+ }
+ } else {
+ for (a = to->ins; a != NULL; a = a->inchain) {
+ if (a->from == from && a->co == co && a->type == t) {
+ return;
+ }
}
}
+ /* no dup, so create the arc */
+ createarc(nfa, t, co, from, to);
+}
+
+/*
+ * createarc - create a new arc within an NFA
+ *
+ * This function must *only* be used after verifying that there is no existing
+ * identical arc (same type/color/from/to).
+ */
+static void
+createarc(
+ struct nfa * nfa,
+ int t,
+ pcolor co,
+ struct state * from,
+ struct state * to)
+{
+ struct arc *a;
+
+ /* the arc is physically allocated within its from-state */
a = allocarc(nfa, from);
if (NISERR()) {
return;
@@ -354,15 +327,21 @@ newarc(
a->from = from;
/*
- * Put the new arc on the beginning, not the end, of the chains. Not only
- * is this easier, it has the very useful side effect that deleting the
- * most-recently-added arc is the cheapest case rather than the most
- * expensive one.
+ * Put the new arc on the beginning, not the end, of the chains; it's
+ * simpler here, and freearc() is the same cost either way. See also the
+ * logic in moveins() and its cohorts, as well as fixempties().
*/
-
a->inchain = to->ins;
+ a->inchainRev = NULL;
+ if (to->ins) {
+ to->ins->inchainRev = a;
+ }
to->ins = a;
a->outchain = from->outs;
+ a->outchainRev = NULL;
+ if (from->outs) {
+ from->outs->outchainRev = a;
+ }
from->outs = a;
from->nouts++;
@@ -399,14 +378,19 @@ allocarc(
*/
if (s->free == NULL) {
- struct arcbatch *newAb = (struct arcbatch *)
- MALLOC(sizeof(struct arcbatch));
+ struct arcbatch *newAb;
int i;
+ if (nfa->v->spaceused >= REG_MAX_COMPILE_SPACE) {
+ NERR(REG_ETOOBIG);
+ return NULL;
+ }
+ newAb = (struct arcbatch *) MALLOC(sizeof(struct arcbatch));
if (newAb == NULL) {
NERR(REG_ESPACE);
return NULL;
}
+ nfa->v->spaceused += sizeof(struct arcbatch);
newAb->next = s->oas.next;
s->oas.next = newAb;
@@ -435,7 +419,7 @@ freearc(
{
struct state *from = victim->from;
struct state *to = victim->to;
- struct arc *a;
+ struct arc *predecessor;
assert(victim->type != 0);
@@ -452,16 +436,17 @@ freearc(
*/
assert(from != NULL);
- assert(from->outs != NULL);
- a = from->outs;
- if (a == victim) { /* simple case: first in chain */
+ predecessor = victim->outchainRev;
+ if (predecessor == NULL) {
+ assert(from->outs == victim);
from->outs = victim->outchain;
} else {
- for (; a!=NULL && a->outchain!=victim ; a=a->outchain) {
- continue;
- }
- assert(a != NULL);
- a->outchain = victim->outchain;
+ assert(predecessor->outchain == victim);
+ predecessor->outchain = victim->outchain;
+ }
+ if (victim->outchain != NULL) {
+ assert(victim->outchain->outchainRev == victim);
+ victim->outchain->outchainRev = predecessor;
}
from->nouts--;
@@ -470,86 +455,95 @@ freearc(
*/
assert(to != NULL);
- assert(to->ins != NULL);
- a = to->ins;
- if (a == victim) { /* simple case: first in chain */
+ predecessor = victim->inchainRev;
+ if (predecessor == NULL) {
+ assert(to->ins == victim);
to->ins = victim->inchain;
} else {
- for (; a->inchain!=victim ; a=a->inchain) {
- assert(a->inchain != NULL);
- continue;
- }
- a->inchain = victim->inchain;
+ assert(predecessor->inchain == victim);
+ predecessor->inchain = victim->inchain;
+ }
+ if (victim->inchain != NULL) {
+ assert(victim->inchain->inchainRev == victim);
+ victim->inchain->inchainRev = predecessor;
}
to->nins--;
/*
- * Clean up and place on free list.
+ * Clean up and place on from-state's free list.
*/
victim->type = 0;
victim->from = NULL; /* precautions... */
victim->to = NULL;
victim->inchain = NULL;
+ victim->inchainRev = NULL;
victim->outchain = NULL;
+ victim->outchainRev = NULL;
victim->freechain = from->free;
from->free = victim;
}
-
+
/*
- - hasnonemptyout - Does state have a non-EMPTY out arc?
- ^ static int hasnonemptyout(struct state *);
+ * changearctarget - flip an arc to have a different to state
+ *
+ * Caller must have verified that there is no pre-existing duplicate arc.
+ *
+ * Note that because we store arcs in their from state, we can't easily have
+ * a similar changearcsource function.
*/
-static int
-hasnonemptyout(
- struct state *s)
+static void
+changearctarget(struct arc * a, struct state * newto)
{
- struct arc *a;
+ struct state *oldto = a->to;
+ struct arc *predecessor;
- for (a = s->outs; a != NULL; a = a->outchain) {
- if (a->type != EMPTY) {
- return 1;
- }
+ assert(oldto != newto);
+
+ /* take it off old target's in-chain */
+ assert(oldto != NULL);
+ predecessor = a->inchainRev;
+ if (predecessor == NULL) {
+ assert(oldto->ins == a);
+ oldto->ins = a->inchain;
+ } else {
+ assert(predecessor->inchain == a);
+ predecessor->inchain = a->inchain;
}
- 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;
+ if (a->inchain != NULL) {
+ assert(a->inchain->inchainRev == a);
+ a->inchain->inchainRev = predecessor;
+ }
+ oldto->nins--;
- for (a = s->outs; a != NULL; a = a->outchain) {
- if (a->type != EMPTY) {
- n++;
- }
+ a->to = newto;
+
+ /* prepend it to new target's in-chain */
+ a->inchain = newto->ins;
+ a->inchainRev = NULL;
+ if (newto->ins) {
+ newto->ins->inchainRev = a;
}
- return n;
+ newto->ins = a;
+ newto->nins++;
}
/*
- - nonemptyins - count non-EMPTY in arcs of a state
- ^ static int nonemptyins(struct state *);
+ - hasnonemptyout - Does state have a non-EMPTY out arc?
+ ^ static int hasnonemptyout(struct state *);
*/
static int
-nonemptyins(
+hasnonemptyout(
struct state *s)
{
- int n = 0;
struct arc *a;
- for (a = s->ins; a != NULL; a = a->inchain) {
+ for (a = s->outs; a != NULL; a = a->outchain) {
if (a->type != EMPTY) {
- n++;
+ return 1;
}
}
- return n;
+ return 0;
}
/*
@@ -587,13 +581,181 @@ cparc(
{
newarc(nfa, oa->type, oa->co, from, to);
}
+
+/*
+ * sortins - sort the in arcs of a state by from/color/type
+ */
+static void
+sortins(
+ struct nfa * nfa,
+ struct state * s)
+{
+ struct arc **sortarray;
+ struct arc *a;
+ int n = s->nins;
+ int i;
+
+ if (n <= 1) {
+ return; /* nothing to do */
+ }
+ /* make an array of arc pointers ... */
+ sortarray = (struct arc **) MALLOC(n * sizeof(struct arc *));
+ if (sortarray == NULL) {
+ NERR(REG_ESPACE);
+ return;
+ }
+ i = 0;
+ for (a = s->ins; a != NULL; a = a->inchain) {
+ sortarray[i++] = a;
+ }
+ assert(i == n);
+ /* ... sort the array */
+ qsort(sortarray, n, sizeof(struct arc *), sortins_cmp);
+ /* ... and rebuild arc list in order */
+ /* it seems worth special-casing first and last items to simplify loop */
+ a = sortarray[0];
+ s->ins = a;
+ a->inchain = sortarray[1];
+ a->inchainRev = NULL;
+ for (i = 1; i < n - 1; i++) {
+ a = sortarray[i];
+ a->inchain = sortarray[i + 1];
+ a->inchainRev = sortarray[i - 1];
+ }
+ a = sortarray[i];
+ a->inchain = NULL;
+ a->inchainRev = sortarray[i - 1];
+ FREE(sortarray);
+}
+
+static int
+sortins_cmp(
+ const void *a,
+ const void *b)
+{
+ const struct arc *aa = *((const struct arc * const *) a);
+ const struct arc *bb = *((const struct arc * const *) b);
+
+ /* we check the fields in the order they are most likely to be different */
+ if (aa->from->no < bb->from->no) {
+ return -1;
+ }
+ if (aa->from->no > bb->from->no) {
+ return 1;
+ }
+ if (aa->co < bb->co) {
+ return -1;
+ }
+ if (aa->co > bb->co) {
+ return 1;
+ }
+ if (aa->type < bb->type) {
+ return -1;
+ }
+ if (aa->type > bb->type) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ * sortouts - sort the out arcs of a state by to/color/type
+ */
+static void
+sortouts(
+ struct nfa * nfa,
+ struct state * s)
+{
+ struct arc **sortarray;
+ struct arc *a;
+ int n = s->nouts;
+ int i;
+
+ if (n <= 1) {
+ return; /* nothing to do */
+ }
+ /* make an array of arc pointers ... */
+ sortarray = (struct arc **) MALLOC(n * sizeof(struct arc *));
+ if (sortarray == NULL) {
+ NERR(REG_ESPACE);
+ return;
+ }
+ i = 0;
+ for (a = s->outs; a != NULL; a = a->outchain) {
+ sortarray[i++] = a;
+ }
+ assert(i == n);
+ /* ... sort the array */
+ qsort(sortarray, n, sizeof(struct arc *), sortouts_cmp);
+ /* ... and rebuild arc list in order */
+ /* it seems worth special-casing first and last items to simplify loop */
+ a = sortarray[0];
+ s->outs = a;
+ a->outchain = sortarray[1];
+ a->outchainRev = NULL;
+ for (i = 1; i < n - 1; i++) {
+ a = sortarray[i];
+ a->outchain = sortarray[i + 1];
+ a->outchainRev = sortarray[i - 1];
+ }
+ a = sortarray[i];
+ a->outchain = NULL;
+ a->outchainRev = sortarray[i - 1];
+ FREE(sortarray);
+}
+
+static int
+sortouts_cmp(
+ const void *a,
+ const void *b)
+{
+ const struct arc *aa = *((const struct arc * const *) a);
+ const struct arc *bb = *((const struct arc * const *) b);
+
+ /* we check the fields in the order they are most likely to be different */
+ if (aa->to->no < bb->to->no) {
+ return -1;
+ }
+ if (aa->to->no > bb->to->no) {
+ return 1;
+ }
+ if (aa->co < bb->co) {
+ return -1;
+ }
+ if (aa->co > bb->co) {
+ return 1;
+ }
+ if (aa->type < bb->type) {
+ return -1;
+ }
+ if (aa->type > bb->type) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ * Common decision logic about whether to use arc-by-arc operations or
+ * sort/merge. If there's just a few source arcs we cannot recoup the
+ * cost of sorting the destination arc list, no matter how large it is.
+ * Otherwise, limit the number of arc-by-arc comparisons to about 1000
+ * (a somewhat arbitrary choice, but the breakeven point would probably
+ * be machine dependent anyway).
+ */
+#define BULK_ARC_OP_USE_SORT(nsrcarcs, ndestarcs) \
+ ((nsrcarcs) < 4 ? 0 : ((nsrcarcs) > 32 || (ndestarcs) > 32))
/*
- moveins - move all in arcs of a state to another state
* You might think this could be done better by just updating the
- * existing arcs, and you would be right if it weren't for the desire
+ * existing arcs, and you would be right if it weren't for the need
* for duplicate suppression, which makes it easier to just make new
* ones to exploit the suppression built into newarc.
+ *
+ * However, if we have a whole lot of arcs to deal with, retail duplicate
+ * checks become too slow. In that case we proceed by sorting and merging
+ * the arc lists, and then we can indeed just update the arcs in-place.
+ *
^ static void moveins(struct nfa *, struct state *, struct state *);
*/
static void
@@ -602,38 +764,253 @@ moveins(
struct state *oldState,
struct state *newState)
{
- struct arc *a;
-
assert(oldState != newState);
- while ((a = oldState->ins) != NULL) {
- cparc(nfa, a, a->from, newState);
- freearc(nfa, a);
+ if (!BULK_ARC_OP_USE_SORT(oldState->nins, newState->nins)) {
+ /* With not too many arcs, just do them one at a time */
+ struct arc *a;
+
+ while ((a = oldState->ins) != NULL) {
+ cparc(nfa, a, a->from, newState);
+ freearc(nfa, a);
+ }
+ } else {
+ /*
+ * With many arcs, use a sort-merge approach. Note changearctarget()
+ * will put the arc onto the front of newState's chain, so it does not
+ * break our walk through the sorted part of the chain.
+ */
+ struct arc *oa;
+ struct arc *na;
+
+ /*
+ * Because we bypass newarc() in this code path, we'd better include a
+ * cancel check.
+ */
+ if (CANCEL_REQUESTED(nfa->v->re)) {
+ NERR(REG_CANCEL);
+ return;
+ }
+
+ sortins(nfa, oldState);
+ sortins(nfa, newState);
+ if (NISERR()) {
+ return; /* might have failed to sort */
+ }
+ oa = oldState->ins;
+ na = newState->ins;
+ while (oa != NULL && na != NULL) {
+ struct arc *a = oa;
+
+ switch (sortins_cmp(&oa, &na)) {
+ case -1:
+ /* newState does not have anything matching oa */
+ oa = oa->inchain;
+
+ /*
+ * Rather than doing createarc+freearc, we can just unlink
+ * and relink the existing arc struct.
+ */
+ changearctarget(a, newState);
+ break;
+ case 0:
+ /* match, advance in both lists */
+ oa = oa->inchain;
+ na = na->inchain;
+ /* ... and drop duplicate arc from oldState */
+ freearc(nfa, a);
+ break;
+ case +1:
+ /* advance only na; oa might have a match later */
+ na = na->inchain;
+ break;
+ default:
+ assert(NOTREACHED);
+ }
+ }
+ while (oa != NULL) {
+ /* newState does not have anything matching oa */
+ struct arc *a = oa;
+
+ oa = oa->inchain;
+ changearctarget(a, newState);
+ }
}
+
assert(oldState->nins == 0);
assert(oldState->ins == NULL);
}
/*
- 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,
- int all)
+ struct state *newState)
{
- struct arc *a;
-
assert(oldState != newState);
- for (a=oldState->ins ; a!=NULL ; a=a->inchain) {
- if (all || a->type != EMPTY) {
+ if (!BULK_ARC_OP_USE_SORT(oldState->nins, newState->nins)) {
+ /* With not too many arcs, just do them one at a time */
+ struct arc *a;
+
+ for (a = oldState->ins; a != NULL; a = a->inchain) {
cparc(nfa, a, a->from, newState);
}
+ } else {
+ /*
+ * With many arcs, use a sort-merge approach. Note that createarc()
+ * will put new arcs onto the front of newState's chain, so it does
+ * not break our walk through the sorted part of the chain.
+ */
+ struct arc *oa;
+ struct arc *na;
+
+ /*
+ * Because we bypass newarc() in this code path, we'd better include a
+ * cancel check.
+ */
+ if (CANCEL_REQUESTED(nfa->v->re)) {
+ NERR(REG_CANCEL);
+ return;
+ }
+
+ sortins(nfa, oldState);
+ sortins(nfa, newState);
+ if (NISERR()) {
+ return; /* might have failed to sort */
+ }
+ oa = oldState->ins;
+ na = newState->ins;
+ while (oa != NULL && na != NULL) {
+ struct arc *a = oa;
+
+ switch (sortins_cmp(&oa, &na)) {
+ case -1:
+ /* newState does not have anything matching oa */
+ oa = oa->inchain;
+ createarc(nfa, a->type, a->co, a->from, newState);
+ break;
+ case 0:
+ /* match, advance in both lists */
+ oa = oa->inchain;
+ na = na->inchain;
+ break;
+ case +1:
+ /* advance only na; oa might have a match later */
+ na = na->inchain;
+ break;
+ default:
+ assert(NOTREACHED);
+ }
+ }
+ while (oa != NULL) {
+ /* newState does not have anything matching oa */
+ struct arc *a = oa;
+
+ oa = oa->inchain;
+ createarc(nfa, a->type, a->co, a->from, newState);
+ }
+ }
+}
+
+/*
+ * mergeins - merge a list of inarcs into a state
+ *
+ * This is much like copyins, but the source arcs are listed in an array,
+ * and are not guaranteed unique. It's okay to clobber the array contents.
+ */
+static void
+mergeins(
+ struct nfa * nfa,
+ struct state * s,
+ struct arc ** arcarray,
+ int arccount)
+{
+ struct arc *na;
+ int i;
+ int j;
+
+ if (arccount <= 0) {
+ return;
+ }
+
+ /*
+ * Because we bypass newarc() in this code path, we'd better include a
+ * cancel check.
+ */
+ if (CANCEL_REQUESTED(nfa->v->re)) {
+ NERR(REG_CANCEL);
+ return;
+ }
+
+ /* Sort existing inarcs as well as proposed new ones */
+ sortins(nfa, s);
+ if (NISERR()) {
+ return; /* might have failed to sort */
+ }
+
+ qsort(arcarray, arccount, sizeof(struct arc *), sortins_cmp);
+
+ /*
+ * arcarray very likely includes dups, so we must eliminate them. (This
+ * could be folded into the next loop, but it's not worth the trouble.)
+ */
+ j = 0;
+ for (i = 1; i < arccount; i++) {
+ switch (sortins_cmp(&arcarray[j], &arcarray[i])) {
+ case -1:
+ /* non-dup */
+ arcarray[++j] = arcarray[i];
+ break;
+ case 0:
+ /* dup */
+ break;
+ default:
+ /* trouble */
+ assert(NOTREACHED);
+ }
+ }
+ arccount = j + 1;
+
+ /*
+ * Now merge into s' inchain. Note that createarc() will put new arcs
+ * onto the front of s's chain, so it does not break our walk through the
+ * sorted part of the chain.
+ */
+ i = 0;
+ na = s->ins;
+ while (i < arccount && na != NULL) {
+ struct arc *a = arcarray[i];
+
+ switch (sortins_cmp(&a, &na)) {
+ case -1:
+ /* s does not have anything matching a */
+ createarc(nfa, a->type, a->co, a->from, s);
+ i++;
+ break;
+ case 0:
+ /* match, advance in both lists */
+ i++;
+ na = na->inchain;
+ break;
+ case +1:
+ /* advance only na; array might have a match later */
+ na = na->inchain;
+ break;
+ default:
+ assert(NOTREACHED);
+ }
+ }
+ while (i < arccount) {
+ /* s does not have anything matching a */
+ struct arc *a = arcarray[i];
+
+ createarc(nfa, a->type, a->co, a->from, s);
+ i++;
}
}
@@ -647,36 +1024,153 @@ moveouts(
struct state *oldState,
struct state *newState)
{
- struct arc *a;
-
assert(oldState != newState);
- while ((a = oldState->outs) != NULL) {
- cparc(nfa, a, newState, a->to);
- freearc(nfa, a);
+ if (!BULK_ARC_OP_USE_SORT(oldState->nouts, newState->nouts)) {
+ /* With not too many arcs, just do them one at a time */
+ struct arc *a;
+
+ while ((a = oldState->outs) != NULL) {
+ cparc(nfa, a, newState, a->to);
+ freearc(nfa, a);
+ }
+ } else {
+ /*
+ * With many arcs, use a sort-merge approach. Note that createarc()
+ * will put new arcs onto the front of newState's chain, so it does
+ * not break our walk through the sorted part of the chain.
+ */
+ struct arc *oa;
+ struct arc *na;
+
+ /*
+ * Because we bypass newarc() in this code path, we'd better include a
+ * cancel check.
+ */
+ if (CANCEL_REQUESTED(nfa->v->re)) {
+ NERR(REG_CANCEL);
+ return;
+ }
+
+ sortouts(nfa, oldState);
+ sortouts(nfa, newState);
+ if (NISERR()) {
+ return; /* might have failed to sort */
+ }
+ oa = oldState->outs;
+ na = newState->outs;
+ while (oa != NULL && na != NULL) {
+ struct arc *a = oa;
+
+ switch (sortouts_cmp(&oa, &na)) {
+ case -1:
+ /* newState does not have anything matching oa */
+ oa = oa->outchain;
+ createarc(nfa, a->type, a->co, newState, a->to);
+ freearc(nfa, a);
+ break;
+ case 0:
+ /* match, advance in both lists */
+ oa = oa->outchain;
+ na = na->outchain;
+ /* ... and drop duplicate arc from oldState */
+ freearc(nfa, a);
+ break;
+ case +1:
+ /* advance only na; oa might have a match later */
+ na = na->outchain;
+ break;
+ default:
+ assert(NOTREACHED);
+ }
+ }
+ while (oa != NULL) {
+ /* newState does not have anything matching oa */
+ struct arc *a = oa;
+
+ oa = oa->outchain;
+ createarc(nfa, a->type, a->co, newState, a->to);
+ freearc(nfa, a);
+ }
}
+
+ assert(oldState->nouts == 0);
+ assert(oldState->outs == NULL);
}
/*
- 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,
- int all)
+ struct state *newState)
{
- struct arc *a;
-
assert(oldState != newState);
- for (a=oldState->outs ; a!=NULL ; a=a->outchain) {
- if (all || a->type != EMPTY) {
+ if (!BULK_ARC_OP_USE_SORT(oldState->nouts, newState->nouts)) {
+ /* With not too many arcs, just do them one at a time */
+ struct arc *a;
+
+ for (a = oldState->outs; a != NULL; a = a->outchain) {
cparc(nfa, a, newState, a->to);
}
+ } else {
+ /*
+ * With many arcs, use a sort-merge approach. Note that createarc()
+ * will put new arcs onto the front of newState's chain, so it does
+ * not break our walk through the sorted part of the chain.
+ */
+ struct arc *oa;
+ struct arc *na;
+
+ /*
+ * Because we bypass newarc() in this code path, we'd better include a
+ * cancel check.
+ */
+ if (CANCEL_REQUESTED(nfa->v->re)) {
+ NERR(REG_CANCEL);
+ return;
+ }
+
+ sortouts(nfa, oldState);
+ sortouts(nfa, newState);
+ if (NISERR()) {
+ return; /* might have failed to sort */
+ }
+ oa = oldState->outs;
+ na = newState->outs;
+ while (oa != NULL && na != NULL) {
+ struct arc *a = oa;
+
+ switch (sortouts_cmp(&oa, &na)) {
+ case -1:
+ /* newState does not have anything matching oa */
+ oa = oa->outchain;
+ createarc(nfa, a->type, a->co, newState, a->to);
+ break;
+ case 0:
+ /* match, advance in both lists */
+ oa = oa->outchain;
+ na = na->outchain;
+ break;
+ case +1:
+ /* advance only na; oa might have a match later */
+ na = na->outchain;
+ break;
+ default:
+ assert(NOTREACHED);
+ }
+ }
+ while (oa != NULL) {
+ /* newState does not have anything matching oa */
+ struct arc *a = oa;
+
+ oa = oa->outchain;
+ createarc(nfa, a->type, a->co, newState, a->to);
+ }
}
}
@@ -895,6 +1389,20 @@ specialcolors(
- optimize - optimize an NFA
^ static long optimize(struct nfa *, FILE *);
*/
+
+ /*
+ * The main goal of this function is not so much "optimization" (though it
+ * does try to get rid of useless NFA states) as reducing the NFA to a form
+ * the regex executor can handle. The executor, and indeed the cNFA format
+ * that is its input, can only handle PLAIN and LACON arcs. The output of
+ * the regex parser also includes EMPTY (do-nothing) arcs, as well as
+ * ^, $, AHEAD, and BEHIND constraint arcs, which we must get rid of here.
+ * We first get rid of EMPTY arcs and then deal with the constraint arcs.
+ * The hardest part of either job is to get rid of circular loops of the
+ * target arc type. We would have to do that in any case, though, as such a
+ * loop would otherwise allow the executor to cycle through the loop endlessly
+ * without making any progress in the input string.
+ */
static long /* re_info bits */
optimize(
struct nfa *nfa,
@@ -916,17 +1424,23 @@ optimize(
if (verbose) {
fprintf(f, "\nconstraints:\n");
}
+ fixconstraintloops(nfa, f); /* get rid of constraint loops */
pullback(nfa, f); /* pull back constraints backward */
pushfwd(nfa, f); /* push fwd constraints forward */
if (verbose) {
fprintf(f, "\nfinal cleanup:\n");
}
cleanup(nfa); /* final tidying */
+#ifdef REG_DEBUG
+ if (verbose) {
+ dumpnfa(nfa, f);
+ }
+#endif
return analyze(nfa); /* and analysis */
}
/*
- - pullback - pull back constraints backward to (with luck) eliminate them
+ - pullback - pull back constraints backward to eliminate them
^ static void pullback(struct nfa *, FILE *);
*/
static void
@@ -938,6 +1452,7 @@ pullback(
struct state *nexts;
struct arc *a;
struct arc *nexta;
+ struct state *intermediates;
int progress;
/*
@@ -948,15 +1463,27 @@ pullback(
progress = 0;
for (s=nfa->states ; s!=NULL && !NISERR() ; s=nexts) {
nexts = s->next;
+ intermediates = NULL;
for (a=s->outs ; a!=NULL && !NISERR() ; a=nexta) {
nexta = a->outchain;
if (a->type == '^' || a->type == BEHIND) {
- if (pull(nfa, a)) {
+ if (pull(nfa, a, &intermediates)) {
progress = 1;
}
}
assert(nexta == NULL || s->no != FREESTATE);
}
+ /* clear tmp fields of intermediate states created here */
+ while (intermediates != NULL) {
+ struct state *ns = intermediates->tmp;
+
+ intermediates->tmp = NULL;
+ intermediates = ns;
+ }
+ /* if s is now useless, get rid of it */
+ if ((s->nins == 0 || s->nouts == 0) && !s->flag) {
+ dropstate(nfa, s);
+ }
}
if (progress && f != NULL) {
dumpnfa(nfa, f);
@@ -966,6 +1493,12 @@ pullback(
return;
}
+ /*
+ * Any ^ constraints we were able to pull to the start state can now be
+ * replaced by PLAIN arcs referencing the BOS or BOL colors. There should
+ * be no other ^ or BEHIND arcs left in the NFA, though we do not check
+ * that here (compact() will fail if so).
+ */
for (a=nfa->pre->outs ; a!=NULL ; a=nexta) {
nexta = a->outchain;
if (a->type == '^') {
@@ -978,15 +1511,28 @@ pullback(
/*
- pull - pull a back constraint backward past its source state
- * A significant property of this function is that it deletes at most
- * one state -- the constraint's from state -- and only if the constraint
- * was that state's last outarc.
+ *
+ * Returns 1 if successful (which it always is unless the source is the
+ * start state or we have an internal error), 0 if nothing happened.
+ *
+ * A significant property of this function is that it deletes no pre-existing
+ * states, and no outarcs of the constraint's from state other than the given
+ * constraint arc. This makes the loops in pullback() safe, at the cost that
+ * we may leave useless states behind. Therefore, we leave it to pullback()
+ * to delete such states.
+ *
+ * If the from state has multiple back-constraint outarcs, and/or multiple
+ * compatible constraint inarcs, we only need to create one new intermediate
+ * state per combination of predecessor and successor states. *intermediates
+ * points to a list of such intermediate states for this from state (chained
+ * through their tmp fields).
^ static int pull(struct nfa *, struct arc *);
*/
-static int /* 0 couldn't, 1 could */
+static int
pull(
struct nfa *nfa,
- struct arc *con)
+ struct arc *con,
+ struct state **intermediates)
{
struct state *from = con->from;
struct state *to = con->to;
@@ -994,10 +1540,7 @@ pull(
struct arc *nexta;
struct state *s;
- if (from == to) { /* circular constraint is pointless */
- freearc(nfa, con);
- return 1;
- }
+ assert(from != to); /* should have gotten rid of this earlier */
if (from->flag) { /* can't pull back beyond start */
return 0;
}
@@ -1007,26 +1550,9 @@ pull(
}
/*
- * DGP 2007-11-15: Cloning a state with a circular constraint on its list
- * of outs can lead to trouble [Bug 1810038], so get rid of them first.
- */
-
- for (a = from->outs; a != NULL; a = nexta) {
- nexta = a->outchain;
- switch (a->type) {
- case '^':
- case '$':
- case BEHIND:
- case AHEAD:
- if (from == a->to) {
- freearc(nfa, a);
- }
- break;
- }
- }
-
- /*
- * First, clone from state if necessary to avoid other outarcs.
+ * First, clone from state if necessary to avoid other outarcs. This may
+ * seem wasteful, but it simplifies the logic, and we'll get rid of the
+ * clone state again at the bottom.
*/
if (from->nouts > 1) {
@@ -1034,10 +1560,12 @@ pull(
if (NISERR()) {
return 0;
}
- assert(to != from); /* con is not an inarc */
- copyins(nfa, from, s, 1); /* duplicate inarcs */
+ copyins(nfa, from, s); /* duplicate inarcs */
cparc(nfa, con, s, to); /* move constraint arc */
freearc(nfa, con);
+ if (NISERR()) {
+ return 0;
+ }
from = s;
con = from->outs;
}
@@ -1047,7 +1575,7 @@ pull(
* Propagate the constraint into the from state's inarcs.
*/
- for (a=from->ins ; a!=NULL ; a=nexta) {
+ for (a=from->ins ; a!=NULL && !NISERR(); a=nexta) {
nexta = a->inchain;
switch (combine(con, a)) {
case INCOMPATIBLE: /* destroy the arc */
@@ -1056,17 +1584,25 @@ pull(
case SATISFIED: /* no action needed */
break;
case COMPATIBLE: /* swap the two arcs, more or less */
- s = newstate(nfa);
- if (NISERR()) {
- return 0;
+ /* need an intermediate state, but might have one already */
+ for (s = *intermediates; s != NULL; s = s->tmp) {
+ assert(s->nins > 0 && s->nouts > 0);
+ if (s->ins->from == a->from && s->outs->to == to) {
+ break;
+ }
}
- cparc(nfa, a, s, to); /* anticipate move */
- cparc(nfa, con, a->from, s);
- if (NISERR()) {
- return 0;
+ if (s == NULL) {
+ s = newstate(nfa);
+ if (NISERR()) {
+ return 0;
+ }
+ s->tmp = *intermediates;
+ *intermediates = s;
}
- freearc(nfa, a);
- break;
+ cparc(nfa, con, a->from, s);
+ cparc(nfa, a, s, to);
+ freearc(nfa, a);
+ break;
default:
assert(NOTREACHED);
break;
@@ -1078,12 +1614,13 @@ pull(
*/
moveins(nfa, from, to);
- dropstate(nfa, from); /* will free the constraint */
+ freearc(nfa, con);
+ /* from state is now useless, but we leave it to pullback() to clean up */
return 1;
}
/*
- - pushfwd - push forward constraints forward to (with luck) eliminate them
+ - pushfwd - push forward constraints forward to eliminate them
^ static void pushfwd(struct nfa *, FILE *);
*/
static void
@@ -1095,6 +1632,7 @@ pushfwd(
struct state *nexts;
struct arc *a;
struct arc *nexta;
+ struct state *intermediates;
int progress;
/*
@@ -1105,14 +1643,25 @@ pushfwd(
progress = 0;
for (s=nfa->states ; s!=NULL && !NISERR() ; s=nexts) {
nexts = s->next;
+ intermediates = NULL;
for (a = s->ins; a != NULL && !NISERR(); a = nexta) {
nexta = a->inchain;
if (a->type == '$' || a->type == AHEAD) {
- if (push(nfa, a)) {
+ if (push(nfa, a, &intermediates)) {
progress = 1;
}
}
- assert(nexta == NULL || s->no != FREESTATE);
+ }
+ /* clear tmp fields of intermediate states created here */
+ while (intermediates != NULL) {
+ struct state *ns = intermediates->tmp;
+
+ intermediates->tmp = NULL;
+ intermediates = ns;
+ }
+ /* if s is now useless, get rid of it */
+ if ((s->nins == 0 || s->nouts == 0) && !s->flag) {
+ dropstate(nfa, s);
}
}
if (progress && f != NULL) {
@@ -1123,6 +1672,12 @@ pushfwd(
return;
}
+ /*
+ * Any $ constraints we were able to push to the post state can now be
+ * replaced by PLAIN arcs referencing the EOS or EOL colors. There should
+ * be no other $ or AHEAD arcs left in the NFA, though we do not check
+ * that here (compact() will fail if so).
+ */
for (a = nfa->post->ins; a != NULL; a = nexta) {
nexta = a->inchain;
if (a->type == '$') {
@@ -1135,15 +1690,28 @@ pushfwd(
/*
- push - push a forward constraint forward past its destination state
- * A significant property of this function is that it deletes at most
- * one state -- the constraint's to state -- and only if the constraint
- * was that state's last inarc.
+ *
+ * Returns 1 if successful (which it always is unless the destination is the
+ * post state or we have an internal error), 0 if nothing happened.
+ *
+ * A significant property of this function is that it deletes no pre-existing
+ * states, and no inarcs of the constraint's to state other than the given
+ * constraint arc. This makes the loops in pushfwd() safe, at the cost that
+ * we may leave useless states behind. Therefore, we leave it to pushfwd()
+ * to delete such states.
+ *
+ * If the to state has multiple forward-constraint inarcs, and/or multiple
+ * compatible constraint outarcs, we only need to create one new intermediate
+ * state per combination of predecessor and successor states. *intermediates
+ * points to a list of such intermediate states for this to state (chained
+ * through their tmp fields).
^ static int push(struct nfa *, struct arc *);
*/
-static int /* 0 couldn't, 1 could */
+static int
push(
struct nfa *nfa,
- struct arc *con)
+ struct arc *con,
+ struct state **intermediates)
{
struct state *from = con->from;
struct state *to = con->to;
@@ -1151,10 +1719,7 @@ push(
struct arc *nexta;
struct state *s;
- if (to == from) { /* circular constraint is pointless */
- freearc(nfa, con);
- return 1;
- }
+ assert(to != from); /* should have gotten rid of this earlier */
if (to->flag) { /* can't push forward beyond end */
return 0;
}
@@ -1164,29 +1729,9 @@ push(
}
/*
- * DGP 2007-11-15: Here we duplicate the same protections as appear
- * in pull() above to avoid troubles with cloning a state with a
- * circular constraint on its list of ins. It is not clear whether
- * this is necessary, or is protecting against a "can't happen".
- * Any test case that actually leads to a freearc() call here would
- * be a welcome addition to the test suite.
- */
-
- for (a = to->ins; a != NULL; a = nexta) {
- nexta = a->inchain;
- switch (a->type) {
- case '^':
- case '$':
- case BEHIND:
- case AHEAD:
- if (a->from == to) {
- freearc(nfa, a);
- }
- break;
- }
- }
- /*
- * First, clone to state if necessary to avoid other inarcs.
+ * First, clone to state if necessary to avoid other inarcs. This may
+ * seem wasteful, but it simplifies the logic, and we'll get rid of the
+ * clone state again at the bottom.
*/
if (to->nins > 1) {
@@ -1194,9 +1739,12 @@ push(
if (NISERR()) {
return 0;
}
- copyouts(nfa, to, s, 1); /* duplicate outarcs */
- cparc(nfa, con, from, s); /* move constraint */
+ copyouts(nfa, to, s); /* duplicate outarcs */
+ cparc(nfa, con, from, s); /* move constraint arc */
freearc(nfa, con);
+ if (NISERR()) {
+ return 0;
+ }
to = s;
con = to->ins;
}
@@ -1206,7 +1754,7 @@ push(
* Propagate the constraint into the to state's outarcs.
*/
- for (a = to->outs; a != NULL; a = nexta) {
+ for (a = to->outs; a != NULL && !NISERR(); a = nexta) {
nexta = a->outchain;
switch (combine(con, a)) {
case INCOMPATIBLE: /* destroy the arc */
@@ -1215,17 +1763,25 @@ push(
case SATISFIED: /* no action needed */
break;
case COMPATIBLE: /* swap the two arcs, more or less */
- s = newstate(nfa);
- if (NISERR()) {
- return 0;
+ /* need an intermediate state, but might have one already */
+ for (s = *intermediates; s != NULL; s = s->tmp) {
+ assert(s->nins > 0 && s->nouts > 0);
+ if (s->ins->from == from && s->outs->to == a->to) {
+ break;
+ }
}
- cparc(nfa, con, s, a->to); /* anticipate move */
- cparc(nfa, a, from, s);
- if (NISERR()) {
- return 0;
+ if (s == NULL) {
+ s = newstate(nfa);
+ if (NISERR()) {
+ return 0;
+ }
+ s->tmp = *intermediates;
+ *intermediates = s;
}
- freearc(nfa, a);
- break;
+ cparc(nfa, con, s, a->to);
+ cparc(nfa, a, from, s);
+ freearc(nfa, a);
+ break;
default:
assert(NOTREACHED);
break;
@@ -1237,7 +1793,8 @@ push(
*/
moveouts(nfa, to, from);
- dropstate(nfa, to); /* will free the constraint */
+ freearc(nfa, con);
+ /* to state is now useless, but we leave it to pushfwd() to clean up */
return 1;
}
@@ -1315,6 +1872,12 @@ fixempties(
struct state *nexts;
struct arc *a;
struct arc *nexta;
+ int totalinarcs;
+ struct arc **inarcsorig;
+ struct arc **arcarray;
+ int arccount;
+ int prevnins;
+ int nskip;
/*
* First, get rid of any states whose sole out-arc is an EMPTY,
@@ -1345,7 +1908,7 @@ fixempties(
for (s = nfa->states; s != NULL && !NISERR(); s = nexts) {
nexts = s->next;
/* Ensure tmp fields are clear for next step */
- assert(s->tmp = NULL);
+ assert(s->tmp == NULL);
if (s->flag || s->nins != 1) {
continue;
}
@@ -1360,42 +1923,129 @@ fixempties(
dropstate(nfa, s);
}
+ if (NISERR()) {
+ return;
+ }
+
/*
- * 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.
+ * For each remaining NFA state, find all other states from which it is
+ * reachable by a chain of one or more EMPTY arcs. Then generate new arcs
+ * that eliminate the need for each such chain.
+ *
+ * We could replace a chain of EMPTY arcs that leads from a "from" state
+ * to a "to" state either by pushing non-EMPTY arcs forward (linking
+ * directly from "from"'s predecessors to "to") or by pulling them back
+ * (linking directly from "from" to "to"'s successors). We choose to
+ * always do the former; this choice is somewhat arbitrary, but the
+ * approach below requires that we uniformly do one or the other.
+ *
+ * Suppose we have a chain of N successive EMPTY arcs (where N can easily
+ * approach the size of the NFA). All of the intermediate states must
+ * have additional inarcs and outarcs, else they'd have been removed by
+ * the steps above. Assuming their inarcs are mostly not empties, we will
+ * add O(N^2) arcs to the NFA, since a non-EMPTY inarc leading to any one
+ * state in the chain must be duplicated to lead to all its successor
+ * states as well. So there is no hope of doing less than O(N^2) work;
+ * however, we should endeavor to keep the big-O cost from being even
+ * worse than that, which it can easily become without care. In
+ * particular, suppose we were to copy all S1's inarcs forward to S2, and
+ * then also to S3, and then later we consider pushing S2's inarcs forward
+ * to S3. If we include the arcs already copied from S1 in that, we'd be
+ * doing O(N^3) work. (The duplicate-arc elimination built into newarc()
+ * and its cohorts would get rid of the extra arcs, but not without cost.)
*
- * 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.
+ * We can avoid this cost by treating only arcs that existed at the start
+ * of this phase as candidates to be pushed forward. To identify those,
+ * we remember the first inarc each state had to start with. We rely on
+ * the fact that newarc() and friends put new arcs on the front of their
+ * to-states' inchains, and that this phase never deletes arcs, so that
+ * the original arcs must be the last arcs in their to-states' inchains.
+ *
+ * So the process here is that, for each state in the NFA, we gather up
+ * all non-EMPTY inarcs of states that can reach the target state via
+ * EMPTY arcs. We then sort, de-duplicate, and merge these arcs into the
+ * target state's inchain. (We can safely use sort-merge for this as long
+ * as we update each state's original-arcs pointer after we add arcs to
+ * it; the sort step of mergeins probably changed the order of the old
+ * arcs.)
+ *
+ * Another refinement worth making is that, because we only add non-EMPTY
+ * arcs during this phase, and all added arcs have the same from-state as
+ * the non-EMPTY arc they were cloned from, we know ahead of time that any
+ * states having only EMPTY outarcs will be useless for lack of outarcs
+ * after we drop the EMPTY arcs. (They cannot gain non-EMPTY outarcs if
+ * they had none to start with.) So we need not bother to update the
+ * inchains of such states at all.
+ */
+
+ /* Remember the states' first original inarcs */
+ /* ... and while at it, count how many old inarcs there are altogether */
+ inarcsorig = (struct arc **) MALLOC(nfa->nstates * sizeof(struct arc *));
+ if (inarcsorig == NULL) {
+ NERR(REG_ESPACE);
+ return;
+ }
+ totalinarcs = 0;
+ for (s = nfa->states; s != NULL; s = s->next) {
+ inarcsorig[s->no] = s->ins;
+ totalinarcs += s->nins;
+ }
+
+ /*
+ * Create a workspace for accumulating the inarcs to be added to the
+ * current target state. totalinarcs is probably a considerable
+ * overestimate of the space needed, but the NFA is unlikely to be large
+ * enough at this point to make it worth being smarter.
*/
+ arcarray = (struct arc **) MALLOC(totalinarcs * sizeof(struct arc *));
+ if (arcarray == NULL) {
+ NERR(REG_ESPACE);
+ FREE(inarcsorig);
+ return;
+ }
+
+ /* And iterate over the target states */
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);
+ /* Ignore target states without non-EMPTY outarcs, per note above */
+ if (!s->flag && !hasnonemptyout(s)) {
+ continue;
+ }
+
+ /* Find predecessor states and accumulate their original inarcs */
+ arccount = 0;
+ for (s2 = emptyreachable(nfa, s, s, inarcsorig); s2 != s; s2 = nexts) {
+ /* Add s2's original inarcs to arcarray[], but ignore empties */
+ for (a = inarcsorig[s2->no]; a != NULL; a = a->inchain) {
+ if (a->type != EMPTY) {
+ arcarray[arccount++] = a;
+ }
}
- /* Reset the tmp fields as we walk back */
- nexts = s2->tmp;
- s2->tmp = NULL;
+ /* Reset the tmp fields as we walk back */
+ nexts = s2->tmp;
+ s2->tmp = NULL;
+ }
+ s->tmp = NULL;
+ assert(arccount <= totalinarcs);
+
+ /* Remember how many original inarcs this state has */
+ prevnins = s->nins;
+
+ /* Add non-duplicate inarcs to target state */
+ mergeins(nfa, s, arcarray, arccount);
+
+ /* Now we must update the state's inarcsorig pointer */
+ nskip = s->nins - prevnins;
+ a = s->ins;
+ while (nskip-- > 0) {
+ a = a->inchain;
}
- s->tmp = NULL;
+ inarcsorig[s->no] = a;
}
+
+ FREE(arcarray);
+ FREE(inarcsorig);
+
if (NISERR()) {
return;
}
@@ -1431,89 +2081,604 @@ fixempties(
}
/*
- - emptyreachable - recursively find all states reachable from s by EMPTY arcs
+ - emptyreachable - recursively find all states that can reach 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.
+ *
+ * Since this is only used in fixempties(), we pass in the inarcsorig[] array
+ * maintained by that function. This lets us skip over all new inarcs, which
+ * are certainly not EMPTY arcs.
+ *
* 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.
+ * the NFA, and in practice will be less than that.
^ static struct state *emptyreachable(struct state *, struct state *);
*/
static struct state *
emptyreachable(
+ struct nfa *nfa,
struct state *s,
- struct state *lastfound)
+ struct state *lastfound,
+ struct arc **inarcsorig)
{
struct arc *a;
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);
+ for (a = inarcsorig[s->no]; a != NULL; a = a->inchain) {
+ if (a->type == EMPTY && a->from->tmp == NULL) {
+ lastfound = emptyreachable(nfa, a->from, lastfound, inarcsorig);
}
}
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 *);
+ * isconstraintarc - detect whether an arc is of a constraint type
+ */
+static inline int
+isconstraintarc(struct arc * a)
+{
+ switch (a->type)
+ {
+ case '^':
+ case '$':
+ case BEHIND:
+ case AHEAD:
+ case LACON:
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ * hasconstraintout - does state have a constraint out arc?
+ */
+static int
+hasconstraintout(struct state * s)
+{
+ struct arc *a;
+
+ for (a = s->outs; a != NULL; a = a->outchain) {
+ if (isconstraintarc(a)) {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+/*
+ * fixconstraintloops - get rid of loops containing only constraint arcs
+ *
+ * A loop of states that contains only constraint arcs is useless, since
+ * passing around the loop represents no forward progress. Moreover, it
+ * would cause infinite looping in pullback/pushfwd, so we need to get rid
+ * of such loops before doing that.
*/
static void
-replaceempty(
- struct nfa *nfa,
- struct state *from,
- struct state *to)
+fixconstraintloops(
+ struct nfa * nfa,
+ FILE *f) /* for debug output; NULL none */
{
- int fromouts;
- int toins;
+ struct state *s;
+ struct state *nexts;
+ struct arc *a;
+ struct arc *nexta;
+ int hasconstraints;
+
+ /*
+ * In the trivial case of a state that loops to itself, we can just drop
+ * the constraint arc altogether. This is worth special-casing because
+ * such loops are far more common than loops containing multiple states.
+ * While we're at it, note whether any constraint arcs survive.
+ */
+ hasconstraints = 0;
+ for (s = nfa->states; s != NULL && !NISERR(); s = nexts) {
+ nexts = s->next;
+ /* while we're at it, ensure tmp fields are clear for next step */
+ assert(s->tmp == NULL);
+ for (a = s->outs; a != NULL && !NISERR(); a = nexta) {
+ nexta = a->outchain;
+ if (isconstraintarc(a)) {
+ if (a->to == s) {
+ freearc(nfa, a);
+ } else {
+ hasconstraints = 1;
+ }
+ }
+ }
+ /* If we removed all the outarcs, the state is useless. */
+ if (s->nouts == 0 && !s->flag) {
+ dropstate(nfa, s);
+ }
+ }
- assert(from != to);
+ /* Nothing to do if no remaining constraint arcs */
+ if (NISERR() || !hasconstraints) {
+ return;
+ }
/*
- * 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.
+ * Starting from each remaining NFA state, search outwards for a
+ * constraint loop. If we find a loop, break the loop, then start the
+ * search over. (We could possibly retain some state from the first scan,
+ * but it would complicate things greatly, and multi-state constraint
+ * loops are rare enough that it's not worth optimizing the case.)
+ */
+ restart:
+ for (s = nfa->states; s != NULL && !NISERR(); s = s->next) {
+ if (findconstraintloop(nfa, s)) {
+ goto restart;
+ }
+ }
+
+ if (NISERR()) {
+ return;
+ }
+
+ /*
+ * Now 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.)
*
- * 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.
+ * Because findconstraintloop intentionally doesn't reset all tmp fields,
+ * we have to clear them after it's done. This is a convenient place to
+ * do that, too.
*/
- fromouts = nonemptyouts(from);
- toins = (fromouts == 0) ? 1 : nonemptyins(to);
+ for (s = nfa->states; s != NULL; s = nexts) {
+ nexts = s->next;
+ s->tmp = NULL;
+ if ((s->nins == 0 || s->nouts == 0) && !s->flag) {
+ dropstate(nfa, s);
+ }
+ }
+
+ if (f != NULL) {
+ dumpnfa(nfa, f);
+ }
+}
- if (fromouts > toins) {
- copyouts(nfa, to, from, 0);
+/*
+ * findconstraintloop - recursively find a loop of constraint arcs
+ *
+ * If we find a loop, break it by calling breakconstraintloop(), then
+ * return 1; otherwise return 0.
+ *
+ * State tmp fields are guaranteed all NULL on a success return, because
+ * breakconstraintloop does that. After a failure return, any state that
+ * is known not to be part of a loop is marked with s->tmp == s; this allows
+ * us not to have to re-prove that fact on later calls. (This convention is
+ * workable because we already eliminated single-state loops.)
+ *
+ * Note that the found loop doesn't necessarily include the first state we
+ * are called on. Any loop reachable from that state will do.
+ *
+ * The maximum recursion depth here is one more than the length of the longest
+ * loop-free chain of constraint arcs, which is surely no more than the size
+ * of the NFA, and in practice will be a lot less than that.
+ */
+static int
+findconstraintloop(struct nfa * nfa, struct state * s)
+{
+ struct arc *a;
+
+ /* Since this is recursive, it could be driven to stack overflow */
+ if (STACK_TOO_DEEP(nfa->v->re)) {
+ NERR(REG_ETOOBIG);
+ return 1; /* to exit as quickly as possible */
+ }
+
+ if (s->tmp != NULL) {
+ /* Already proven uninteresting? */
+ if (s->tmp == s) {
+ return 0;
+ }
+ /* Found a loop involving s */
+ breakconstraintloop(nfa, s);
+ /* The tmp fields have been cleaned up by breakconstraintloop */
+ return 1;
+ }
+ for (a = s->outs; a != NULL; a = a->outchain) {
+ if (isconstraintarc(a)) {
+ struct state *sto = a->to;
+
+ assert(sto != s);
+ s->tmp = sto;
+ if (findconstraintloop(nfa, sto)) {
+ return 1;
+ }
+ }
+ }
+
+ /*
+ * If we get here, no constraint loop exists leading out from s. Mark it
+ * with s->tmp == s so we need not rediscover that fact again later.
+ */
+ s->tmp = s;
+ return 0;
+}
+
+/*
+ * breakconstraintloop - break a loop of constraint arcs
+ *
+ * sinitial is any one member state of the loop. Each loop member's tmp
+ * field links to its successor within the loop. (Note that this function
+ * will reset all the tmp fields to NULL.)
+ *
+ * We can break the loop by, for any one state S1 in the loop, cloning its
+ * loop successor state S2 (and possibly following states), and then moving
+ * all S1->S2 constraint arcs to point to the cloned S2. The cloned S2 should
+ * copy any non-constraint outarcs of S2. Constraint outarcs should be
+ * dropped if they point back to S1, else they need to be copied as arcs to
+ * similarly cloned states S3, S4, etc. In general, each cloned state copies
+ * non-constraint outarcs, drops constraint outarcs that would lead to itself
+ * or any earlier cloned state, and sends other constraint outarcs to newly
+ * cloned states. No cloned state will have any inarcs that aren't constraint
+ * arcs or do not lead from S1 or earlier-cloned states. It's okay to drop
+ * constraint back-arcs since they would not take us to any state we've not
+ * already been in; therefore, no new constraint loop is created. In this way
+ * we generate a modified NFA that can still represent every useful state
+ * sequence, but not sequences that represent state loops with no consumption
+ * of input data. Note that the set of cloned states will certainly include
+ * all of the loop member states other than S1, and it may also include
+ * non-loop states that are reachable from S2 via constraint arcs. This is
+ * important because there is no guarantee that findconstraintloop found a
+ * maximal loop (and searching for one would be NP-hard, so don't try).
+ * Frequently the "non-loop states" are actually part of a larger loop that
+ * we didn't notice, and indeed there may be several overlapping loops.
+ * This technique ensures convergence in such cases, while considering only
+ * the originally-found loop does not.
+ *
+ * If there is only one S1->S2 constraint arc, then that constraint is
+ * certainly satisfied when we enter any of the clone states. This means that
+ * in the common case where many of the constraint arcs are identically
+ * labeled, we can merge together clone states linked by a similarly-labeled
+ * constraint: if we can get to the first one we can certainly get to the
+ * second, so there's no need to distinguish. This greatly reduces the number
+ * of new states needed, so we preferentially break the given loop at a state
+ * pair where this is true.
+ *
+ * Furthermore, it's fairly common to find that a cloned successor state has
+ * no outarcs, especially if we're a bit aggressive about removing unnecessary
+ * outarcs. If that happens, then there is simply not any interesting state
+ * that can be reached through the predecessor's loop arcs, which means we can
+ * break the loop just by removing those loop arcs, with no new states added.
+ */
+static void
+breakconstraintloop(struct nfa * nfa, struct state * sinitial)
+{
+ struct state *s;
+ struct state *shead;
+ struct state *stail;
+ struct state *sclone;
+ struct state *nexts;
+ struct arc *refarc;
+ struct arc *a;
+ struct arc *nexta;
+
+ /*
+ * Start by identifying which loop step we want to break at.
+ * Preferentially this is one with only one constraint arc. (XXX are
+ * there any other secondary heuristics we want to use here?) Set refarc
+ * to point to the selected lone constraint arc, if there is one.
+ */
+ refarc = NULL;
+ s = sinitial;
+ do {
+ nexts = s->tmp;
+ assert(nexts != s); /* should not see any one-element loops */
+ if (refarc == NULL) {
+ int narcs = 0;
+
+ for (a = s->outs; a != NULL; a = a->outchain) {
+ if (a->to == nexts && isconstraintarc(a)) {
+ refarc = a;
+ narcs++;
+ }
+ }
+ assert(narcs > 0);
+ if (narcs > 1) {
+ refarc = NULL; /* multiple constraint arcs here, no good */
+ }
+ }
+ s = nexts;
+ } while (s != sinitial);
+
+ if (refarc) {
+ /* break at the refarc */
+ shead = refarc->from;
+ stail = refarc->to;
+ assert(stail == shead->tmp);
+ } else {
+ /* for lack of a better idea, break after sinitial */
+ shead = sinitial;
+ stail = sinitial->tmp;
+ }
+
+ /*
+ * Reset the tmp fields so that we can use them for local storage in
+ * clonesuccessorstates. (findconstraintloop won't mind, since it's just
+ * going to abandon its search anyway.)
+ */
+ for (s = nfa->states; s != NULL; s = s->next) {
+ s->tmp = NULL;
+ }
+
+ /*
+ * Recursively build clone state(s) as needed.
+ */
+ sclone = newstate(nfa);
+ if (sclone == NULL) {
+ assert(NISERR());
return;
}
- if (fromouts < toins) {
- copyins(nfa, from, to, 0);
+
+ clonesuccessorstates(nfa, stail, sclone, shead, refarc,
+ NULL, NULL, nfa->nstates);
+
+ if (NISERR()) {
return;
}
/*
- * 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.
+ * It's possible that sclone has no outarcs at all, in which case it's
+ * useless. (We don't try extremely hard to get rid of useless states
+ * here, but this is an easy and fairly common case.)
+ */
+ if (sclone->nouts == 0) {
+ freestate(nfa, sclone);
+ sclone = NULL;
+ }
+
+ /*
+ * Move shead's constraint-loop arcs to point to sclone, or just drop them
+ * if we discovered we don't need sclone.
*/
- if (from->nins > to->nouts) {
- copyouts(nfa, to, from, 0);
+ for (a = shead->outs; a != NULL; a = nexta) {
+ nexta = a->outchain;
+ if (a->to == stail && isconstraintarc(a)) {
+ if (sclone) {
+ cparc(nfa, a, shead, sclone);
+ }
+ freearc(nfa, a);
+ if (NISERR()) {
+ break;
+ }
+ }
+ }
+}
+
+/*
+ * clonesuccessorstates - create a tree of constraint-arc successor states
+ *
+ * ssource is the state to be cloned, and sclone is the state to copy its
+ * outarcs into. sclone's inarcs, if any, should already be set up.
+ *
+ * spredecessor is the original predecessor state that we are trying to build
+ * successors for (it may not be the immediate predecessor of ssource).
+ * refarc, if not NULL, is the original constraint arc that is known to have
+ * been traversed out of spredecessor to reach the successor(s).
+ *
+ * For each cloned successor state, we transiently create a "donemap" that is
+ * a boolean array showing which source states we've already visited for this
+ * clone state. This prevents infinite recursion as well as useless repeat
+ * visits to the same state subtree (which can add up fast, since typical NFAs
+ * have multiple redundant arc pathways). Each donemap is a char array
+ * indexed by state number. The donemaps are all of the same size "nstates",
+ * which is nfa->nstates as of the start of the recursion. This is enough to
+ * have entries for all pre-existing states, but *not* entries for clone
+ * states created during the recursion. That's okay since we have no need to
+ * mark those.
+ *
+ * curdonemap is NULL when recursing to a new sclone state, or sclone's
+ * donemap when we are recursing without having created a new state (which we
+ * do when we decide we can merge a successor state into the current clone
+ * state). outerdonemap is NULL at the top level and otherwise the parent
+ * clone state's donemap.
+ *
+ * The successor states we create and fill here form a strict tree structure,
+ * with each state having exactly one predecessor, except that the toplevel
+ * state has no inarcs as yet (breakconstraintloop will add its inarcs from
+ * spredecessor after we're done). Thus, we can examine sclone's inarcs back
+ * to the root, plus refarc if any, to identify the set of constraints already
+ * known valid at the current point. This allows us to avoid generating extra
+ * successor states.
+ */
+static void
+clonesuccessorstates(
+ struct nfa * nfa,
+ struct state * ssource,
+ struct state * sclone,
+ struct state * spredecessor,
+ struct arc * refarc,
+ char *curdonemap,
+ char *outerdonemap,
+ int nstates)
+{
+ char *donemap;
+ struct arc *a;
+
+ /* Since this is recursive, it could be driven to stack overflow */
+ if (STACK_TOO_DEEP(nfa->v->re)) {
+ NERR(REG_ETOOBIG);
return;
}
- copyins(nfa, from, to, 0);
+ /* If this state hasn't already got a donemap, create one */
+ donemap = curdonemap;
+ if (donemap == NULL) {
+ donemap = (char *) MALLOC(nstates * sizeof(char));
+ if (donemap == NULL) {
+ NERR(REG_ESPACE);
+ return;
+ }
+
+ if (outerdonemap != NULL) {
+ /*
+ * Not at outermost recursion level, so copy the outer level's
+ * donemap; this ensures that we see states in process of being
+ * visited at outer levels, or already merged into predecessor
+ * states, as ones we shouldn't traverse back to.
+ */
+ memcpy(donemap, outerdonemap, nstates * sizeof(char));
+ } else {
+ /* At outermost level, only spredecessor is off-limits */
+ memset(donemap, 0, nstates * sizeof(char));
+ assert(spredecessor->no < nstates);
+ donemap[spredecessor->no] = 1;
+ }
+ }
+
+ /* Mark ssource as visited in the donemap */
+ assert(ssource->no < nstates);
+ assert(donemap[ssource->no] == 0);
+ donemap[ssource->no] = 1;
+
+ /*
+ * We proceed by first cloning all of ssource's outarcs, creating new
+ * clone states as needed but not doing more with them than that. Then in
+ * a second pass, recurse to process the child clone states. This allows
+ * us to have only one child clone state per reachable source state, even
+ * when there are multiple outarcs leading to the same state. Also, when
+ * we do visit a child state, its set of inarcs is known exactly, which
+ * makes it safe to apply the constraint-is-already-checked optimization.
+ * Also, this ensures that we've merged all the states we can into the
+ * current clone before we recurse to any children, thus possibly saving
+ * them from making extra images of those states.
+ *
+ * While this function runs, child clone states of the current state are
+ * marked by setting their tmp fields to point to the original state they
+ * were cloned from. This makes it possible to detect multiple outarcs
+ * leading to the same state, and also makes it easy to distinguish clone
+ * states from original states (which will have tmp == NULL).
+ */
+ for (a = ssource->outs; a != NULL && !NISERR(); a = a->outchain) {
+ struct state *sto = a->to;
+
+ /*
+ * We do not consider cloning successor states that have no constraint
+ * outarcs; just link to them as-is. They cannot be part of a
+ * constraint loop so there is no need to make copies. In particular,
+ * this rule keeps us from trying to clone the post state, which would
+ * be a bad idea.
+ */
+ if (isconstraintarc(a) && hasconstraintout(sto)) {
+ struct state *prevclone;
+ int canmerge;
+ struct arc *a2;
+
+ /*
+ * Back-link constraint arcs must not be followed. Nor is there a
+ * need to revisit states previously merged into this clone.
+ */
+ assert(sto->no < nstates);
+ if (donemap[sto->no] != 0) {
+ continue;
+ }
+
+ /*
+ * Check whether we already have a child clone state for this
+ * source state.
+ */
+ prevclone = NULL;
+ for (a2 = sclone->outs; a2 != NULL; a2 = a2->outchain) {
+ if (a2->to->tmp == sto) {
+ prevclone = a2->to;
+ break;
+ }
+ }
+
+ /*
+ * If this arc is labeled the same as refarc, or the same as any
+ * arc we must have traversed to get to sclone, then no additional
+ * constraints need to be met to get to sto, so we should just
+ * merge its outarcs into sclone.
+ */
+ if (refarc && a->type == refarc->type && a->co == refarc->co) {
+ canmerge = 1;
+ } else {
+ struct state *s;
+
+ canmerge = 0;
+ for (s = sclone; s->ins; s = s->ins->from) {
+ if (s->nins == 1 &&
+ a->type == s->ins->type && a->co == s->ins->co) {
+ canmerge = 1;
+ break;
+ }
+ }
+ }
+
+ if (canmerge) {
+ /*
+ * We can merge into sclone. If we previously made a child
+ * clone state, drop it; there's no need to visit it. (This
+ * can happen if ssource has multiple pathways to sto, and we
+ * only just now found one that is provably a no-op.)
+ */
+ if (prevclone) {
+ dropstate(nfa, prevclone); /* kills our outarc, too */
+ }
+
+ /* Recurse to merge sto's outarcs into sclone */
+ clonesuccessorstates(nfa, sto, sclone, spredecessor, refarc,
+ donemap, outerdonemap, nstates);
+ /* sto should now be marked as previously visited */
+ assert(NISERR() || donemap[sto->no] == 1);
+ } else if (prevclone) {
+ /*
+ * We already have a clone state for this successor, so just
+ * make another arc to it.
+ */
+ cparc(nfa, a, sclone, prevclone);
+ } else {
+ /*
+ * We need to create a new successor clone state.
+ */
+ struct state *stoclone;
+
+ stoclone = newstate(nfa);
+ if (stoclone == NULL) {
+ assert(NISERR());
+ break;
+ }
+ /* Mark it as to what it's a clone of */
+ stoclone->tmp = sto;
+ /* ... and add the outarc leading to it */
+ cparc(nfa, a, sclone, stoclone);
+ }
+ } else {
+ /*
+ * Non-constraint outarcs just get copied to sclone, as do outarcs
+ * leading to states with no constraint outarc.
+ */
+ cparc(nfa, a, sclone, sto);
+ }
+ }
+
+ /*
+ * If we are at outer level for this clone state, recurse to all its child
+ * clone states, clearing their tmp fields as we go. (If we're not
+ * outermost for sclone, leave this to be done by the outer call level.)
+ * Note that if we have multiple outarcs leading to the same clone state,
+ * it will only be recursed-to once.
+ */
+ if (curdonemap == NULL) {
+ for (a = sclone->outs; a != NULL && !NISERR(); a = a->outchain) {
+ struct state *stoclone = a->to;
+ struct state *sto = stoclone->tmp;
+
+ if (sto != NULL) {
+ stoclone->tmp = NULL;
+ clonesuccessorstates(nfa, sto, stoclone, spredecessor, refarc,
+ NULL, donemap, nstates);
+ }
+ }
+
+ /* Don't forget to free sclone's donemap when done with it */
+ FREE(donemap);
+ }
}
/*
@@ -1630,7 +2795,7 @@ analyze(
}
/*
- - compact - compact an NFA
+ - compact - construct the compact representation of an NFA
^ static void compact(struct nfa *, struct cnfa *);
*/
static void
@@ -1651,13 +2816,16 @@ compact(
narcs = 0;
for (s = nfa->states; s != NULL; s = s->next) {
nstates++;
- narcs += 1 + s->nouts + 1;
- /* 1 as a fake for flags, nouts for arcs, 1 as endmarker */
+ narcs += s->nouts + 1; /* need one extra for endmarker */
}
+ cnfa->stflags = (char *) MALLOC(nstates * sizeof(char));
cnfa->states = (struct carc **) MALLOC(nstates * sizeof(struct carc *));
cnfa->arcs = (struct carc *) MALLOC(narcs * sizeof(struct carc));
- if (cnfa->states == NULL || cnfa->arcs == NULL) {
+ if (cnfa->stflags == NULL || cnfa->states == NULL || cnfa->arcs == NULL) {
+ if (cnfa->stflags != NULL) {
+ FREE(cnfa->stflags);
+ }
if (cnfa->states != NULL) {
FREE(cnfa->states);
}
@@ -1680,9 +2848,8 @@ compact(
ca = cnfa->arcs;
for (s = nfa->states; s != NULL; s = s->next) {
assert((size_t) s->no < nstates);
+ cnfa->stflags[s->no] = 0;
cnfa->states[s->no] = ca;
- ca->co = 0; /* clear and skip flags "arc" */
- ca++;
first = ca;
for (a = s->outs; a != NULL; a = a->outchain) {
switch (a->type) {
@@ -1699,11 +2866,11 @@ compact(
cnfa->flags |= HASLACONS;
break;
default:
- assert(NOTREACHED);
+ NERR(REG_ASSERT);
break;
}
}
- carcsort(first, ca-1);
+ carcsort(first, ca - first);
ca->co = COLORLESS;
ca->to = 0;
ca++;
@@ -1716,40 +2883,46 @@ compact(
*/
for (a = nfa->pre->outs; a != NULL; a = a->outchain) {
- cnfa->states[a->to->no]->co = 1;
+ cnfa->stflags[a->to->no] = CNFA_NOPROGRESS;
}
- cnfa->states[nfa->pre->no]->co = 1;
+ cnfa->stflags[nfa->pre->no] = CNFA_NOPROGRESS;
}
/*
- carcsort - sort compacted-NFA arcs by color
- * Really dumb algorithm, but if the list is long enough for that to matter,
- * you're in real trouble anyway.
^ static void carcsort(struct carc *, struct carc *);
*/
static void
carcsort(
struct carc *first,
- struct carc *last)
+ size_t n)
{
- struct carc *p;
- struct carc *q;
- struct carc tmp;
-
- if (last - first <= 1) {
- return;
+ if (n > 1) {
+ qsort(first, n, sizeof(struct carc), carc_cmp);
}
+}
- for (p = first; p <= last; p++) {
- for (q = p; q <= last; q++) {
- if (p->co > q->co || (p->co == q->co && p->to > q->to)) {
- assert(p != q);
- tmp = *p;
- *p = *q;
- *q = tmp;
- }
- }
+static int
+carc_cmp(
+ const void *a,
+ const void *b)
+{
+ const struct carc *aa = (const struct carc *) a;
+ const struct carc *bb = (const struct carc *) b;
+
+ if (aa->co < bb->co) {
+ return -1;
}
+ if (aa->co > bb->co) {
+ return +1;
+ }
+ if (aa->to < bb->to) {
+ return -1;
+ }
+ if (aa->to > bb->to) {
+ return +1;
+ }
+ return 0;
}
/*
@@ -1762,6 +2935,7 @@ freecnfa(
{
assert(cnfa->nstates != 0); /* not empty already */
cnfa->nstates = 0;
+ FREE(cnfa->stflags);
FREE(cnfa->states);
FREE(cnfa->arcs);
}
@@ -1777,6 +2951,8 @@ dumpnfa(
{
#ifdef REG_DEBUG
struct state *s;
+ int nstates = 0;
+ int narcs = 0;
fprintf(f, "pre %d, post %d", nfa->pre->no, nfa->post->no);
if (nfa->bos[0] != COLORLESS) {
@@ -1794,7 +2970,10 @@ dumpnfa(
fprintf(f, "\n");
for (s = nfa->states; s != NULL; s = s->next) {
dumpstate(s, f);
+ nstates++;
+ narcs += s->nouts;
}
+ fprintf(f, "total of %d states, %d arcs\n", nstates, narcs);
if (nfa->parent == NULL) {
dumpcolors(nfa->cm, f);
}
@@ -1847,37 +3026,28 @@ dumparcs(
FILE *f)
{
int pos;
+ struct arc *a;
- assert(s->nouts > 0);
- /* printing arcs in reverse order is usually clearer */
- pos = dumprarcs(s->outs, s, f, 1);
- if (pos != 1) {
- fprintf(f, "\n");
- }
-}
-
-/*
- - dumprarcs - dump remaining outarcs, recursively, in reverse order
- ^ static int dumprarcs(struct arc *, struct state *, FILE *, int);
- */
-static int /* resulting print position */
-dumprarcs(
- struct arc *a,
- struct state *s,
- FILE *f,
- int pos) /* initial print position */
-{
- if (a->outchain != NULL) {
- pos = dumprarcs(a->outchain, s, f, pos);
+ /* printing oldest arcs first is usually clearer */
+ a = s->outs;
+ assert(a != NULL);
+ while (a->outchain != NULL) {
+ a = a->outchain;
}
- dumparc(a, s, f);
- if (pos == 5) {
+ pos = 1;
+ do {
+ dumparc(a, s, f);
+ if (pos == 5) {
+ fprintf(f, "\n");
+ pos = 1;
+ } else {
+ pos++;
+ }
+ a = a->outchainRev;
+ } while (a != NULL);
+ if (pos != 1) {
fprintf(f, "\n");
- pos = 1;
- } else {
- pos++;
}
- return pos;
}
/*
@@ -1984,7 +3154,7 @@ dumpcnfa(
}
fprintf(f, "\n");
for (st = 0; st < cnfa->nstates; st++) {
- dumpcstate(st, cnfa->states[st], cnfa, f);
+ dumpcstate(st, cnfa, f);
}
fflush(f);
#endif
@@ -1997,25 +3167,24 @@ dumpcnfa(
/*
- dumpcstate - dump a compacted-NFA state in human-readable form
- ^ static void dumpcstate(int, struct carc *, struct cnfa *, FILE *);
+ ^ static void dumpcstate(int, struct cnfa *, FILE *);
*/
static void
dumpcstate(
int st,
- struct carc *ca,
struct cnfa *cnfa,
FILE *f)
{
- int i;
+ struct carc *ca;
int pos;
- fprintf(f, "%d%s", st, (ca[0].co) ? ":" : ".");
+ fprintf(f, "%d%s", st, (cnfa->stflags[st] & CNFA_NOPROGRESS) ? ":" : ".");
pos = 1;
- for (i = 1; ca[i].co != COLORLESS; i++) {
- if (ca[i].co < cnfa->ncolors) {
- fprintf(f, "\t[%ld]->%d", (long) ca[i].co, ca[i].to);
+ for (ca = cnfa->states[st]; ca->co != COLORLESS; ca++) {
+ if (ca->co < cnfa->ncolors) {
+ fprintf(f, "\t[%ld]->%d", (long) ca->co, ca->to);
} else {
- fprintf(f, "\t:%ld:->%d", (long) ca[i].co-cnfa->ncolors,ca[i].to);
+ fprintf(f, "\t:%ld:->%d", (long) (ca->co - cnfa->ncolors), ca->to);
}
if (pos == 5) {
fprintf(f, "\n");
@@ -2024,7 +3193,7 @@ dumpcstate(
pos++;
}
}
- if (i == 1 || pos != 1) {
+ if (ca == cnfa->states[st] || pos != 1) {
fprintf(f, "\n");
}
fflush(f);
diff --git a/generic/regcomp.c b/generic/regcomp.c
index c93eb24..211cd70 100644
--- a/generic/regcomp.c
+++ b/generic/regcomp.c
@@ -83,9 +83,6 @@ static int lexdigits(struct vars *, int, int, int);
static int brenext(struct vars *, pchr);
static void skip(struct vars *);
static chr newline(NOPARMS);
-#ifdef REG_DEBUG
-static const chr *ch(NOPARMS);
-#endif
static chr chrnamed(struct vars *, const chr *, const chr *, pchr);
/* === regc_color.c === */
static void initcm(struct vars *, struct colormap *);
@@ -119,17 +116,22 @@ static void dropstate(struct nfa *, struct state *);
static void freestate(struct nfa *, struct state *);
static void destroystate(struct nfa *, struct state *);
static void newarc(struct nfa *, int, pcolor, struct state *, struct state *);
+static void createarc(struct nfa *, int, pcolor, struct state *, struct state *);
static struct arc *allocarc(struct nfa *, struct state *);
static void freearc(struct nfa *, struct arc *);
+static void changearctarget(struct arc *, struct state *);
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 sortins(struct nfa *, struct state *);
+static int sortins_cmp(const void *, const void *);
+static void sortouts(struct nfa *, struct state *);
+static int sortouts_cmp(const void *, const void *);
static void moveins(struct nfa *, struct state *, struct state *);
-static void copyins(struct nfa *, struct state *, struct state *, int);
+static void copyins(struct nfa *, struct state *, struct state *);
+static void mergeins(struct nfa *, struct state *, struct arc **, int);
static void moveouts(struct nfa *, struct state *, struct state *);
-static void copyouts(struct nfa *, struct state *, struct state *, int);
+static void copyouts(struct nfa *, struct state *, struct state *);
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 *);
@@ -139,33 +141,40 @@ static void cleartraverse(struct nfa *, struct state *);
static void specialcolors(struct nfa *);
static long optimize(struct nfa *, FILE *);
static void pullback(struct nfa *, FILE *);
-static int pull(struct nfa *, struct arc *);
+static int pull(struct nfa *, struct arc *, struct state **);
static void pushfwd(struct nfa *, FILE *);
-static int push(struct nfa *, struct arc *);
+static int push(struct nfa *, struct arc *, struct state **);
#define INCOMPATIBLE 1 /* destroys arc */
#define SATISFIED 2 /* constraint satisfied */
#define COMPATIBLE 3 /* compatible but not satisfied yet */
static int combine(struct arc *, struct arc *);
static void fixempties(struct nfa *, FILE *);
-static struct state *emptyreachable(struct state *, struct state *);
-static void replaceempty(struct nfa *, struct state *, struct state *);
+static struct state *emptyreachable(struct nfa *, struct state *,
+ struct state *, struct arc **);
+static int isconstraintarc(struct arc *);
+static int hasconstraintout(struct state *);
+static void fixconstraintloops(struct nfa *, FILE *);
+static int findconstraintloop(struct nfa *, struct state *);
+static void breakconstraintloop(struct nfa *, struct state *);
+static void clonesuccessorstates(struct nfa *, struct state *, struct state *,
+ struct state *, struct arc *, char *, char *, int);
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 *);
static long analyze(struct nfa *);
static void compact(struct nfa *, struct cnfa *);
-static void carcsort(struct carc *, struct carc *);
+static void carcsort(struct carc *, size_t);
+static int carc_cmp(const void *, const void *);
static void freecnfa(struct cnfa *);
static void dumpnfa(struct nfa *, FILE *);
#ifdef REG_DEBUG
static void dumpstate(struct state *, FILE *);
static void dumparcs(struct state *, FILE *);
-static int dumprarcs(struct arc *, struct state *, FILE *, int);
static void dumparc(struct arc *, struct state *, FILE *);
#endif
static void dumpcnfa(struct cnfa *, FILE *);
#ifdef REG_DEBUG
-static void dumpcstate(int, struct carc *, struct cnfa *, FILE *);
+static void dumpcstate(int, struct cnfa *, FILE *);
#endif
/* === regc_cvec.c === */
static struct cvec *clearcvec(struct cvec *);
@@ -210,11 +219,12 @@ struct vars {
struct subre *tree; /* subexpression tree */
struct subre *treechain; /* all tree nodes allocated */
struct subre *treefree; /* any free tree nodes */
- int ntree; /* number of tree nodes */
+ int ntree; /* number of tree nodes, plus one */
struct cvec *cv; /* interface cvec */
struct cvec *cv2; /* utility cvec */
struct subre *lacons; /* lookahead-constraint vector */
int nlacons; /* size of lacons */
+ size_t spaceused; /* approx. space used for compilation */
};
/* parsing macros; most know that `v' is the struct vars pointer */
@@ -223,13 +233,13 @@ struct vars {
#define EAT(t) (SEE(t) && next(v)) /* if next is this, swallow it */
#define VISERR(vv) ((vv)->err != 0)/* have we seen an error yet? */
#define ISERR() VISERR(v)
-#define VERR(vv,e) \
- ((vv)->nexttype = EOS, ((vv)->err) ? (vv)->err : ((vv)->err = (e)))
+#define VERR(vv,e) ((vv)->nexttype = EOS, \
+ (vv)->err = ((vv)->err ? (vv)->err : (e)))
#define ERR(e) VERR(v, e) /* record an error */
#define NOERR() {if (ISERR()) return;} /* if error seen, return */
#define NOERRN() {if (ISERR()) return NULL;} /* NOERR with retval */
#define NOERRZ() {if (ISERR()) return 0;} /* NOERR with retval */
-#define INSIST(c, e) ((c) ? 0 : ERR(e)) /* if condition false, error */
+#define INSIST(c, e) do { if (!(c)) ERR(e); } while (0) /* error if c false */
#define NOTE(b) (v->re->re_info |= (b)) /* note visible condition */
#define EMPTYARC(x, y) newarc(v->nfa, EMPTY, 0, x, y)
@@ -258,12 +268,14 @@ struct vars {
((a)->type == PLAIN || (a)->type == AHEAD || (a)->type == BEHIND)
/* static function list */
-static struct fns functions = {
+static const struct fns functions = {
rfree, /* regfree insides */
};
/*
- compile - compile regular expression
+ * Note: on failure, no resources remain allocated, so regfree()
+ * need not be applied to re.
^ int compile(regex_t *, const chr *, size_t, int);
*/
int
@@ -324,6 +336,7 @@ compile(
v->cv2 = NULL;
v->lacons = NULL;
v->nlacons = 0;
+ v->spaceused = 0;
re->re_magic = REMAGIC;
re->re_info = 0; /* bits get set during parse */
re->re_csize = sizeof(chr);
@@ -593,13 +606,15 @@ makesearch(
break;
}
}
- if (b != NULL && s->tmp == NULL) {
- /*
- * Must be split if not already in the list (fixes bugs 505048,
- * 230589, 840258, 504785).
- */
- s->tmp = slist;
+ /*
+ * We want to mark states as being in the list already by having non
+ * NULL tmp fields, but we can't just store the old slist value in tmp
+ * because that doesn't work for the first such state. Instead, the
+ * first list entry gets its own address in tmp.
+ */
+ if (b != NULL && s->tmp == NULL) {
+ s->tmp = (slist != NULL) ? slist : s;
slist = s;
}
}
@@ -610,8 +625,9 @@ makesearch(
for (s=slist ; s!=NULL ; s=s2) {
s2 = newstate(nfa);
-
- copyouts(nfa, s, s2, 1);
+ NOERR();
+ copyouts(nfa, s, s2);
+ NOERR();
for (a=s->ins ; a!=NULL ; a=b) {
b = a->inchain;
@@ -620,7 +636,7 @@ makesearch(
freearc(nfa, a);
}
}
- s2 = s->tmp;
+ s2 = (s->tmp != s) ? s->tmp : NULL;
s->tmp = NULL; /* clean up while we're at it */
}
}
@@ -982,6 +998,7 @@ parseqatom(
NOERR();
assert(v->nextvalue > 0);
atom = subre(v, 'b', BACKR, lp, rp);
+ NOERR();
subno = v->nextvalue;
atom->subno = subno;
EMPTYARC(lp, rp); /* temporarily, so there's something */
@@ -996,13 +1013,13 @@ parseqatom(
switch (v->nexttype) {
case '*':
m = 0;
- n = INFINITY;
+ n = DUPINF;
qprefer = (v->nextvalue) ? LONGER : SHORTER;
NEXT();
break;
case '+':
m = 1;
- n = INFINITY;
+ n = DUPINF;
qprefer = (v->nextvalue) ? LONGER : SHORTER;
NEXT();
break;
@@ -1019,7 +1036,7 @@ parseqatom(
if (SEE(DIGIT)) {
n = scannum(v);
} else {
- n = INFINITY;
+ n = DUPINF;
}
if (m > n) {
ERR(REG_BADBR);
@@ -1102,11 +1119,17 @@ parseqatom(
/*
* Prepare a general-purpose state skeleton.
*
- * ---> [s] ---prefix---> [begin] ---atom---> [end] ----rest---> [rp]
- * / /
- * [lp] ----> [s2] ----bypass---------------------
+ * In the no-backrefs case, we want this:
+ *
+ * [lp] ---> [s] ---prefix---> [begin] ---atom---> [end] ---rest---> [rp]
*
- * where bypass is an empty, and prefix is some repetitions of atom
+ * where prefix is some repetitions of atom. In the general case we need
+ *
+ * [lp] ---> [s] ---iterator---> [s2] ---rest---> [rp]
+ *
+ * where the iterator wraps around [begin] ---atom---> [end]
+ *
+ * We make the s state here for both cases; s2 is made below if needed
*/
s = newstate(v->nfa); /* first, new endpoints for the atom */
@@ -1117,11 +1140,9 @@ parseqatom(
NOERR();
atom->begin = s;
atom->end = s2;
- s = newstate(v->nfa); /* and spots for prefix and bypass */
- s2 = newstate(v->nfa);
+ s = newstate(v->nfa); /* set up starting state */
NOERR();
EMPTYARC(lp, s);
- EMPTYARC(lp, s2);
NOERR();
/*
@@ -1129,6 +1150,7 @@ parseqatom(
*/
t = subre(v, '.', COMBINE(qprefer, atom->flags), lp, rp);
+ NOERR();
t->left = atom;
atomp = &t->left;
@@ -1142,6 +1164,7 @@ parseqatom(
assert(top->op == '=' && top->left == NULL && top->right == NULL);
top->left = subre(v, '=', top->flags, top->begin, lp);
+ NOERR();
top->op = '.';
top->right = t;
@@ -1166,27 +1189,8 @@ parseqatom(
}
/*
- * It's quantifier time; first, turn x{0,...} into x{1,...}|empty
- */
-
- if (m == 0) {
- EMPTYARC(s2, atom->end);/* the bypass */
- assert(PREF(qprefer) != 0);
- f = COMBINE(qprefer, atom->flags);
- t = subre(v, '|', f, lp, atom->end);
- NOERR();
- t->left = atom;
- t->right = subre(v, '|', PREF(f), s2, atom->end);
- NOERR();
- t->right->left = subre(v, '=', 0, s2, atom->end);
- NOERR();
- *atomp = t;
- atomp = &t->left;
- m = 1;
- }
-
- /*
- * Deal with the rest of the quantifier.
+ * It's quantifier time. If the atom is just a backref, we'll let it deal
+ * with quantifiers internally.
*/
if (atomtype == BACKREF) {
@@ -1204,21 +1208,29 @@ parseqatom(
atom->min = (short) m;
atom->max = (short) n;
atom->flags |= COMBINE(qprefer, atom->flags);
+ /* rest of branch can be strung starting from atom->end */
+ s2 = atom->end;
} else if (m == 1 && n == 1) {
/*
* No/vacuous quantifier: done.
*/
EMPTYARC(s, atom->begin); /* empty prefix */
- } else {
+ /* rest of branch can be strung starting from atom->end */
+ s2 = atom->end;
+ } else if (m > 0 && !(atom->flags & BACKR)) {
/*
- * Turn x{m,n} into x{m-1,n-1}x, with capturing parens in only second
- * x
+ * If there's no backrefs involved, we can turn x{m,n} into
+ * x{m-1,n-1}x, with capturing parens in only the second x. This
+ * is valid because we only care about capturing matches from the
+ * final iteration of the quantifier. It's a win because we can
+ * implement the backref-free left side as a plain DFA node, since
+ * we don't really care where its submatches are.
*/
dupnfa(v->nfa, atom->begin, atom->end, s, atom->begin);
- assert(m >= 1 && m != INFINITY && n >= 1);
- repeat(v, s, atom->begin, m-1, (n == INFINITY) ? n : n-1);
+ assert(m >= 1 && m != DUPINF && n >= 1);
+ repeat(v, s, atom->begin, m-1, (n == DUPINF) ? n : n-1);
f = COMBINE(qprefer, atom->flags);
t = subre(v, '.', f, s, atom->end); /* prefix and atom */
NOERR();
@@ -1226,6 +1238,24 @@ parseqatom(
NOERR();
t->right = atom;
*atomp = t;
+ /* rest of branch can be strung starting from atom->end */
+ s2 = atom->end;
+ } else {
+ /* general case: need an iteration node */
+ s2 = newstate(v->nfa);
+ NOERR();
+ moveouts(v->nfa, atom->end, s2);
+ NOERR();
+ dupnfa(v->nfa, atom->begin, atom->end, s, s2);
+ repeat(v, s, s2, m, n);
+ f = COMBINE(qprefer, atom->flags);
+ t = subre(v, '*', f, s, s2);
+ NOERR();
+ t->min = (short) m;
+ t->max = (short) n;
+ t->left = atom;
+ *atomp = t;
+ /* rest of branch is to be strung from iteration's end state */
}
/*
@@ -1234,10 +1264,10 @@ parseqatom(
t = top->right;
if (!(SEE('|') || SEE(stopper) || SEE(EOS))) {
- t->right = parsebranch(v, stopper, type, atom->end, rp, 1);
+ t->right = parsebranch(v, stopper, type, s2, rp, 1);
} else {
- EMPTYARC(atom->end, rp);
- t->right = subre(v, '=', 0, atom->end, rp);
+ EMPTYARC(s2, rp);
+ t->right = subre(v, '=', 0, s2, rp);
}
NOERR();
assert(SEE('|') || SEE(stopper) || SEE(EOS));
@@ -1304,6 +1334,8 @@ scannum(
/*
- repeat - replicate subNFA for quantifiers
+ * The sub-NFA strung from lp to rp is modified to represent m to n
+ * repetitions of its initial contents.
* The duplication sequences used here are chosen carefully so that any
* pointers starting out pointing into the subexpression end up pointing into
* the last occurrence. (Note that it may not be strung between the same left
@@ -1323,7 +1355,7 @@ repeat(
#define SOME 2
#define INF 3
#define PAIR(x, y) ((x)*4 + (y))
-#define REDUCE(x) ( ((x) == INFINITY) ? INF : (((x) > 1) ? SOME : (x)) )
+#define REDUCE(x) ( ((x) == DUPINF) ? INF : (((x) > 1) ? SOME : (x)) )
const int rm = REDUCE(m);
const int rn = REDUCE(n);
struct state *s, *s2;
@@ -1713,11 +1745,11 @@ subre(
v->treechain = ret;
}
- assert(strchr("|.b(=", op) != NULL);
+ assert(strchr("=b|.*(", op) != NULL);
ret->op = op;
ret->flags = flags;
- ret->retry = 0;
+ ret->id = 0; /* will be assigned later */
ret->subno = 0;
ret->min = ret->max = 1;
ret->left = NULL;
@@ -1770,7 +1802,8 @@ freesrnode(
}
sr->flags = 0;
- if (v != NULL) {
+ if (v != NULL && v->treechain != NULL) {
+ /* we're still parsing, maybe we can reuse the subre */
sr->left = v->treefree;
v->treefree = sr;
} else {
@@ -1798,7 +1831,7 @@ optst(
}
/*
- - numst - number tree nodes (assigning retry indexes)
+ - numst - number tree nodes (assigning "id" indexes)
^ static int numst(struct subre *, int);
*/
static int /* next number */
@@ -1811,7 +1844,7 @@ numst(
assert(t != NULL);
i = start;
- t->retry = (short) i++;
+ t->id = (short) i++;
if (t->left != NULL) {
i = numst(t->left, i);
}
@@ -1823,6 +1856,19 @@ numst(
/*
- markst - mark tree nodes as INUSE
+ * Note: this is a great deal more subtle than it looks. During initial
+ * parsing of a regex, all subres are linked into the treechain list;
+ * discarded ones are also linked into the treefree list for possible reuse.
+ * After we are done creating all subres required for a regex, we run markst()
+ * then cleanst(), which results in discarding all subres not reachable from
+ * v->tree. We then clear v->treechain, indicating that subres must be found
+ * by descending from v->tree. This changes the behavior of freesubre(): it
+ * will henceforth FREE() unwanted subres rather than sticking them into the
+ * treefree list. (Doing that any earlier would result in dangling links in
+ * the treechain list.) This all means that freev() will clean up correctly
+ * if invoked before or after markst()+cleanst(); but it would not work if
+ * called partway through this state conversion, so we mustn't error out
+ * in or between these two functions.
^ static void markst(struct subre *);
*/
static void
@@ -1929,24 +1975,26 @@ newlacon(
struct state *end,
int pos)
{
- struct subre *sub;
int n;
+ struct subre *newlacons;
+ struct subre *sub;
if (v->nlacons == 0) {
- v->lacons = (struct subre *) MALLOC(2 * sizeof(struct subre));
n = 1; /* skip 0th */
- v->nlacons = 2;
+ newlacons = (struct subre *) MALLOC(2 * sizeof(struct subre));
} else {
- v->lacons = (struct subre *) REALLOC(v->lacons,
- (v->nlacons+1)*sizeof(struct subre));
- n = v->nlacons++;
+ n = v->nlacons;
+ newlacons = (struct subre *) REALLOC(v->lacons,
+ (n + 1) * sizeof(struct subre));
}
- if (v->lacons == NULL) {
+ if (newlacons == NULL) {
ERR(REG_ESPACE);
return 0;
}
+ v->lacons = newlacons;
+ v->nlacons = n + 1;
sub = &v->lacons[n];
sub->begin = begin;
sub->end = end;
@@ -1994,18 +2042,20 @@ rfree(
g = (struct guts *) re->re_guts;
re->re_guts = NULL;
re->re_fns = NULL;
- g->magic = 0;
- freecm(&g->cmap);
- if (g->tree != NULL) {
- freesubre(NULL, g->tree);
- }
- if (g->lacons != NULL) {
- freelacons(g->lacons, g->nlacons);
- }
- if (!NULLCNFA(g->search)) {
- freecnfa(&g->search);
+ if (g != NULL) {
+ g->magic = 0;
+ freecm(&g->cmap);
+ if (g->tree != NULL) {
+ freesubre(NULL, g->tree);
+ }
+ if (g->lacons != NULL) {
+ freelacons(g->lacons, g->nlacons);
+ }
+ if (!NULLCNFA(g->search)) {
+ freecnfa(&g->search);
+ }
+ FREE(g);
}
- FREE(g);
}
/*
@@ -2037,11 +2087,11 @@ dump(
fprintf(f, "\n\n\n========= DUMP ==========\n");
fprintf(f, "nsub %d, info 0%lo, csize %d, ntree %d\n",
- re->re_nsub, re->re_info, re->re_csize, g->ntree);
+ (int) re->re_nsub, re->re_info, re->re_csize, g->ntree);
dumpcolors(&g->cmap, f);
if (!NULLCNFA(g->search)) {
- printf("\nsearch:\n");
+ fprintf(f, "\nsearch:\n");
dumpcnfa(&g->search, f);
}
for (i = 1; i < g->nlacons; i++) {
@@ -2108,7 +2158,7 @@ stdump(
}
if (t->min != 1 || t->max != 1) {
fprintf(f, " {%d,", t->min);
- if (t->max != INFINITY) {
+ if (t->max != DUPINF) {
fprintf(f, "%d", t->max);
}
fprintf(f, "}");
@@ -2146,14 +2196,14 @@ stid(
size_t bufsize)
{
/*
- * Big enough for hex int or decimal t->retry?
+ * Big enough for hex int or decimal t->id?
*/
- if (bufsize < sizeof(void*)*2 + 3 || bufsize < sizeof(t->retry)*3 + 1) {
+ if (bufsize < sizeof(void*)*2 + 3 || bufsize < sizeof(t->id)*3 + 1) {
return "unable";
}
- if (t->retry != 0) {
- sprintf(buf, "%d", t->retry);
+ if (t->id != 0) {
+ sprintf(buf, "%d", t->id);
} else {
sprintf(buf, "%p", t);
}
diff --git a/generic/regcustom.h b/generic/regcustom.h
index 1c970ea..681b97d 100644
--- a/generic/regcustom.h
+++ b/generic/regcustom.h
@@ -60,12 +60,6 @@
#ifdef __REG_REGOFF_T
#undef __REG_REGOFF_T
#endif
-#ifdef __REG_VOID_T
-#undef __REG_VOID_T
-#endif
-#ifdef __REG_CONST
-#undef __REG_CONST
-#endif
#ifdef __REG_NOFRONT
#undef __REG_NOFRONT
#endif
@@ -75,8 +69,6 @@
/* Interface types */
#define __REG_WIDE_T Tcl_UniChar
#define __REG_REGOFF_T long /* Not really right, but good enough... */
-#define __REG_VOID_T void
-#define __REG_CONST const
/* Names and declarations */
#define __REG_WIDE_COMPILE TclReComp
#define __REG_WIDE_EXEC TclReExec
diff --git a/generic/rege_dfa.c b/generic/rege_dfa.c
index 920ea6c..e5f22c4 100644
--- a/generic/rege_dfa.c
+++ b/generic/rege_dfa.c
@@ -84,7 +84,7 @@ longest(
if (v->eflags&REG_FTRACE) {
while (cp < realstop) {
- FDEBUG(("+++ at c%d +++\n", css - d->ssets));
+ FDEBUG(("+++ at c%d +++\n", (int) (css - d->ssets)));
co = GETCOLOR(cm, *cp);
FDEBUG(("char %c, color %ld\n", (char)*cp, (long)co));
ss = css->outs[co];
@@ -118,7 +118,7 @@ longest(
* Shutdown.
*/
- FDEBUG(("+++ shutdown at c%d +++\n", css - d->ssets));
+ FDEBUG(("+++ shutdown at c%d +++\n", (int) (css - d->ssets)));
if (cp == v->stop && stop == v->stop) {
if (hitstopp != NULL) {
*hitstopp = 1;
@@ -213,7 +213,7 @@ shortest(
if (v->eflags&REG_FTRACE) {
while (cp < realmax) {
- FDEBUG(("--- at c%d ---\n", css - d->ssets));
+ FDEBUG(("--- at c%d ---\n", (int) (css - d->ssets)));
co = GETCOLOR(cm, *cp);
FDEBUG(("char %c, color %ld\n", (char)*cp, (long)co));
ss = css->outs[co];
@@ -516,14 +516,14 @@ miss(
gotState = 0;
for (i = 0; i < d->nstates; i++) {
if (ISBSET(css->states, i)) {
- for (ca = cnfa->states[i]+1; ca->co != COLORLESS; ca++) {
+ for (ca = cnfa->states[i]; ca->co != COLORLESS; ca++) {
if (ca->co == co) {
BSET(d->work, ca->to);
gotState = 1;
if (ca->to == cnfa->post) {
isPost = 1;
}
- if (!cnfa->states[ca->to]->co) {
+ if (!(cnfa->stflags[ca->to] & CNFA_NOPROGRESS)) {
noProgress = 0;
}
FDEBUG(("%d -> %d\n", i, ca->to));
@@ -537,8 +537,8 @@ miss(
doLAConstraints = 0;
for (i = 0; i < d->nstates; i++) {
if (ISBSET(d->work, i)) {
- for (ca = cnfa->states[i]+1; ca->co != COLORLESS; ca++) {
- if (ca->co <= cnfa->ncolors) {
+ for (ca = cnfa->states[i]; ca->co != COLORLESS; ca++) {
+ if (ca->co < cnfa->ncolors) {
continue; /* NOTE CONTINUE */
}
sawLAConstraints = 1;
@@ -553,7 +553,7 @@ miss(
if (ca->to == cnfa->post) {
isPost = 1;
}
- if (!cnfa->states[ca->to]->co) {
+ if (!(cnfa->stflags[ca->to] & CNFA_NOPROGRESS)) {
noProgress = 0;
}
FDEBUG(("%d :> %d\n", i, ca->to));
@@ -572,7 +572,7 @@ miss(
for (p = d->ssets, i = d->nssused; i > 0; p++, i--) {
if (HIT(h, d->work, p, d->wordsper)) {
- FDEBUG(("cached c%d\n", p - d->ssets));
+ FDEBUG(("cached c%d\n", (int) (p - d->ssets)));
break; /* NOTE BREAK OUT */
}
}
@@ -594,7 +594,8 @@ miss(
}
if (!sawLAConstraints) { /* lookahead conds. always cache miss */
- FDEBUG(("c%d[%d]->c%d\n", css - d->ssets, co, p - d->ssets));
+ FDEBUG(("c%d[%d]->c%d\n",
+ (int) (css - d->ssets), co, (int) (p - d->ssets)));
css->outs[co] = p;
css->inchain[co] = p->ins;
p->ins.ss = css;
@@ -663,7 +664,7 @@ getVacantSS(
ap = ss->ins;
while ((p = ap.ss) != NULL) {
co = ap.co;
- FDEBUG(("zapping c%d's %ld outarc\n", p - d->ssets, (long)co));
+ FDEBUG(("zapping c%d's %ld outarc\n", (int) (p - d->ssets), (long)co));
p->outs[co] = NULL;
ap = p->inchain[co];
p->inchain[co].ss = NULL; /* paranoia */
@@ -680,7 +681,7 @@ getVacantSS(
if (p == NULL) {
continue; /* NOTE CONTINUE */
}
- FDEBUG(("del outarc %d from c%d's in chn\n", i, p - d->ssets));
+ FDEBUG(("del outarc %d from c%d's in chn\n", i, (int) (p - d->ssets)));
if (p->ins.ss == ss && p->ins.co == i) {
p->ins = ss->inchain[i];
} else {
@@ -772,7 +773,7 @@ pickNextSS(
if ((ss->lastseen == NULL || ss->lastseen < ancient)
&& !(ss->flags&LOCKED)) {
d->search = ss + 1;
- FDEBUG(("replacing c%d\n", ss - d->ssets));
+ FDEBUG(("replacing c%d\n", (int) (ss - d->ssets)));
return ss;
}
}
@@ -780,7 +781,7 @@ pickNextSS(
if ((ss->lastseen == NULL || ss->lastseen < ancient)
&& !(ss->flags&LOCKED)) {
d->search = ss + 1;
- FDEBUG(("replacing c%d\n", ss - d->ssets));
+ FDEBUG(("replacing c%d\n", (int) (ss - d->ssets)));
return ss;
}
}
diff --git a/generic/regerror.c b/generic/regerror.c
index a1a0163..49d93ed 100644
--- a/generic/regerror.c
+++ b/generic/regerror.c
@@ -41,7 +41,7 @@ static const char unk[] = "*** unknown regex error code 0x%x ***";
* Struct to map among codes, code names, and explanations.
*/
-static struct rerr {
+static const struct rerr {
int code;
const char *name;
const char *explain;
@@ -62,7 +62,7 @@ regerror(
char *errbuf, /* Result buffer (unless errbuf_size==0) */
size_t errbuf_size) /* Available space in errbuf, can be 0 */
{
- struct rerr *r;
+ const struct rerr *r;
const char *msg;
char convbuf[sizeof(unk)+50]; /* 50 = plenty for int */
size_t len;
diff --git a/generic/regerrs.h b/generic/regerrs.h
index 72548ff..ee203d5 100644
--- a/generic/regerrs.h
+++ b/generic/regerrs.h
@@ -16,5 +16,5 @@
{ REG_INVARG, "REG_INVARG", "invalid argument to regex function" },
{ 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_ETOOBIG, "REG_ETOOBIG", "regular expression is too complex" },
{ REG_ECOLORS, "REG_ECOLORS", "too many colors" },
diff --git a/generic/regex.h b/generic/regex.h
index 9466fbb..8845f72 100644
--- a/generic/regex.h
+++ b/generic/regex.h
@@ -92,12 +92,6 @@ extern "C" {
#ifdef __REG_REGOFF_T
#undef __REG_REGOFF_T
#endif
-#ifdef __REG_VOID_T
-#undef __REG_VOID_T
-#endif
-#ifdef __REG_CONST
-#undef __REG_CONST
-#endif
#ifdef __REG_NOFRONT
#undef __REG_NOFRONT
#endif
@@ -107,8 +101,6 @@ extern "C" {
/* interface types */
#define __REG_WIDE_T Tcl_UniChar
#define __REG_REGOFF_T long /* not really right, but good enough... */
-#define __REG_VOID_T void
-#define __REG_CONST const
/* names and declarations */
#define __REG_WIDE_COMPILE TclReComp
#define __REG_WIDE_EXEC TclReExec
@@ -134,26 +126,6 @@ typedef long regoff_t;
#endif
/*
- * For benefit of old compilers, we offer <sys/types.h> the option of
- * overriding the `void' type used to declare nonexistent return types.
- */
-#ifdef __REG_VOID_T
-typedef __REG_VOID_T re_void;
-#else
-typedef void re_void;
-#endif
-
-/*
- * Also for benefit of old compilers, <sys/types.h> can supply a macro which
- * expands to a substitute for `const'.
- */
-#ifndef __REG_CONST
-#define __REG_CONST const
-#endif
-
-
-
-/*
* other interface types
*/
@@ -197,13 +169,13 @@ typedef struct {
/*
* compilation
^ #ifndef __REG_NOCHAR
- ^ int re_comp(regex_t *, __REG_CONST char *, size_t, int);
+ ^ int re_comp(regex_t *, const char *, size_t, int);
^ #endif
^ #ifndef __REG_NOFRONT
- ^ int regcomp(regex_t *, __REG_CONST char *, int);
+ ^ int regcomp(regex_t *, const char *, int);
^ #endif
^ #ifdef __REG_WIDE_T
- ^ int __REG_WIDE_COMPILE(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int);
+ ^ int __REG_WIDE_COMPILE(regex_t *, const __REG_WIDE_T *, size_t, int);
^ #endif
*/
#define REG_BASIC 000000 /* BREs (convenience) */
@@ -228,14 +200,14 @@ typedef struct {
/*
* execution
^ #ifndef __REG_NOCHAR
- ^ int re_exec(regex_t *, __REG_CONST char *, size_t,
+ ^ int re_exec(regex_t *, const char *, size_t,
^ rm_detail_t *, size_t, regmatch_t [], int);
^ #endif
^ #ifndef __REG_NOFRONT
- ^ int regexec(regex_t *, __REG_CONST char *, size_t, regmatch_t [], int);
+ ^ int regexec(regex_t *, const char *, size_t, regmatch_t [], int);
^ #endif
^ #ifdef __REG_WIDE_T
- ^ int __REG_WIDE_EXEC(regex_t *, __REG_CONST __REG_WIDE_T *, size_t,
+ ^ int __REG_WIDE_EXEC(regex_t *, const __REG_WIDE_T *, size_t,
^ rm_detail_t *, size_t, regmatch_t [], int);
^ #endif
*/
@@ -248,7 +220,7 @@ typedef struct {
/*
* misc generics (may be more functions here eventually)
- ^ re_void regfree(regex_t *);
+ ^ void regfree(regex_t *);
*/
/*
@@ -260,7 +232,7 @@ typedef struct {
* of character is used for error reports is independent of what kind is used
* in matching.
*
- ^ extern size_t regerror(int, __REG_CONST regex_t *, char *, size_t);
+ ^ extern size_t regerror(int, const regex_t *, char *, size_t);
*/
#define REG_OKAY 0 /* no errors detected */
#define REG_NOMATCH 1 /* failed to match */
@@ -280,7 +252,7 @@ typedef struct {
#define REG_INVARG 16 /* invalid argument to regex function */
#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_ETOOBIG 19 /* regular expression is too complex */
#define REG_ECOLORS 20 /* too many colors */
/* two specials for debugging and testing */
#define REG_ATOI 101 /* convert error-code name to number */
@@ -293,25 +265,25 @@ typedef struct {
/* automatically gathered by fwd; do not hand-edit */
/* === regproto.h === */
#ifndef __REG_NOCHAR
-int re_comp(regex_t *, __REG_CONST char *, size_t, int);
+int re_comp(regex_t *, const char *, size_t, int);
#endif
#ifndef __REG_NOFRONT
-int regcomp(regex_t *, __REG_CONST char *, int);
+int regcomp(regex_t *, const char *, int);
#endif
#ifdef __REG_WIDE_T
-MODULE_SCOPE int __REG_WIDE_COMPILE(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int);
+MODULE_SCOPE int __REG_WIDE_COMPILE(regex_t *, const __REG_WIDE_T *, size_t, int);
#endif
#ifndef __REG_NOCHAR
-int re_exec(regex_t *, __REG_CONST char *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
+int re_exec(regex_t *, const char *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
#endif
#ifndef __REG_NOFRONT
-int regexec(regex_t *, __REG_CONST char *, size_t, regmatch_t [], int);
+int regexec(regex_t *, const char *, size_t, regmatch_t [], int);
#endif
#ifdef __REG_WIDE_T
-MODULE_SCOPE int __REG_WIDE_EXEC(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
+MODULE_SCOPE int __REG_WIDE_EXEC(regex_t *, const __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
#endif
-MODULE_SCOPE re_void regfree(regex_t *);
-MODULE_SCOPE size_t regerror(int, __REG_CONST regex_t *, char *, size_t);
+MODULE_SCOPE void regfree(regex_t *);
+MODULE_SCOPE size_t regerror(int, const regex_t *, char *, size_t);
/* automatically gathered by fwd; do not hand-edit */
/* =====^!^===== end forwards =====^!^===== */
diff --git a/generic/regexec.c b/generic/regexec.c
index ad4b6e6..6d12827 100644
--- a/generic/regexec.c
+++ b/generic/regexec.c
@@ -107,13 +107,13 @@ struct vars {
chr *start; /* start of string */
chr *stop; /* just past end of string */
int err; /* error code if any (0 none) */
- regoff_t *mem; /* memory vector for backtracking */
+ struct dfa **subdfas; /* per-subre DFAs */
struct smalldfa dfa1;
struct smalldfa dfa2;
};
#define VISERR(vv) ((vv)->err != 0) /* have we seen an error yet? */
#define ISERR() VISERR(v)
-#define VERR(vv,e) (((vv)->err) ? (vv)->err : ((vv)->err = (e)))
+#define VERR(vv,e) ((vv)->err = ((vv)->err ? (vv)->err : (e)))
#define ERR(e) VERR(v, e) /* record an error */
#define NOERR() {if (ISERR()) return v->err;} /* if error seen, return it */
#define OFF(p) ((p) - v->start)
@@ -126,21 +126,20 @@ struct vars {
/* automatically gathered by fwd; do not hand-edit */
/* === regexec.c === */
int exec(regex_t *, const chr *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
+static struct dfa *getsubdfa(struct vars *, struct subre *);
static int simpleFind(struct vars *const, struct cnfa *const, struct colormap *const);
static int complicatedFind(struct vars *const, struct cnfa *const, struct colormap *const);
static int complicatedFindLoop(struct vars *const, struct cnfa *const, struct colormap *const, struct dfa *const, struct dfa *const, chr **const);
-static void zapSubexpressions(regmatch_t *const, const size_t);
-static void zapSubtree(struct vars *const, struct subre *const);
+static void zapallsubs(regmatch_t *const, const size_t);
+static void zaptreesubs(struct vars *const, struct subre *const);
static void subset(struct vars *const, struct subre *const, chr *const, chr *const);
-static int dissect(struct vars *const, struct subre *, chr *const, chr *const);
-static int concatenationDissect(struct vars *const, struct subre *const, chr *const, chr *const);
-static int alternationDissect(struct vars *const, struct subre *, chr *const, chr *const);
-static inline int complicatedDissect(struct vars *const, struct subre *const, chr *const, chr *const);
-static int complicatedCapturingDissect(struct vars *const, struct subre *const, chr *const, chr *const);
-static int complicatedConcatenationDissect(struct vars *const, struct subre *const, chr *const, chr *const);
-static int complicatedReversedDissect(struct vars *const, struct subre *const, chr *const, chr *const);
-static int complicatedBackrefDissect(struct vars *const, struct subre *const, chr *const, chr *const);
-static int complicatedAlternationDissect(struct vars *const, struct subre *, chr *const, chr *const);
+static int cdissect(struct vars *, struct subre *, chr *, chr *);
+static int ccondissect(struct vars *, struct subre *, chr *, chr *);
+static int crevcondissect(struct vars *, struct subre *, chr *, chr *);
+static int cbrdissect(struct vars *, struct subre *, chr *, chr *);
+static int caltdissect(struct vars *, struct subre *, chr *, chr *);
+static int citerdissect(struct vars *, struct subre *, chr *, chr *);
+static int creviterdissect(struct vars *, struct subre *, chr *, chr *);
/* === rege_dfa.c === */
static chr *longest(struct vars *const, struct dfa *const, chr *const, chr *const, int *const);
static chr *shortest(struct vars *const, struct dfa *const, chr *const, chr *const, chr *const, chr **const, int *const);
@@ -174,10 +173,11 @@ exec(
AllocVars(v);
int st, backref;
size_t n;
+ size_t i;
#define LOCALMAT 20
regmatch_t mat[LOCALMAT];
-#define LOCALMEM 40
- regoff_t mem[LOCALMEM];
+#define LOCALDFAS 40
+ struct dfa *subdfas[LOCALDFAS];
/*
* Sanity checks.
@@ -235,28 +235,20 @@ exec(
v->start = (chr *)string;
v->stop = (chr *)string + len;
v->err = 0;
- if (backref) {
- /*
- * Need retry memory.
- */
-
- assert(v->g->ntree >= 0);
- n = (size_t)v->g->ntree;
- if (n <= LOCALMEM) {
- v->mem = mem;
- } else {
- v->mem = (regoff_t *) MALLOC(n*sizeof(regoff_t));
- }
- if (v->mem == NULL) {
- if (v->pmatch != pmatch && v->pmatch != mat) {
- FREE(v->pmatch);
- }
- FreeVars(v);
- return REG_ESPACE;
- }
- } else {
- v->mem = NULL;
+ assert(v->g->ntree >= 0);
+ n = (size_t) v->g->ntree;
+ if (n <= LOCALDFAS)
+ v->subdfas = subdfas;
+ else
+ v->subdfas = (struct dfa **) MALLOC(n * sizeof(struct dfa *));
+ if (v->subdfas == NULL) {
+ if (v->pmatch != pmatch && v->pmatch != mat)
+ FREE(v->pmatch);
+ FreeVars(v);
+ return REG_ESPACE;
}
+ for (i = 0; i < n; i++)
+ v->subdfas[i] = NULL;
/*
* Do it.
@@ -274,7 +266,7 @@ exec(
*/
if (st == REG_OKAY && v->pmatch != pmatch && nmatch > 0) {
- zapSubexpressions(pmatch, nmatch);
+ zapallsubs(pmatch, nmatch);
n = (nmatch < v->nmatch) ? nmatch : v->nmatch;
memcpy(VS(pmatch), VS(v->pmatch), n*sizeof(regmatch_t));
}
@@ -286,14 +278,35 @@ exec(
if (v->pmatch != pmatch && v->pmatch != mat) {
FREE(v->pmatch);
}
- if (v->mem != NULL && v->mem != mem) {
- FREE(v->mem);
+ n = (size_t) v->g->ntree;
+ for (i = 0; i < n; i++) {
+ if (v->subdfas[i] != NULL)
+ freeDFA(v->subdfas[i]);
}
+ if (v->subdfas != subdfas)
+ FREE(v->subdfas);
FreeVars(v);
return st;
}
/*
+ - getsubdfa - create or re-fetch the DFA for a subre node
+ * We only need to create the DFA once per overall regex execution.
+ * The DFA will be freed by the cleanup step in exec().
+ */
+static struct dfa *
+getsubdfa(struct vars * v,
+ struct subre * t)
+{
+ if (v->subdfas[t->id] == NULL) {
+ v->subdfas[t->id] = newDFA(v, &t->cnfa, &v->g->cmap, DOMALLOC);
+ if (ISERR())
+ return NULL;
+ }
+ return v->subdfas[t->id];
+}
+
+/*
- simpleFind - find a match for the main NFA (no-complications case)
^ static int simpleFind(struct vars *, struct cnfa *, struct colormap *);
*/
@@ -357,7 +370,10 @@ simpleFind(
} else {
end = longest(v, d, begin, v->stop, &hitend);
}
- NOERR();
+ if (ISERR()) {
+ freeDFA(d);
+ return v->err;
+ }
if (hitend && cold == NULL) {
cold = begin;
}
@@ -388,11 +404,11 @@ simpleFind(
}
/*
- * Submatches.
+ * Find submatches.
*/
- zapSubexpressions(v->pmatch, v->nmatch);
- return dissect(v, v->g->tree, begin, end);
+ zapallsubs(v->pmatch, v->nmatch);
+ return cdissect(v, v->g->tree, begin, end);
}
/*
@@ -488,9 +504,8 @@ complicatedFindLoop(
}
MDEBUG(("tentative end %ld\n", LOFF(end)));
- zapSubexpressions(v->pmatch, v->nmatch);
- zapSubtree(v, v->g->tree);
- er = complicatedDissect(v, v->g->tree, begin, end);
+ zapallsubs(v->pmatch, v->nmatch);
+ er = cdissect(v, v->g->tree, begin, end);
if (er == REG_OKAY) {
if (v->nmatch > 0) {
v->pmatch[0].rm_so = OFF(begin);
@@ -501,6 +516,7 @@ complicatedFindLoop(
}
if (er != REG_NOMATCH) {
ERR(er);
+ *coldp = cold;
return er;
}
if ((shorter) ? end == estop : end == begin) {
@@ -525,11 +541,11 @@ complicatedFindLoop(
}
/*
- - zapSubexpressions - initialize the subexpression matches to "no match"
- ^ static void zapSubexpressions(regmatch_t *, size_t);
+ - zapallsubs - initialize all subexpression matches to "no match"
+ ^ static void zapallsubs(regmatch_t *, size_t);
*/
static void
-zapSubexpressions(
+zapallsubs(
regmatch_t *const p,
const size_t n)
{
@@ -542,36 +558,33 @@ zapSubexpressions(
}
/*
- - zapSubtree - initialize the retry memory of a subtree to zeros
- ^ static void zapSubtree(struct vars *, struct subre *);
+ - zaptreesubs - initialize subexpressions within subtree to "no match"
+ ^ static void zaptreesubs(struct vars *, struct subre *);
*/
static void
-zapSubtree(
+zaptreesubs(
struct vars *const v,
struct subre *const t)
{
- if (t == NULL) {
- return;
- }
-
- assert(v->mem != NULL);
- v->mem[t->retry] = 0;
if (t->op == '(') {
- assert(t->subno > 0);
- v->pmatch[t->subno].rm_so = -1;
- v->pmatch[t->subno].rm_eo = -1;
+ int n = t->subno;
+ assert(n > 0);
+ if ((size_t) n < v->nmatch) {
+ v->pmatch[n].rm_so = -1;
+ v->pmatch[n].rm_eo = -1;
+ }
}
if (t->left != NULL) {
- zapSubtree(v, t->left);
+ zaptreesubs(v, t->left);
}
if (t->right != NULL) {
- zapSubtree(v, t->right);
+ zaptreesubs(v, t->right);
}
}
/*
- - subset - set any subexpression relevant to a successful subre
+ - subset - set subexpression match data for a successful subre
^ static void subset(struct vars *, struct subre *, chr *, chr *);
*/
static void
@@ -594,247 +607,91 @@ subset(
}
/*
- - dissect - determine subexpression matches (uncomplicated case)
- ^ static int dissect(struct vars *, struct subre *, chr *, chr *);
+ - cdissect - check backrefs and determine subexpression matches
+ * cdissect recursively processes a subre tree to check matching of backrefs
+ * and/or identify submatch boundaries for capture nodes. The proposed match
+ * runs from "begin" to "end" (not including "end"), and we are basically
+ * "dissecting" it to see where the submatches are.
+ * Before calling any level of cdissect, the caller must have run the node's
+ * DFA and found that the proposed substring satisfies the DFA. (We make
+ * the caller do that because in concatenation and iteration nodes, it's
+ * much faster to check all the substrings against the child DFAs before we
+ * recurse.) Also, caller must have cleared subexpression match data via
+ * zaptreesubs (or zapallsubs at the top level).
+ ^ static int cdissect(struct vars *, struct subre *, chr *, chr *);
*/
static int /* regexec return code */
-dissect(
- struct vars *const v,
+cdissect(
+ struct vars *v,
struct subre *t,
- chr *const begin, /* beginning of relevant substring */
- chr *const end) /* end of same */
+ chr *begin, /* beginning of relevant substring */
+ chr *end) /* end of same */
{
-#ifndef COMPILER_DOES_TAILCALL_OPTIMIZATION
- restart:
-#endif
- assert(t != NULL);
- MDEBUG(("dissect %ld-%ld\n", LOFF(begin), LOFF(end)));
-
- switch (t->op) {
- case '=': /* terminal node */
- assert(t->left == NULL && t->right == NULL);
- return REG_OKAY; /* no action, parent did the work */
- case '|': /* alternation */
- assert(t->left != NULL);
- return alternationDissect(v, t, begin, end);
- case 'b': /* back ref -- shouldn't be calling us! */
- return REG_ASSERT;
- case '.': /* concatenation */
- assert(t->left != NULL && t->right != NULL);
- return concatenationDissect(v, t, begin, end);
- case '(': /* capturing */
- assert(t->left != NULL && t->right == NULL);
- assert(t->subno > 0);
- subset(v, t, begin, end);
-#ifndef COMPILER_DOES_TAILCALL_OPTIMIZATION
- t = t->left;
- goto restart;
-#else
- return dissect(v, t->left, begin, end);
-#endif
- default:
- return REG_ASSERT;
- }
-}
-
-/*
- - concatenationDissect - determine concatenation subexpression matches
- - (uncomplicated)
- ^ static int concatenationDissect(struct vars *, struct subre *, chr *, chr *);
- */
-static int /* regexec return code */
-concatenationDissect(
- struct vars *const v,
- struct subre *const t,
- chr *const begin, /* beginning of relevant substring */
- chr *const end) /* end of same */
-{
- struct dfa *d, *d2;
- chr *mid;
- int i;
- int shorter = (t->left->flags&SHORTER) ? 1 : 0;
- chr *stop = (shorter) ? end : begin;
-
- assert(t->op == '.');
- assert(t->left != NULL && t->left->cnfa.nstates > 0);
- assert(t->right != NULL && t->right->cnfa.nstates > 0);
-
- d = newDFA(v, &t->left->cnfa, &v->g->cmap, &v->dfa1);
- NOERR();
- d2 = newDFA(v, &t->right->cnfa, &v->g->cmap, &v->dfa2);
- if (ISERR()) {
- assert(d2 == NULL);
- freeDFA(d);
- return v->err;
- }
-
- /*
- * Pick a tentative midpoint.
- */
-
- if (shorter) {
- mid = shortest(v, d, begin, begin, end, NULL, NULL);
- } else {
- mid = longest(v, d, begin, end, NULL);
- }
- if (mid == NULL) {
- freeDFA(d);
- freeDFA(d2);
- return REG_ASSERT;
- }
- MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
-
- /*
- * Iterate until satisfaction or failure.
- */
-
- while (longest(v, d2, mid, end, NULL) != end) {
- /*
- * That midpoint didn't work, find a new one.
- */
-
- if (mid == stop) {
- /*
- * All possibilities exhausted!
- */
-
- MDEBUG(("no midpoint!\n"));
- freeDFA(d);
- freeDFA(d2);
- return REG_ASSERT;
- }
- if (shorter) {
- mid = shortest(v, d, begin, mid+1, end, NULL, NULL);
- } else {
- mid = longest(v, d, begin, mid-1, NULL);
- }
- if (mid == NULL) {
- /*
- * Failed to find a new one!
- */
-
- MDEBUG(("failed midpoint!\n"));
- freeDFA(d);
- freeDFA(d2);
- return REG_ASSERT;
- }
- MDEBUG(("new midpoint %ld\n", LOFF(mid)));
- }
-
- /*
- * Satisfaction.
- */
-
- MDEBUG(("successful\n"));
- freeDFA(d);
- freeDFA(d2);
- i = dissect(v, t->left, begin, mid);
- if (i != REG_OKAY) {
- return i;
- }
- return dissect(v, t->right, mid, end);
-}
-
-/*
- - alternationDissect - determine alternative subexpression matches (uncomplicated)
- ^ static int alternationDissect(struct vars *, struct subre *, chr *, chr *);
- */
-static int /* regexec return code */
-alternationDissect(
- struct vars *const v,
- struct subre *t,
- chr *const begin, /* beginning of relevant substring */
- chr *const end) /* end of same */
-{
- int i;
-
- assert(t != NULL);
- assert(t->op == '|');
-
- for (i = 0; t != NULL; t = t->right, i++) {
- struct dfa *d;
+ int er;
- MDEBUG(("trying %dth\n", i));
- assert(t->left != NULL && t->left->cnfa.nstates > 0);
- d = newDFA(v, &t->left->cnfa, &v->g->cmap, &v->dfa1);
- if (ISERR()) {
- return v->err;
- }
- if (longest(v, d, begin, end, NULL) == end) {
- MDEBUG(("success\n"));
- freeDFA(d);
- return dissect(v, t->left, begin, end);
- }
- freeDFA(d);
- }
- return REG_ASSERT; /* none of them matched?!? */
-}
-
-/*
- - complicatedDissect - determine subexpression matches (with complications)
- * The retry memory stores the offset of the trial midpoint from begin, plus 1
- * so that 0 uniquely means "clean slate".
- ^ static int complicatedDissect(struct vars *, struct subre *, chr *, chr *);
- */
-static inline int /* regexec return code */
-complicatedDissect(
- struct vars *const v,
- struct subre *const t,
- chr *const begin, /* beginning of relevant substring */
- chr *const end) /* end of same */
-{
assert(t != NULL);
- MDEBUG(("complicatedDissect %ld-%ld %c\n", LOFF(begin), LOFF(end), t->op));
+ MDEBUG(("cdissect %ld-%ld %c\n", LOFF(begin), LOFF(end), t->op));
switch (t->op) {
case '=': /* terminal node */
assert(t->left == NULL && t->right == NULL);
- return REG_OKAY; /* no action, parent did the work */
- case '|': /* alternation */
- assert(t->left != NULL);
- return complicatedAlternationDissect(v, t, begin, end);
- case 'b': /* back ref -- shouldn't be calling us! */
+ er = REG_OKAY; /* no action, parent did the work */
+ break;
+ case 'b': /* back reference */
assert(t->left == NULL && t->right == NULL);
- return complicatedBackrefDissect(v, t, begin, end);
+ er = cbrdissect(v, t, begin, end);
+ break;
case '.': /* concatenation */
assert(t->left != NULL && t->right != NULL);
- return complicatedConcatenationDissect(v, t, begin, end);
+ if (t->left->flags & SHORTER) /* reverse scan */
+ er = crevcondissect(v, t, begin, end);
+ else
+ er = ccondissect(v, t, begin, end);
+ break;
+ case '|': /* alternation */
+ assert(t->left != NULL);
+ er = caltdissect(v, t, begin, end);
+ break;
+ case '*': /* iteration */
+ assert(t->left != NULL);
+ if (t->left->flags & SHORTER) /* reverse scan */
+ er = creviterdissect(v, t, begin, end);
+ else
+ er = citerdissect(v, t, begin, end);
+ break;
case '(': /* capturing */
assert(t->left != NULL && t->right == NULL);
assert(t->subno > 0);
- return complicatedCapturingDissect(v, t, begin, end);
+ er = cdissect(v, t->left, begin, end);
+ if (er == REG_OKAY) {
+ subset(v, t, begin, end);
+ }
+ break;
default:
- return REG_ASSERT;
+ er = REG_ASSERT;
+ break;
}
-}
-static int /* regexec return code */
-complicatedCapturingDissect(
- struct vars *const v,
- struct subre *const t,
- chr *const begin, /* beginning of relevant substring */
- chr *const end) /* end of same */
-{
- int er = complicatedDissect(v, t->left, begin, end);
+ /*
+ * We should never have a match failure unless backrefs lurk below;
+ * otherwise, either caller failed to check the DFA, or there's some
+ * inconsistency between the DFA and the node's innards.
+ */
+ assert(er != REG_NOMATCH || (t->flags & BACKR));
- if (er == REG_OKAY) {
- subset(v, t, begin, end);
- }
return er;
}
/*
- - complicatedConcatenationDissect - concatenation subexpression matches (with complications)
- * The retry memory stores the offset of the trial midpoint from begin, plus 1
- * so that 0 uniquely means "clean slate".
- ^ static int complicatedConcatenationDissect(struct vars *, struct subre *, chr *, chr *);
+ - ccondissect - dissect match for concatenation node
+ ^ static int ccondissect(struct vars *, struct subre *, chr *, chr *);
*/
static int /* regexec return code */
-complicatedConcatenationDissect(
- struct vars *const v,
- struct subre *const t,
- chr *const begin, /* beginning of relevant substring */
- chr *const end) /* end of same */
+ccondissect(
+ struct vars *v,
+ struct subre *t,
+ chr *begin, /* beginning of relevant substring */
+ chr *end) /* end of same */
{
struct dfa *d, *d2;
chr *mid;
@@ -842,39 +699,23 @@ complicatedConcatenationDissect(
assert(t->op == '.');
assert(t->left != NULL && t->left->cnfa.nstates > 0);
assert(t->right != NULL && t->right->cnfa.nstates > 0);
+ assert(!(t->left->flags & SHORTER));
- if (t->left->flags&SHORTER) { /* reverse scan */
- return complicatedReversedDissect(v, t, begin, end);
- }
+ d = getsubdfa(v, t->left);
+ NOERR();
+ d2 = getsubdfa(v, t->right);
+ NOERR();
- d = newDFA(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
- if (ISERR()) {
- return v->err;
- }
- d2 = newDFA(v, &t->right->cnfa, &v->g->cmap, DOMALLOC);
- if (ISERR()) {
- freeDFA(d);
- return v->err;
- }
- MDEBUG(("cConcat %d\n", t->retry));
+ MDEBUG(("cConcat %d\n", t->id));
/*
* Pick a tentative midpoint.
*/
-
- if (v->mem[t->retry] == 0) {
- mid = longest(v, d, begin, end, NULL);
- if (mid == NULL) {
- freeDFA(d);
- freeDFA(d2);
- return REG_NOMATCH;
- }
- MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
- v->mem[t->retry] = (mid - begin) + 1;
- } else {
- mid = begin + (v->mem[t->retry] - 1);
- MDEBUG(("working midpoint %ld\n", LOFF(mid)));
+ mid = longest(v, d, begin, end, (int *) NULL);
+ if (mid == NULL) {
+ return REG_NOMATCH;
}
+ MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
/*
* Iterate until satisfaction or failure.
@@ -886,24 +727,20 @@ complicatedConcatenationDissect(
*/
if (longest(v, d2, mid, end, NULL) == end) {
- int er = complicatedDissect(v, t->left, begin, mid);
+ int er = cdissect(v, t->left, begin, mid);
if (er == REG_OKAY) {
- er = complicatedDissect(v, t->right, mid, end);
+ er = cdissect(v, t->right, mid, end);
if (er == REG_OKAY) {
/*
* Satisfaction.
*/
MDEBUG(("successful\n"));
- freeDFA(d);
- freeDFA(d2);
return REG_OKAY;
}
}
- if ((er != REG_OKAY) && (er != REG_NOMATCH)) {
- freeDFA(d);
- freeDFA(d2);
+ if (er != REG_NOMATCH) {
return er;
}
}
@@ -917,9 +754,7 @@ complicatedConcatenationDissect(
* All possibilities exhausted.
*/
- MDEBUG(("%d no midpoint\n", t->retry));
- freeDFA(d);
- freeDFA(d2);
+ MDEBUG(("%d no midpoint\n", t->id));
return REG_NOMATCH;
}
mid = longest(v, d, begin, mid-1, NULL);
@@ -928,31 +763,25 @@ complicatedConcatenationDissect(
* Failed to find a new one.
*/
- MDEBUG(("%d failed midpoint\n", t->retry));
- freeDFA(d);
- freeDFA(d2);
+ MDEBUG(("%d failed midpoint\n", t->id));
return REG_NOMATCH;
}
- MDEBUG(("%d: new midpoint %ld\n", t->retry, LOFF(mid)));
- v->mem[t->retry] = (mid - begin) + 1;
- zapSubtree(v, t->left);
- zapSubtree(v, t->right);
+ MDEBUG(("%d: new midpoint %ld\n", t->id, LOFF(mid)));
+ zaptreesubs(v, t->left);
+ zaptreesubs(v, t->right);
}
}
/*
- - complicatedReversedDissect - determine backref shortest-first subexpression
- - matches
- * The retry memory stores the offset of the trial midpoint from begin, plus 1
- * so that 0 uniquely means "clean slate".
- ^ static int complicatedReversedDissect(struct vars *, struct subre *, chr *, chr *);
+ - crevcondissect - dissect match for concatenation node, shortest-first
+ ^ static int crevcondissect(struct vars *, struct subre *, chr *, chr *);
*/
static int /* regexec return code */
-complicatedReversedDissect(
- struct vars *const v,
- struct subre *const t,
- chr *const begin, /* beginning of relevant substring */
- chr *const end) /* end of same */
+crevcondissect(
+ struct vars *v,
+ struct subre *t,
+ chr *begin, /* beginning of relevant substring */
+ chr *end) /* end of same */
{
struct dfa *d, *d2;
chr *mid;
@@ -962,38 +791,22 @@ complicatedReversedDissect(
assert(t->right != NULL && t->right->cnfa.nstates > 0);
assert(t->left->flags&SHORTER);
- /*
- * Concatenation -- need to split the substring between parts.
- */
+ d = getsubdfa(v, t->left);
+ NOERR();
+ d2 = getsubdfa(v, t->right);
+ NOERR();
- d = newDFA(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
- if (ISERR()) {
- return v->err;
- }
- d2 = newDFA(v, &t->right->cnfa, &v->g->cmap, DOMALLOC);
- if (ISERR()) {
- freeDFA(d);
- return v->err;
- }
- MDEBUG(("cRev %d\n", t->retry));
+ MDEBUG(("crevcon %d\n", t->id));
/*
* Pick a tentative midpoint.
*/
- if (v->mem[t->retry] == 0) {
- mid = shortest(v, d, begin, begin, end, NULL, NULL);
- if (mid == NULL) {
- freeDFA(d);
- freeDFA(d2);
- return REG_NOMATCH;
- }
- MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
- v->mem[t->retry] = (mid - begin) + 1;
- } else {
- mid = begin + (v->mem[t->retry] - 1);
- MDEBUG(("working midpoint %ld\n", LOFF(mid)));
+ mid = shortest(v, d, begin, begin, end, (chr **) NULL, (int *) NULL);
+ if (mid == NULL) {
+ return REG_NOMATCH;
}
+ MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
/*
* Iterate until satisfaction or failure.
@@ -1005,24 +818,20 @@ complicatedReversedDissect(
*/
if (longest(v, d2, mid, end, NULL) == end) {
- int er = complicatedDissect(v, t->left, begin, mid);
+ int er = cdissect(v, t->left, begin, mid);
if (er == REG_OKAY) {
- er = complicatedDissect(v, t->right, mid, end);
+ er = cdissect(v, t->right, mid, end);
if (er == REG_OKAY) {
/*
* Satisfaction.
*/
MDEBUG(("successful\n"));
- freeDFA(d);
- freeDFA(d2);
return REG_OKAY;
}
}
- if (er != REG_OKAY && er != REG_NOMATCH) {
- freeDFA(d);
- freeDFA(d2);
+ if (er != REG_NOMATCH) {
return er;
}
}
@@ -1036,9 +845,7 @@ complicatedReversedDissect(
* All possibilities exhausted.
*/
- MDEBUG(("%d no midpoint\n", t->retry));
- freeDFA(d);
- freeDFA(d2);
+ MDEBUG(("%d no midpoint\n", t->id));
return REG_NOMATCH;
}
mid = shortest(v, d, begin, mid+1, end, NULL, NULL);
@@ -1047,164 +854,474 @@ complicatedReversedDissect(
* Failed to find a new one.
*/
- MDEBUG(("%d failed midpoint\n", t->retry));
- freeDFA(d);
- freeDFA(d2);
+ MDEBUG(("%d failed midpoint\n", t->id));
return REG_NOMATCH;
}
- MDEBUG(("%d: new midpoint %ld\n", t->retry, LOFF(mid)));
- v->mem[t->retry] = (mid - begin) + 1;
- zapSubtree(v, t->left);
- zapSubtree(v, t->right);
+ MDEBUG(("%d: new midpoint %ld\n", t->id, LOFF(mid)));
+ zaptreesubs(v, t->left);
+ zaptreesubs(v, t->right);
}
}
/*
- - complicatedBackrefDissect - determine backref subexpression matches
- ^ static int complicatedBackrefDissect(struct vars *, struct subre *, chr *, chr *);
+ - cbrdissect - dissect match for backref node
+ ^ static int cbrdissect(struct vars *, struct subre *, chr *, chr *);
*/
static int /* regexec return code */
-complicatedBackrefDissect(
- struct vars *const v,
- struct subre *const t,
- chr *const begin, /* beginning of relevant substring */
- chr *const end) /* end of same */
+cbrdissect(
+ struct vars *v,
+ struct subre *t,
+ chr *begin, /* beginning of relevant substring */
+ chr *end) /* end of same */
{
- int i, n = t->subno, min = t->min, max = t->max;
- chr *paren, *p, *stop;
- size_t len;
+ int n = t->subno, min = t->min, max = t->max;
+ size_t numreps;
+ size_t tlen;
+ size_t brlen;
+ chr *brstring;
+ chr *p;
assert(t != NULL);
assert(t->op == 'b');
assert(n >= 0);
assert((size_t)n < v->nmatch);
- MDEBUG(("cbackref n%d %d{%d-%d}\n", t->retry, n, min, max));
+ MDEBUG(("cbackref n%d %d{%d-%d}\n", t->id, n, min, max));
+ /* get the backreferenced string */
if (v->pmatch[n].rm_so == -1) {
return REG_NOMATCH;
}
- paren = v->start + v->pmatch[n].rm_so;
- len = v->pmatch[n].rm_eo - v->pmatch[n].rm_so;
+ brstring = v->start + v->pmatch[n].rm_so;
+ brlen = v->pmatch[n].rm_eo - v->pmatch[n].rm_so;
- /*
- * No room to maneuver -- retries are pointless.
- */
-
- if (v->mem[t->retry]) {
+ /* special cases for zero-length strings */
+ if (brlen == 0) {
+ /*
+ * matches only if target is zero length, but any number of
+ * repetitions can be considered to be present
+ */
+ if (begin == end && min <= max) {
+ MDEBUG(("cbackref matched trivially\n"));
+ return REG_OKAY;
+ }
return REG_NOMATCH;
}
- v->mem[t->retry] = 1;
-
- /*
- * Special-case zero-length string.
- */
-
- if (len == 0) {
- if (begin == end) {
+ if (begin == end) {
+ /* matches only if zero repetitions are okay */
+ if (min == 0) {
+ MDEBUG(("cbackref matched trivially\n"));
return REG_OKAY;
}
return REG_NOMATCH;
}
/*
- * And too-short string.
+ * check target length to see if it could possibly be an allowed number of
+ * repetitions of brstring
*/
- assert(end >= begin);
- if ((size_t)(end - begin) < len) {
+ assert(end > begin);
+ tlen = end - begin;
+ if (tlen % brlen != 0)
+ return REG_NOMATCH;
+ numreps = tlen / brlen;
+ if (numreps < (size_t)min || (numreps > (size_t)max && max != DUPINF))
return REG_NOMATCH;
+
+ /* okay, compare the actual string contents */
+ p = begin;
+ while (numreps-- > 0) {
+ if ((*v->g->compare) (brstring, p, brlen) != 0)
+ return REG_NOMATCH;
+ p += brlen;
}
- stop = end - len;
- /*
- * Count occurrences.
- */
+ MDEBUG(("cbackref matched\n"));
+ return REG_OKAY;
+}
+
+/*
+ - caltdissect - dissect match for alternation node
+ ^ static int caltdissect(struct vars *, struct subre *, chr *, chr *);
+ */
+static int /* regexec return code */
+caltdissect(
+ struct vars *v,
+ struct subre *t,
+ chr *begin, /* beginning of relevant substring */
+ chr *end) /* end of same */
+{
+ struct dfa *d;
+ int er;
+
+ /* We loop, rather than tail-recurse, to handle a chain of alternatives */
+ while (t != NULL) {
+ assert(t->op == '|');
+ assert(t->left != NULL && t->left->cnfa.nstates > 0);
- i = 0;
- for (p = begin; p <= stop && (i < max || max == INFINITY); p += len) {
- if (v->g->compare(paren, p, len) != 0) {
- break;
+ MDEBUG(("calt n%d\n", t->id));
+
+ d = getsubdfa(v, t->left);
+ NOERR();
+ if (longest(v, d, begin, end, (int *) NULL) == end) {
+ MDEBUG(("calt matched\n"));
+ er = cdissect(v, t->left, begin, end);
+ if (er != REG_NOMATCH) {
+ return er;
+ }
}
- i++;
+
+ t = t->right;
}
- MDEBUG(("cbackref found %d\n", i));
+
+ return REG_NOMATCH;
+}
+
+/*
+ - citerdissect - dissect match for iteration node
+ ^ static int citerdissect(struct vars *, struct subre *, chr *, chr *);
+ */
+static int /* regexec return code */
+citerdissect(struct vars * v,
+ struct subre * t,
+ chr *begin, /* beginning of relevant substring */
+ chr *end) /* end of same */
+{
+ struct dfa *d;
+ chr **endpts;
+ chr *limit;
+ int min_matches;
+ size_t max_matches;
+ int nverified;
+ int k;
+ int i;
+ int er;
+
+ assert(t->op == '*');
+ assert(t->left != NULL && t->left->cnfa.nstates > 0);
+ assert(!(t->left->flags & SHORTER));
+ assert(begin <= end);
/*
- * And sort it out.
+ * If zero matches are allowed, and target string is empty, just declare
+ * victory. OTOH, if target string isn't empty, zero matches can't work
+ * so we pretend the min is 1.
*/
+ min_matches = t->min;
+ if (min_matches <= 0) {
+ if (begin == end)
+ return REG_OKAY;
+ min_matches = 1;
+ }
- if (p != end) { /* didn't consume all of it */
- return REG_NOMATCH;
+ /*
+ * We need workspace to track the endpoints of each sub-match. Normally
+ * we consider only nonzero-length sub-matches, so there can be at most
+ * end-begin of them. However, if min is larger than that, we will also
+ * consider zero-length sub-matches in order to find enough matches.
+ *
+ * For convenience, endpts[0] contains the "begin" pointer and we store
+ * sub-match endpoints in endpts[1..max_matches].
+ */
+ max_matches = end - begin;
+ if (max_matches > (size_t)t->max && t->max != DUPINF)
+ max_matches = t->max;
+ if (max_matches < (size_t)min_matches)
+ max_matches = min_matches;
+ endpts = (chr **) MALLOC((max_matches + 1) * sizeof(chr *));
+ if (endpts == NULL)
+ return REG_ESPACE;
+ endpts[0] = begin;
+
+ d = getsubdfa(v, t->left);
+ if (ISERR()) {
+ FREE(endpts);
+ return v->err;
}
- if (min <= i && (i <= max || max == INFINITY)) {
- return REG_OKAY;
+ MDEBUG(("citer %d\n", t->id));
+
+ /*
+ * Our strategy is to first find a set of sub-match endpoints that are
+ * valid according to the child node's DFA, and then recursively dissect
+ * each sub-match to confirm validity. If any validity check fails,
+ * backtrack the last sub-match and try again. And, when we next try for
+ * a validity check, we need not recheck any successfully verified
+ * sub-matches that we didn't move the endpoints of. nverified remembers
+ * how many sub-matches are currently known okay.
+ */
+
+ /* initialize to consider first sub-match */
+ nverified = 0;
+ k = 1;
+ limit = end;
+
+ /* iterate until satisfaction or failure */
+ while (k > 0) {
+ /* try to find an endpoint for the k'th sub-match */
+ endpts[k] = longest(v, d, endpts[k - 1], limit, (int *) NULL);
+ if (endpts[k] == NULL) {
+ /* no match possible, so see if we can shorten previous one */
+ k--;
+ goto backtrack;
+ }
+ MDEBUG(("%d: working endpoint %d: %ld\n",
+ t->id, k, LOFF(endpts[k])));
+
+ /* k'th sub-match can no longer be considered verified */
+ if (nverified >= k)
+ nverified = k - 1;
+
+ if (endpts[k] != end) {
+ /* haven't reached end yet, try another iteration if allowed */
+ if ((size_t)k >= max_matches) {
+ /* must try to shorten some previous match */
+ k--;
+ goto backtrack;
+ }
+
+ /* reject zero-length match unless necessary to achieve min */
+ if (endpts[k] == endpts[k - 1] &&
+ (k >= min_matches || min_matches - k < end - endpts[k]))
+ goto backtrack;
+
+ k++;
+ limit = end;
+ continue;
+ }
+
+ /*
+ * We've identified a way to divide the string into k sub-matches
+ * that works so far as the child DFA can tell. If k is an allowed
+ * number of matches, start the slow part: recurse to verify each
+ * sub-match. We always have k <= max_matches, needn't check that.
+ */
+ if (k < min_matches)
+ goto backtrack;
+
+ MDEBUG(("%d: verifying %d..%d\n", t->id, nverified + 1, k));
+
+ for (i = nverified + 1; i <= k; i++) {
+ zaptreesubs(v, t->left);
+ er = cdissect(v, t->left, endpts[i - 1], endpts[i]);
+ if (er == REG_OKAY) {
+ nverified = i;
+ continue;
+ }
+ if (er == REG_NOMATCH)
+ break;
+ /* oops, something failed */
+ FREE(endpts);
+ return er;
+ }
+
+ if (i > k) {
+ /* satisfaction */
+ MDEBUG(("%d successful\n", t->id));
+ FREE(endpts);
+ return REG_OKAY;
+ }
+
+ /* match failed to verify, so backtrack */
+
+ backtrack:
+ /*
+ * Must consider shorter versions of the current sub-match. However,
+ * we'll only ask for a zero-length match if necessary.
+ */
+ while (k > 0) {
+ chr *prev_end = endpts[k - 1];
+
+ if (endpts[k] > prev_end) {
+ limit = endpts[k] - 1;
+ if (limit > prev_end ||
+ (k < min_matches && min_matches - k >= end - prev_end)) {
+ /* break out of backtrack loop, continue the outer one */
+ break;
+ }
+ }
+ /* can't shorten k'th sub-match any more, consider previous one */
+ k--;
+ }
}
- return REG_NOMATCH; /* out of range */
+
+ /* all possibilities exhausted */
+ MDEBUG(("%d failed\n", t->id));
+ FREE(endpts);
+ return REG_NOMATCH;
}
/*
- - complicatedAlternationDissect - determine alternative subexpression matches (w.
- - complications)
- ^ static int complicatedAlternationDissect(struct vars *, struct subre *, chr *, chr *);
+ - creviterdissect - dissect match for iteration node, shortest-first
+ ^ static int creviterdissect(struct vars *, struct subre *, chr *, chr *);
*/
static int /* regexec return code */
-complicatedAlternationDissect(
- struct vars *const v,
- struct subre *t,
- chr *const begin, /* beginning of relevant substring */
- chr *const end) /* end of same */
+creviterdissect(struct vars * v,
+ struct subre * t,
+ chr *begin, /* beginning of relevant substring */
+ chr *end) /* end of same */
{
- int er;
-#define UNTRIED 0 /* not yet tried at all */
-#define TRYING 1 /* top matched, trying submatches */
-#define TRIED 2 /* top didn't match or submatches exhausted */
+ struct dfa *d;
+ chr **endpts;
+ chr *limit;
+ int min_matches;
+ size_t max_matches;
+ int nverified;
+ int k;
+ int i;
+ int er;
+
+ assert(t->op == '*');
+ assert(t->left != NULL && t->left->cnfa.nstates > 0);
+ assert(t->left->flags & SHORTER);
+ assert(begin <= end);
-#ifndef COMPILER_DOES_TAILCALL_OPTIMIZATION
- if (0) {
- doRight:
- t = t->right;
- }
-#endif
- if (t == NULL) {
- return REG_NOMATCH;
+ /*
+ * If zero matches are allowed, and target string is empty, just declare
+ * victory. OTOH, if target string isn't empty, zero matches can't work
+ * so we pretend the min is 1.
+ */
+ min_matches = t->min;
+ if (min_matches <= 0) {
+ if (begin == end)
+ return REG_OKAY;
+ min_matches = 1;
}
- assert(t->op == '|');
- if (v->mem[t->retry] == TRIED) {
- goto doRight;
+
+ /*
+ * We need workspace to track the endpoints of each sub-match. Normally
+ * we consider only nonzero-length sub-matches, so there can be at most
+ * end-begin of them. However, if min is larger than that, we will also
+ * consider zero-length sub-matches in order to find enough matches.
+ *
+ * For convenience, endpts[0] contains the "begin" pointer and we store
+ * sub-match endpoints in endpts[1..max_matches].
+ */
+ max_matches = end - begin;
+ if (max_matches > (size_t)t->max && t->max != DUPINF)
+ max_matches = t->max;
+ if (max_matches < (size_t)min_matches)
+ max_matches = min_matches;
+ endpts = (chr **) MALLOC((max_matches + 1) * sizeof(chr *));
+ if (endpts == NULL)
+ return REG_ESPACE;
+ endpts[0] = begin;
+
+ d = getsubdfa(v, t->left);
+ if (ISERR()) {
+ FREE(endpts);
+ return v->err;
}
+ MDEBUG(("creviter %d\n", t->id));
- MDEBUG(("cAlt n%d\n", t->retry));
- assert(t->left != NULL);
+ /*
+ * Our strategy is to first find a set of sub-match endpoints that are
+ * valid according to the child node's DFA, and then recursively dissect
+ * each sub-match to confirm validity. If any validity check fails,
+ * backtrack the last sub-match and try again. And, when we next try for
+ * a validity check, we need not recheck any successfully verified
+ * sub-matches that we didn't move the endpoints of. nverified remembers
+ * how many sub-matches are currently known okay.
+ */
- if (v->mem[t->retry] == UNTRIED) {
- struct dfa *d = newDFA(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
+ /* initialize to consider first sub-match */
+ nverified = 0;
+ k = 1;
+ limit = begin;
+
+ /* iterate until satisfaction or failure */
+ while (k > 0) {
+ /* disallow zero-length match unless necessary to achieve min */
+ if (limit == endpts[k - 1] &&
+ limit != end &&
+ (k >= min_matches || min_matches - k < end - limit))
+ limit++;
+
+ /* if this is the last allowed sub-match, it must reach to the end */
+ if ((size_t)k >= max_matches)
+ limit = end;
+
+ /* try to find an endpoint for the k'th sub-match */
+ endpts[k] = shortest(v, d, endpts[k - 1], limit, end,
+ (chr **) NULL, (int *) NULL);
+ if (endpts[k] == NULL) {
+ /* no match possible, so see if we can lengthen previous one */
+ k--;
+ goto backtrack;
+ }
+ MDEBUG(("%d: working endpoint %d: %ld\n",
+ t->id, k, LOFF(endpts[k])));
+
+ /* k'th sub-match can no longer be considered verified */
+ if (nverified >= k)
+ nverified = k - 1;
+
+ if (endpts[k] != end) {
+ /* haven't reached end yet, try another iteration if allowed */
+ if ((size_t)k >= max_matches) {
+ /* must try to lengthen some previous match */
+ k--;
+ goto backtrack;
+ }
- if (ISERR()) {
- return v->err;
+ k++;
+ limit = endpts[k - 1];
+ continue;
}
- if (longest(v, d, begin, end, NULL) != end) {
- freeDFA(d);
- v->mem[t->retry] = TRIED;
- goto doRight;
+
+ /*
+ * We've identified a way to divide the string into k sub-matches
+ * that works so far as the child DFA can tell. If k is an allowed
+ * number of matches, start the slow part: recurse to verify each
+ * sub-match. We always have k <= max_matches, needn't check that.
+ */
+ if (k < min_matches)
+ goto backtrack;
+
+ MDEBUG(("%d: verifying %d..%d\n", t->id, nverified + 1, k));
+
+ for (i = nverified + 1; i <= k; i++) {
+ zaptreesubs(v, t->left);
+ er = cdissect(v, t->left, endpts[i - 1], endpts[i]);
+ if (er == REG_OKAY) {
+ nverified = i;
+ continue;
+ }
+ if (er == REG_NOMATCH)
+ break;
+ /* oops, something failed */
+ FREE(endpts);
+ return er;
}
- freeDFA(d);
- MDEBUG(("cAlt matched\n"));
- v->mem[t->retry] = TRYING;
- }
- er = complicatedDissect(v, t->left, begin, end);
- if (er != REG_NOMATCH) {
- return er;
+ if (i > k) {
+ /* satisfaction */
+ MDEBUG(("%d successful\n", t->id));
+ FREE(endpts);
+ return REG_OKAY;
+ }
+
+ /* match failed to verify, so backtrack */
+
+ backtrack:
+ /*
+ * Must consider longer versions of the current sub-match.
+ */
+ while (k > 0) {
+ if (endpts[k] < end) {
+ limit = endpts[k] + 1;
+ /* break out of backtrack loop, continue the outer one */
+ break;
+ }
+ /* can't lengthen k'th sub-match any more, consider previous one */
+ k--;
+ }
}
- v->mem[t->retry] = TRIED;
-#ifndef COMPILER_DOES_TAILCALL_OPTIMIZATION
- goto doRight;
-#else
- doRight:
- return complicatedAlternationDissect(v, t->right, begin, end);
-#endif
+ /* all possibilities exhausted */
+ MDEBUG(("%d failed\n", t->id));
+ FREE(endpts);
+ return REG_NOMATCH;
}
#include "rege_dfa.c"
diff --git a/generic/regguts.h b/generic/regguts.h
index b478e4c..1ac2465 100644
--- a/generic/regguts.h
+++ b/generic/regguts.h
@@ -99,7 +99,7 @@
#define xxx 1
#define DUPMAX _POSIX2_RE_DUP_MAX
-#define INFINITY (DUPMAX+1)
+#define DUPINF (DUPMAX+1)
#define REMAGIC 0xfed7 /* magic number for main struct */
@@ -186,7 +186,14 @@ struct colordesc {
union tree *block; /* block of solid color, if any */
};
-/* the color map itself */
+/*
+ * The color map itself
+ *
+ * Much of the data in the colormap struct is only used at compile time.
+ * However, the bulk of the space usage is in the "tree" structure, so it's
+ * not clear that there's much point in converting the rest to a more compact
+ * form when compilation is finished.
+ */
struct colormap {
int magic;
#define CMMAGIC 0x876
@@ -242,14 +249,15 @@ struct cvec {
struct state;
struct arc {
- int type;
-#define ARCFREE '\0'
+ int type; /* 0 if free, else an NFA arc type code */
color co;
struct state *from; /* where it's from (and contained within) */
struct state *to; /* where it's to */
- struct arc *outchain; /* *from's outs chain or free chain */
-#define freechain outchain
+ struct arc *outchain; /* link in *from's outs chain or free chain */
+ struct arc *outchainRev; /* back-link in *from's outs chain */
+#define freechain outchain /* we do not maintain "freechainRev" */
struct arc *inchain; /* *to's ins chain */
+ struct arc *inchainRev; /* back-link in *to's ins chain */
struct arc *colorchain; /* color's arc chain */
struct arc *colorchainRev; /* back-link in color's arc chain */
};
@@ -288,20 +296,28 @@ struct nfa {
struct colormap *cm; /* the color map */
color bos[2]; /* colors, if any, assigned to BOS and BOL */
color eos[2]; /* colors, if any, assigned to EOS and EOL */
- size_t size; /* Current NFA size; differs from nstates as
- * it also counts the number of states created
- * by children of this state. */
struct vars *v; /* simplifies compile error reporting */
struct nfa *parent; /* parent NFA, if any */
};
/*
* definitions for compacted NFA
+ *
+ * The main space savings in a compacted NFA is from making the arcs as small
+ * as possible. We store only the transition color and next-state number for
+ * each arc. The list of out arcs for each state is an array beginning at
+ * cnfa.states[statenumber], and terminated by a dummy carc struct with
+ * co == COLORLESS.
+ *
+ * The non-dummy carc structs are of two types: plain arcs and LACON arcs.
+ * Plain arcs just store the transition color number as "co". LACON arcs
+ * store the lookahead constraint number plus cnfa.ncolors as "co". LACON
+ * arcs can be distinguished from plain by testing for co >= cnfa.ncolors.
*/
struct carc {
color co; /* COLORLESS is list terminator */
- int to; /* state number */
+ int to; /* next-state number */
};
struct cnfa {
@@ -313,27 +329,52 @@ struct cnfa {
int post; /* teardown state number */
color bos[2]; /* colors, if any, assigned to BOS and BOL */
color eos[2]; /* colors, if any, assigned to EOS and EOL */
+ char *stflags; /* vector of per-state flags bytes */
+#define CNFA_NOPROGRESS 01 /* flag bit for a no-progress state */
struct carc **states; /* vector of pointers to outarc lists */
+ /* states[n] are pointers into a single malloc'd array of arcs */
struct carc *arcs; /* the area for the lists */
};
#define ZAPCNFA(cnfa) ((cnfa).nstates = 0)
#define NULLCNFA(cnfa) ((cnfa).nstates == 0)
/*
- * Used to limit the maximum NFA size to something sane. [Bug 1810264]
+ * This symbol limits the transient heap space used by the regex compiler,
+ * and thereby also the maximum complexity of NFAs that we'll deal with.
+ * Currently we only count NFA states and arcs against this; the other
+ * transient data is generally not large enough to notice compared to those.
+ * Note that we do not charge anything for the final output data structures
+ * (the compacted NFA and the colormap).
*/
-
-#ifndef REG_MAX_STATES
-# define REG_MAX_STATES 100000
+#ifndef REG_MAX_COMPILE_SPACE
+#define REG_MAX_COMPILE_SPACE \
+ (100000 * sizeof(struct state) + 100000 * sizeof(struct arcbatch))
#endif
/*
* subexpression tree
+ *
+ * "op" is one of:
+ * '=' plain regex without interesting substructure (implemented as DFA)
+ * 'b' back-reference (has no substructure either)
+ * '(' capture node: captures the match of its single child
+ * '.' concatenation: matches a match for left, then a match for right
+ * '|' alternation: matches a match for left or a match for right
+ * '*' iteration: matches some number of matches of its single child
+ *
+ * Note: the right child of an alternation must be another alternation or
+ * NULL; hence, an N-way branch requires N alternation nodes, not N-1 as you
+ * might expect. This could stand to be changed. Actually I'd rather see
+ * a single alternation node with N children, but that will take revising
+ * the representation of struct subre.
+ *
+ * Note: when a backref is directly quantified, we stick the min/max counts
+ * into the backref rather than plastering an iteration node on top. This is
+ * for efficiency: there is no need to search for possible division points.
*/
struct subre {
- char op; /* '|', '.' (concat), 'b' (backref), '(',
- * '=' */
+ char op; /* see type codes above */
char flags;
#define LONGER 01 /* prefers longer match */
#define SHORTER 02 /* prefers shorter match */
@@ -349,10 +390,10 @@ struct subre {
#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 */
+ short id; /* ID of subre (1..ntree-1) */
int subno; /* subexpression number (for 'b' and '(') */
- short min; /* min repetitions, for backref only */
- short max; /* max repetitions, for backref only */
+ short min; /* min repetitions for iteration or backref */
+ short max; /* max repetitions for iteration or backref */
struct subre *left; /* left child, if any (also freelist chain) */
struct subre *right; /* right child, if any */
struct state *begin; /* outarcs from here... */
@@ -382,7 +423,7 @@ struct guts {
size_t nsub; /* copy of re_nsub */
struct subre *tree;
struct cnfa search; /* for fast preliminary search */
- int ntree;
+ int ntree; /* number of subre's, plus one */
struct colormap cmap;
int FUNCPTR(compare, (const chr *, const chr *, size_t));
struct subre *lacons; /* lookahead-constraint vector */
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 1829249..574b49b 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2,8 +2,8 @@
#
# This file contains the declarations for all supported public
# functions that are exported by the Tcl library via the stubs table.
-# This file is used to generate the tclDecls.h, tclPlatDecls.h,
-# tclStub.c, and tclPlatStub.c files.
+# This file is used to generate the tclDecls.h, tclPlatDecls.h
+# and tclStubInit.c files.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001, 2002 by Kevin B. Kenny. All rights reserved.
@@ -37,7 +37,7 @@ declare 1 {
void *clientDataPtr)
}
declare 2 {
- void Tcl_Panic(const char *format, ...)
+ TCL_NORETURN void Tcl_Panic(const char *format, ...)
}
declare 3 {
char *Tcl_Alloc(unsigned int size)
@@ -480,7 +480,7 @@ declare 132 {
void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc)
}
declare 133 {
- void Tcl_Exit(int status)
+ TCL_NORETURN void Tcl_Exit(int status)
}
declare 134 {
int Tcl_ExposeCommand(Tcl_Interp *interp, const char *hiddenCmdToken,
@@ -815,7 +815,7 @@ declare 229 {
void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr)
}
declare 230 {
- void Tcl_SetPanicProc(Tcl_PanicProc *panicProc)
+ void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc)
}
declare 231 {
int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth)
@@ -986,7 +986,7 @@ declare 277 {
Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
}
declare 278 {
- void Tcl_PanicVA(const char *format, va_list argList)
+ TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList)
}
declare 279 {
void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type)
@@ -1872,7 +1872,7 @@ declare 518 {
# TIP#121 (exit handler) dkf for Joe Mistachkin
declare 519 {
- Tcl_ExitProc *Tcl_SetExitProc(Tcl_ExitProc *proc)
+ Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc)
}
# TIP#143 (resource limits) dkf
diff --git a/generic/tcl.h b/generic/tcl.h
index a833218..3490049 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 5
#define TCL_VERSION "8.6"
-#define TCL_PATCH_LEVEL "8.6.0"
+#define TCL_PATCH_LEVEL "8.6.5"
/*
*----------------------------------------------------------------------------
@@ -67,27 +67,14 @@ 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
-#endif
-
-/*
- * STRICT: See MSDN Article Q83456
- */
-
-#ifdef __WIN32__
-# ifndef STRICT
-# define STRICT
+# ifndef WIN32
+# define WIN32
# endif
-#endif /* __WIN32__ */
+#endif
/*
* Utility macros: STRINGIFY takes an argument and wraps it in "" (double
@@ -156,8 +143,20 @@ extern "C" {
#endif
#if defined(__GNUC__) && (__GNUC__ > 2)
# define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))
+# define TCL_NORETURN __attribute__ ((noreturn))
+# if defined(BUILD_tcl) || defined(BUILD_tk)
+# define TCL_NORETURN1 __attribute__ ((noreturn))
+# else
+# define TCL_NORETURN1 /* nothing */
+# endif
#else
# define TCL_FORMAT_PRINTF(a,b)
+# if defined(_MSC_VER) && (_MSC_VER >= 1310)
+# define TCL_NORETURN _declspec(noreturn)
+# else
+# define TCL_NORETURN /* nothing */
+# endif
+# define TCL_NORETURN1 /* nothing */
#endif
/*
@@ -168,7 +167,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 +190,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,14 +314,14 @@ 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 *"
@@ -390,7 +389,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"
@@ -400,22 +399,18 @@ 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...
*/
-# ifdef NO_LIMITS_H
-# error please define either TCL_WIDE_INT_TYPE or TCL_WIDE_INT_IS_LONG
-# else /* !NO_LIMITS_H */
-# include <limits.h>
-# if (INT_MAX < LONG_MAX)
-# define TCL_WIDE_INT_IS_LONG 1
-# else
-# define TCL_WIDE_INT_TYPE long long
-# endif
-# endif /* NO_LIMITS_H */
-# endif /* __WIN32__ */
+# include <limits.h>
+# if (INT_MAX < LONG_MAX)
+# define TCL_WIDE_INT_IS_LONG 1
+# else
+# define TCL_WIDE_INT_TYPE long long
+# endif
+# endif /* _WIN32 */
#endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */
#ifdef TCL_WIDE_INT_IS_LONG
# undef TCL_WIDE_INT_TYPE
@@ -447,7 +442,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)
@@ -458,7 +453,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;
@@ -562,7 +557,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);
@@ -574,7 +569,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
@@ -833,18 +828,19 @@ typedef struct Tcl_Obj {
union { /* The internal representation: */
long longValue; /* - an long integer value. */
double doubleValue; /* - a double-precision floating value. */
- void *otherValuePtr; /* - another, type-specific value. */
+ void *otherValuePtr; /* - another, type-specific value,
+ not used internally any more. */
Tcl_WideInt wideValue; /* - a long long value. */
- struct { /* - internal rep as two pointers. */
+ struct { /* - internal rep as two pointers.
+ * the main use of which is a bignum's
+ * tightly packed fields, where the alloc,
+ * used and signum flags are packed into
+ * ptr2 with everything else hung off ptr1. */
void *ptr1;
void *ptr2;
} twoPtrValue;
struct { /* - internal rep as a pointer and a long,
- * the main use of which is a bignum's
- * tightly packed fields, where the alloc,
- * used and signum flags are packed into a
- * single word with everything else hung
- * off the pointer. */
+ not used internally any more. */
void *ptr;
unsigned long value;
} ptrAndLongRep;
@@ -2147,11 +2143,28 @@ typedef struct Tcl_EncodingType {
* substituting one or more "close" characters in
* the destination buffer and then continue to
* convert the source.
+ * TCL_ENCODING_NO_TERMINATE - If set, Tcl_ExternalToUtf will not append a
+ * terminating NUL byte. Knowing that it will
+ * not need space to do so, it will fill all
+ * dstLen bytes with encoded UTF-8 content, as
+ * other circumstances permit. If clear, the
+ * default behavior is to reserve a byte in
+ * the dst space for NUL termination, and to
+ * append the NUL byte.
+ * TCL_ENCODING_CHAR_LIMIT - If set and dstCharsPtr is not NULL, then
+ * Tcl_ExternalToUtf takes the initial value
+ * of *dstCharsPtr is taken as a limit of the
+ * maximum number of chars to produce in the
+ * encoded UTF-8 content. Otherwise, the
+ * number of chars produced is controlled only
+ * by other limiting factors.
*/
#define TCL_ENCODING_START 0x01
#define TCL_ENCODING_END 0x02
#define TCL_ENCODING_STOPONERROR 0x04
+#define TCL_ENCODING_NO_TERMINATE 0x08
+#define TCL_ENCODING_CHAR_LIMIT 0x10
/*
* The following definitions are the error codes returned by the conversion
@@ -2422,9 +2435,7 @@ EXTERN void Tcl_MainEx(int argc, char **argv,
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
const char *version, int exact);
-#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
-#endif
/*
*----------------------------------------------------------------------------
@@ -2436,9 +2447,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"
/*
@@ -2505,7 +2522,7 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
# define Tcl_DecrRefCount(objPtr) \
do { \
Tcl_Obj *_objPtr = (objPtr); \
- if (--(_objPtr)->refCount <= 0) { \
+ if ((_objPtr)->refCount-- <= 1) { \
TclFreeObj(_objPtr); \
} \
} while(0)
diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c
index ae61e85..cda1f38 100644
--- a/generic/tclAlloc.c
+++ b/generic/tclAlloc.c
@@ -31,7 +31,7 @@
* until Tcl uses config.h properly.
*/
-#if defined(_MSC_VER) || defined(__MINGW32__) || defined(__BORLANDC__)
+#if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__)
typedef unsigned long caddr_t;
#endif
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 100e9ef..f56da8f 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -26,6 +26,7 @@
*- 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;
@@ -349,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},
@@ -408,6 +410,10 @@ static const TalInstDesc TalInstructionTable[] = {
{"lappendArray", ASSEM_LVT, (INST_LAPPEND_ARRAY1<<8
| INST_LAPPEND_ARRAY4),2, 1},
{"lappendArrayStk", ASSEM_1BYTE, INST_LAPPEND_ARRAY_STK, 3, 1},
+ {"lappendList", ASSEM_LVT4, INST_LAPPEND_LIST, 1, 1},
+ {"lappendListArray",ASSEM_LVT4, INST_LAPPEND_LIST_ARRAY,2, 1},
+ {"lappendListArrayStk", ASSEM_1BYTE,INST_LAPPEND_LIST_ARRAY_STK, 3, 1},
+ {"lappendListStk", ASSEM_1BYTE, INST_LAPPEND_LIST_STK, 2, 1},
{"lappendStk", ASSEM_1BYTE, INST_LAPPEND_STK, 2, 1},
{"le", ASSEM_1BYTE, INST_LE, 2, 1},
{"lindexMulti", ASSEM_LINDEX_MULTI,
@@ -436,6 +442,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},
@@ -452,7 +460,11 @@ static const TalInstDesc TalInstructionTable[] = {
| INST_STORE_ARRAY4), 2, 1},
{"storeArrayStk", ASSEM_1BYTE, INST_STORE_ARRAY_STK, 3, 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},
@@ -461,12 +473,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},
@@ -493,6 +510,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 */
@@ -502,7 +520,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 */
};
/*
@@ -682,7 +704,7 @@ BBEmitInstInt4(
* BBEmitInst1or4 --
*
* Emits a 1- or 4-byte operation according to the magnitude of the
- * operand
+ * operand.
*
*-----------------------------------------------------------------------------
*/
@@ -2617,6 +2639,7 @@ AllocBB(
bb->minStackDepth = 0;
bb->maxStackDepth = 0;
bb->finalStackDepth = 0;
+ bb->catchDepth = 0;
bb->enclosingCatch = NULL;
bb->foreignExceptionBase = -1;
bb->foreignExceptionCount = 0;
@@ -3961,10 +3984,12 @@ UnstackExpiredCatches(
while (catchDepth > bbPtr->catchDepth) {
--catchDepth;
- range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
- range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
- catches[catchDepth] = NULL;
- catchIndices[catchDepth] = -1;
+ if (catches[catchDepth] != NULL) {
+ range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
+ range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
+ catches[catchDepth] = NULL;
+ catchIndices[catchDepth] = -1;
+ }
}
/*
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index c1032f9..e5d7406 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -22,10 +22,7 @@
#include "tclCompile.h"
#include "tommath.h"
#include <math.h>
-
-#if NRE_ENABLE_ASSERTS
#include <assert.h>
-#endif
#define INTERP_STACK_INITIAL_SIZE 2000
#define CORO_STACK_INITIAL_SIZE 200
@@ -147,7 +144,7 @@ static int TEOV_NotFound(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[], Namespace *lookupNsPtr);
static int TEOV_RunEnterTraces(Tcl_Interp *interp,
Command **cmdPtrPtr, Tcl_Obj *commandPtr, int objc,
- Tcl_Obj *const objv[], Namespace *lookupNsPtr);
+ Tcl_Obj *const objv[]);
static Tcl_NRPostProc RewindCoroutineCallback;
static Tcl_NRPostProc TailcallCleanup;
static Tcl_NRPostProc TEOEx_ByteCodeCallback;
@@ -157,9 +154,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;
@@ -209,7 +208,7 @@ static const CmdInfo builtInCmds[] = {
{"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE},
#endif
{"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE},
- {"concat", Tcl_ConcatObjCmd, NULL, NULL, 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},
@@ -225,7 +224,7 @@ static const CmdInfo builtInCmds[] = {
{"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, NULL, 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},
@@ -257,7 +256,7 @@ static const CmdInfo builtInCmds[] = {
{"variable", Tcl_VariableObjCmd, TclCompileVariableCmd, NULL, CMD_IS_SAFE},
{"while", Tcl_WhileObjCmd, TclCompileWhileCmd, TclNRWhileObjCmd, CMD_IS_SAFE},
{"yield", NULL, TclCompileYieldCmd, TclNRYieldObjCmd, CMD_IS_SAFE},
- {"yieldto", NULL, NULL, TclNRYieldToObjCmd, CMD_IS_SAFE},
+ {"yieldto", NULL, TclCompileYieldToCmd, TclNRYieldToObjCmd, CMD_IS_SAFE},
/*
* Commands in the OS-interface. Note that many of these are unsafe.
@@ -470,7 +469,6 @@ Tcl_CreateInterp(void)
#endif /* TCL_COMPILE_STATS */
char mathFuncName[32];
CallFrame *framePtr;
- int result;
TclInitSubsystems();
@@ -524,6 +522,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 */
@@ -637,11 +638,8 @@ Tcl_CreateInterp(void)
/* This is needed to satisfy GCC 3.3's strict aliasing rules */
framePtr = ckalloc(sizeof(CallFrame));
- result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
+ (void) Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
(Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0);
- if (result != TCL_OK) {
- Tcl_Panic("Tcl_CreateInterp: failed to push the root stack frame");
- }
framePtr->objc = 0;
iPtr->framePtr = framePtr;
@@ -835,7 +833,9 @@ Tcl_CreateInterp(void)
*/
Tcl_CreateObjCommand(interp, "::tcl::unsupported::disassemble",
- Tcl_DisassembleObjCmd, NULL, NULL);
+ Tcl_DisassembleObjCmd, INT2PTR(0), NULL);
+ Tcl_CreateObjCommand(interp, "::tcl::unsupported::getbytecode",
+ Tcl_DisassembleObjCmd, INT2PTR(1), NULL);
Tcl_CreateObjCommand(interp, "::tcl::unsupported::representation",
Tcl_RepresentationCmd, NULL, NULL);
@@ -916,6 +916,13 @@ Tcl_CreateInterp(void)
TclInitEmbeddedConfigurationInformation(interp);
/*
+ * TIP #440: Declare the name of the script engine to be "Tcl".
+ */
+
+ Tcl_SetVar2(interp, "tcl_platform", "engine", "Tcl",
+ TCL_GLOBAL_ONLY);
+
+ /*
* Compute the byte order of this machine.
*/
@@ -2080,10 +2087,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) {
/*
@@ -2173,7 +2189,8 @@ Tcl_CreateCommand(
*
* Side effects:
* If a command named "cmdName" already exists for interp, it is
- * first deleted. Then the new command is created from the arguments.
+ * 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
@@ -2240,17 +2257,45 @@ Tcl_CreateObjCommand(
if (!isNew) {
cmdPtr = Tcl_GetHashValue(hPtr);
+ /* Command already exists. */
+
+ /*
+ * [***] 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
+ && cmdPtr->clientData == clientData
+ && cmdPtr->deleteData == clientData
+ && cmdPtr->deleteProc == deleteProc) {
+ cmdPtr->objProc = proc;
+ cmdPtr->objClientData = clientData;
+ return (Tcl_Command) cmdPtr;
+ }
+
/*
- * Command already exists; delete it. Be careful to preserve any
+ * Otherwise, we delete the old command. Be careful to preserve any
* existing import links so we can restore them down below. That way,
* you can redefine a command and its import status will remain
* 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) {
/*
@@ -3039,7 +3084,7 @@ Tcl_DeleteCommandFromToken(
while (tracePtr != NULL) {
CommandTrace *nextPtr = tracePtr->nextPtr;
- if ((--tracePtr->refCount) <= 0) {
+ if (tracePtr->refCount-- <= 1) {
ckfree(tracePtr);
}
tracePtr = nextPtr;
@@ -3092,12 +3137,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);
+ }
}
/*
@@ -3224,7 +3270,7 @@ CallCommandTraces(
tracePtr->traceProc(tracePtr->clientData, (Tcl_Interp *) iPtr,
oldName, newName, flags);
cmdPtr->flags &= ~tracePtr->flags;
- if ((--tracePtr->refCount) <= 0) {
+ if (tracePtr->refCount-- <= 1) {
ckfree(tracePtr);
}
}
@@ -4093,42 +4139,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.
+ * command redirectors (imports, alias, ensembles) so that tailcall skips
+ * this callback (that marks the end of the target command) and goes back
+ * to the end of the source command.
*/
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]);
iPtr->numLevels++;
- result = TclInterpReady(interp);
-
- if ((result != TCL_OK) || (objc == 0)) {
- return result;
- }
+ TclNRAddCallback(interp, EvalObjvCore, cmdPtr, INT2PTR(flags),
+ INT2PTR(objc), objv);
+ return TCL_OK;
+}
- if (cmdPtr) {
- goto commandFound;
- }
+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
@@ -4139,63 +4182,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)) {
+
+ Tcl_Obj *commandPtr = TclGetSourceFromFrame(
+ flags & TCL_EVAL_SOURCE_IN_FRAME ? iPtr->cmdFramePtr : NULL,
+ objc, objv);
+ Tcl_IncrRefCount(commandPtr);
+
+ 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;
+ }
+ }
- commandFound:
- if (iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
/*
- * Call enter traces. They will schedule a call to the leave traces if
- * necessary.
+ * 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.
*/
- result = TEOV_RunEnterTraces(interp, &cmdPtr, TclGetSourceFromFrame(
- flags & TCL_EVAL_SOURCE_IN_FRAME ? iPtr->cmdFramePtr : NULL,
- objc, objv), objc, objv, lookupNsPtr);
- if (result != TCL_OK) {
- return result;
- }
- if (!cmdPtr) {
- return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
- }
+ 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()) {
@@ -4216,41 +4346,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++;
-
- TclNRAddCallback(interp, Dispatch, cmdPtr, INT2PTR(objc), objv, NULL);
- return TCL_OK;
-}
-
-static int
-Dispatch(
- ClientData data[],
- Tcl_Interp *interp,
- int result)
-{
- Command *cmdPtr = data[0];
- int objc = PTR2INT(data[1]);
- Tcl_Obj **objv = data[2];
- if (cmdPtr->nreProc) {
- return cmdPtr->nreProc(cmdPtr->objClientData, interp, objc, objv);
- } else {
- return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
- }
+ iPtr->cmdCount++;
+ return objProc(clientData, interp, objc, objv);
}
int
@@ -4296,18 +4403,13 @@ 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
+ * If there is a tailcall, schedule it next
*/
-
+
if (data[1] && (data[1] != INT2PTR(1))) {
TclNRAddCallback(interp, TclNRTailcallEval, data[1], NULL, NULL, NULL);
}
@@ -4594,25 +4696,19 @@ TEOV_RunEnterTraces(
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_IncrRefCount(commandPtr);
- 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++;
@@ -4627,29 +4723,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 && (traceCode == TCL_OK)) {
- /*
- * Command was found: push a record to schedule the leave traces.
- */
-
- TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc),
- commandPtr, cmdPtr, objv);
- cmdPtr->refCount++;
- } else {
- Tcl_DecrRefCount(commandPtr);
+ if (cmdEpoch != newEpoch) {
+ *cmdPtrPtr = NULL;
}
- return traceCode;
+ return TCL_OK;
}
static int
@@ -4664,12 +4753,10 @@ TEOV_RunLeaveTraces(
Tcl_Obj *commandPtr = data[1];
Command *cmdPtr = data[2];
Tcl_Obj **objv = data[3];
-
+ int length;
+ const char *command = Tcl_GetStringFromObj(commandPtr, &length);
if (!(cmdPtr->flags & CMD_IS_DELETED)) {
- int length;
- const char *command = Tcl_GetStringFromObj(commandPtr, &length);
-
if (cmdPtr->flags & CMD_HAS_EXEC_TRACES){
traceCode = TclCheckExecutionTraces(interp, command, length,
cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
@@ -4679,7 +4766,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.
@@ -4690,8 +4776,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;
}
@@ -4707,7 +4803,6 @@ TEOV_LookupCmdFromObj(
if (lookupNsPtr) {
iPtr->varFramePtr->nsPtr = lookupNsPtr;
- iPtr->lookupNsPtr = NULL;
}
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, namePtr);
iPtr->varFramePtr->nsPtr = savedNsPtr;
@@ -5548,10 +5643,10 @@ TclArgumentBCEnter(
* 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
+ * shenanigans. This means that we don't have to tend to the
* housekeeping, and can escape now.
*/
-
+
if (ePtr->nline != objc) {
return;
}
@@ -5815,7 +5910,7 @@ Tcl_GlobalEvalObj(
*
* 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
+ * been removed since it was unused and untested. Failure to
* follow this limitation will lead to an assertion panic.
*
* Results:
@@ -6423,11 +6518,7 @@ TclObjInvokeNamespace(
* command.
*/
- result = TclPushStackFrame(interp, &framePtr, nsPtr, /*isProcFrame*/0);
- if (result != TCL_OK) {
- return TCL_ERROR;
- }
-
+ (void) TclPushStackFrame(interp, &framePtr, nsPtr, /*isProcFrame*/0);
result = TclObjInvoke(interp, objc, objv, flags);
TclPopStackFrame(interp);
@@ -6462,30 +6553,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;
@@ -6501,36 +6594,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;
}
@@ -7981,39 +8065,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);
}
/*
@@ -8106,31 +8162,36 @@ 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);
}
/*****************************************************************************
- * Stuff for tailcalls
+ * Tailcall related code
*****************************************************************************
*
- * Just to show that IT CAN BE DONE! The precise semantics are not simple,
- * require more thought. Possibly need a new Tcl return code to do it right?
- * Questions include:
- * (1) How is the objc/objv tailcall to be run? My current thinking is that
- * it should essentially be
- * [tailcall a b c] <=> [uplevel 1 [list a b c]]
- * with two caveats
- * (a) the current frame is dropped first, after running all pending
- * cleanup tasks and saving its namespace
- * (b) 'a' is looked up in the returning frame's namespace, but the
- * command is run in the context to which we are returning
- * Current implementation does this if [tailcall] is called from within
- * a proc, errors otherwise.
- * (2) Should a tailcall bypass [catch] in the returning frame? Current
- * implementation does not (or does it? Changed, test!) - it causes an
- * error.
- *
- * FIXME NRE!
+ * The steps of the tailcall dance are as follows:
+ *
+ * 1. when [tailcall] is invoked, it stores the corresponding callback in
+ * the current CallFrame and returns TCL_RETURN
+ * 2. when the CallFrame is popped, it calls TclSetTailcall to store the
+ * callback in the proper NRCommand callback - the spot where the command
+ * that pushed the CallFrame is completely cleaned up
+ * 3. when the NRCommand callback runs, it schedules the tailcall callback
+ * to run immediately after it returns
+ *
+ * One delicate point is to properly define the NRCommand where the tailcall
+ * will execute. There are functions whose purpose is to help define the
+ * precise spot:
+ * TclMarkTailcall: if the NEXT command to be pushed tailcalls, execution
+ * should continue right here
+ * TclSkipTailcall: if the NEXT command to be pushed tailcalls, execution
+ * should continue after the CURRENT command is fully returned ("skip
+ * the next command: we are redirecting to it, tailcalls should run
+ * after WE return")
+ * TclPushTailcallPoint: the search for a tailcalling spot cannot traverse
+ * this point. This is special for OO, as some of the oo constructs
+ * that behave like commands may not push an NRCommand callback.
*/
void
@@ -8164,6 +8225,18 @@ TclPushTailcallPoint(
((Interp *) interp)->numLevels++;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetTailcall --
+ *
+ * Splice a tailcall command in the proper spot of the NRE callback
+ * stack, so that it runs at the right time.
+ *
+ *----------------------------------------------------------------------
+ */
+
void
TclSetTailcall(
Tcl_Interp *interp,
@@ -8188,6 +8261,23 @@ TclSetTailcall(
runPtr->data[1] = listPtr;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNRTailcallObjCmd --
+ *
+ * Prepare the tailcall as a list and store it in the current
+ * varFrame. When the frame is later popped the tailcall will be spliced
+ * at the proper place.
+ *
+ * Results:
+ * The first NRCommand callback that is not marked to be skipped is
+ * updated so that its data[1] field contains the tailcall list.
+ *
+ *----------------------------------------------------------------------
+ */
+
int
TclNRTailcallObjCmd(
ClientData clientData,
@@ -8202,9 +8292,9 @@ TclNRTailcallObjCmd(
return TCL_ERROR;
}
- if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { /* or is upleveled */
+ if (!(iPtr->varFramePtr->isProcCallFrame & 1)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "tailcall can only be called from a proc or lambda", -1));
+ "tailcall can only be called from a proc, lambda or method", -1));
Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
return TCL_ERROR;
}
@@ -8222,8 +8312,7 @@ TclNRTailcallObjCmd(
/*
* Create the callback to actually evaluate the tailcalled
* command, then set it in the varFrame so that PopCallFrame can use it
- * at the proper time. Being lazy: exploit the TclNRAddCallBack macro to
- * build the callback.
+ * at the proper time.
*/
if (objc > 1) {
@@ -8233,7 +8322,7 @@ TclNRTailcallObjCmd(
/* The tailcall data is in a Tcl list: the first element is the
* namespace, the rest the command to be tailcalled. */
-
+
listPtr = Tcl_NewListObj(objc, objv);
nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
@@ -8242,12 +8331,23 @@ TclNRTailcallObjCmd(
Tcl_Panic("Tailcall failed to find the proper namespace");
}
TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
-
+
iPtr->varFramePtr->tailcallPtr = listPtr;
}
return TCL_RETURN;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNRTailcallEval --
+ *
+ * This NREcallback actually causes the tailcall to be evaluated.
+ *
+ *----------------------------------------------------------------------
+ */
+
int
TclNRTailcallEval(
ClientData data[],
@@ -8260,9 +8360,9 @@ TclNRTailcallEval(
int objc;
Tcl_Obj **objv;
- Tcl_ListObjGetElements(interp, listPtr, &objc, &objv);
+ Tcl_ListObjGetElements(interp, listPtr, &objc, &objv);
nsObjPtr = objv[0];
-
+
if (result == TCL_OK) {
result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
}
@@ -8377,8 +8477,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 ...?");
@@ -8392,11 +8491,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.
@@ -8405,15 +8506,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 901237b..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[] = {
@@ -607,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.
@@ -628,6 +629,7 @@ TclAppendBytesToByteArray(
int len)
{
ByteArray *byteArrayPtr;
+ int needed;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
@@ -636,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;
-
- 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]
- */
+ if (needed > byteArrayPtr->allocated) {
+ ByteArray *ptr = NULL;
+ int attempt;
- 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;
- TclInvalidateStringRep(objPtr);
}
+ byteArrayPtr->used += len;
+ TclInvalidateStringRep(objPtr);
}
/*
@@ -2312,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) {
@@ -2324,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;
@@ -2386,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;
@@ -2436,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
@@ -2472,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;
@@ -2495,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);
@@ -2525,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]);
}
}
}
@@ -2547,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.
@@ -2570,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 };
@@ -2597,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/tclClock.c b/generic/tclClock.c
index 6d2976d..949cb1c 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
@@ -522,6 +522,46 @@ ClockGetdatefieldsObjCmd(
*/
static int
+FetchEraField(
+ Tcl_Interp *interp,
+ Tcl_Obj *dict,
+ Tcl_Obj *key,
+ int *storePtr)
+{
+ Tcl_Obj *value = NULL;
+
+ if (Tcl_DictObjGet(interp, dict, key, &value) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (value == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "expected key(s) not found in dictionary", -1));
+ return TCL_ERROR;
+ }
+ return Tcl_GetIndexFromObj(interp, value, eras, "era", TCL_EXACT, storePtr);
+}
+
+static int
+FetchIntField(
+ Tcl_Interp *interp,
+ Tcl_Obj *dict,
+ Tcl_Obj *key,
+ int *storePtr)
+{
+ Tcl_Obj *value = NULL;
+
+ if (Tcl_DictObjGet(interp, dict, key, &value) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (value == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "expected key(s) not found in dictionary", -1));
+ return TCL_ERROR;
+ }
+ return TclGetIntFromObj(interp, value, storePtr);
+}
+
+static int
ClockGetjuliandayfromerayearmonthdayObjCmd(
ClientData clientData, /* Opaque pointer to literal pool, etc. */
Tcl_Interp *interp, /* Tcl interpreter */
@@ -532,7 +572,6 @@ ClockGetjuliandayfromerayearmonthdayObjCmd(
Tcl_Obj *dict;
ClockClientData *data = clientData;
Tcl_Obj *const *literals = data->literals;
- Tcl_Obj *fieldPtr;
int changeover;
int copied = 0;
int status;
@@ -547,18 +586,13 @@ ClockGetjuliandayfromerayearmonthdayObjCmd(
return TCL_ERROR;
}
dict = objv[1];
- if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
- || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
- &era) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR],
- &fieldPtr) != TCL_OK
- || TclGetIntFromObj(interp, fieldPtr, &fields.year) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_MONTH],
- &fieldPtr) != TCL_OK
- || TclGetIntFromObj(interp, fieldPtr, &fields.month) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH],
- &fieldPtr) != TCL_OK
- || TclGetIntFromObj(interp, fieldPtr, &fields.dayOfMonth)!=TCL_OK
+ if (FetchEraField(interp, dict, literals[LIT_ERA], &era) != TCL_OK
+ || FetchIntField(interp, dict, literals[LIT_YEAR], &fields.year)
+ != TCL_OK
+ || FetchIntField(interp, dict, literals[LIT_MONTH], &fields.month)
+ != TCL_OK
+ || FetchIntField(interp, dict, literals[LIT_DAYOFMONTH],
+ &fields.dayOfMonth) != TCL_OK
|| TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
return TCL_ERROR;
}
@@ -622,7 +656,6 @@ ClockGetjuliandayfromerayearweekdayObjCmd(
Tcl_Obj *dict;
ClockClientData *data = clientData;
Tcl_Obj *const *literals = data->literals;
- Tcl_Obj *fieldPtr;
int changeover;
int copied = 0;
int status;
@@ -637,18 +670,13 @@ ClockGetjuliandayfromerayearweekdayObjCmd(
return TCL_ERROR;
}
dict = objv[1];
- if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
- || 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
+ if (FetchEraField(interp, dict, literals[LIT_ERA], &era) != TCL_OK
+ || FetchIntField(interp, dict, literals[LIT_ISO8601YEAR],
+ &fields.iso8601Year) != TCL_OK
+ || FetchIntField(interp, dict, literals[LIT_ISO8601WEEK],
+ &fields.iso8601Week) != TCL_OK
+ || FetchIntField(interp, dict, literals[LIT_DAYOFWEEK],
+ &fields.dayOfWeek) != TCL_OK
|| TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
return TCL_ERROR;
}
@@ -1697,7 +1725,7 @@ ClockClicksObjCmd(
case 1:
break;
case 2:
- if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "switch", 0,
+ if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
@@ -1867,9 +1895,9 @@ ClockParseformatargsObjCmd(
localeObj = litPtr[LIT_C];
timezoneObj = litPtr[LIT__NIL];
for (i = 2; i < objc; i+=2) {
- if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", 0,
+ if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
&optionIndex) != TCL_OK) {
- Tcl_SetErrorCode(interp, "CLOCK", "badSwitch",
+ Tcl_SetErrorCode(interp, "CLOCK", "badOption",
Tcl_GetString(objv[i]), NULL);
return TCL_ERROR;
}
@@ -1977,22 +2005,23 @@ ClockSecondsObjCmd(
static void
TzsetIfNecessary(void)
{
- static char *tzWas = NULL; /* Previous value of TZ, protected by
+ static char* tzWas = INT2PTR(-1); /* Previous value of TZ, protected by
* clockMutex. */
const char *tzIsNow; /* Current value of TZ */
Tcl_MutexLock(&clockMutex);
tzIsNow = getenv("TZ");
- if (tzIsNow != NULL && (tzWas == NULL || strcmp(tzIsNow, tzWas) != 0)) {
+ if (tzIsNow != NULL && (tzWas == NULL || tzWas == INT2PTR(-1)
+ || strcmp(tzIsNow, tzWas) != 0)) {
tzset();
- if (tzWas != NULL) {
+ if (tzWas != NULL && tzWas != INT2PTR(-1)) {
ckfree(tzWas);
}
tzWas = ckalloc(strlen(tzIsNow) + 1);
strcpy(tzWas, tzIsNow);
} else if (tzIsNow == NULL && tzWas != NULL) {
tzset();
- ckfree(tzWas);
+ if (tzWas != INT2PTR(-1)) ckfree(tzWas);
tzWas = NULL;
}
Tcl_MutexUnlock(&clockMutex);
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index f90819a..54e0227 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -748,7 +748,7 @@ Tcl_EvalObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- return Tcl_NRCallObjProc(interp, TclNREvalObjCmd, dummy, objc, objv);
+ return Tcl_NRCallObjProc(interp, TclNREvalObjCmd, dummy, objc, objv);
}
int
@@ -1590,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 fa4ead4..0d35397 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -29,7 +29,7 @@
typedef struct SortElement {
union { /* The value that we sorting by. */
const char *strValuePtr;
- long intValue;
+ Tcl_WideInt wideValue;
double doubleValue;
Tcl_Obj *objValuePtr;
} collationKey;
@@ -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;
}
@@ -1283,6 +1287,7 @@ TclInfoFrame(
"eval", "eval", "eval", "precompiled", "source", "proc"
};
Proc *procPtr = framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;
+ int needsFree = -1;
/*
* Pull the information and construct the dictionary to return, as list.
@@ -1356,6 +1361,9 @@ TclInfoFrame(
}
ADD_PAIR("cmd", TclGetSourceFromFrame(fPtr, 0, NULL));
+ if (fPtr->cmdObj && framePtr->cmdObj == NULL) {
+ needsFree = lc - 1;
+ }
TclStackFree(interp, fPtr);
break;
}
@@ -1443,7 +1451,11 @@ TclInfoFrame(
}
}
- return Tcl_NewListObj(lc, lv);
+ tmpObj = Tcl_NewListObj(lc, lv);
+ if (needsFree >= 0) {
+ Tcl_DecrRefCount(lv[needsFree]);
+ }
+ return tmpObj;
}
/*
@@ -2378,7 +2390,10 @@ Tcl_LinsertObjCmd(
Tcl_ListObjAppendElement(NULL, listPtr, objv[3]);
} else {
- Tcl_ListObjReplace(NULL, listPtr, index, 0, (objc-3), &(objv[3]));
+ if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, index, 0,
+ (objc-3), &(objv[3]))) {
+ return TCL_ERROR;
+ }
}
/*
@@ -2651,7 +2666,7 @@ Tcl_LrepeatObjCmd(
* number of times.
*/
- CLANG_ASSERT(dataArray);
+ CLANG_ASSERT(dataArray || totalElems == 0 );
if (objc == 1) {
register Tcl_Obj *tmpPtr = objv[0];
@@ -2740,7 +2755,7 @@ Tcl_LreplaceObjCmd(
* (to allow for replacing the last elem).
*/
- if ((first >= listLen) && (listLen > 0)) {
+ if ((first > listLen) && (listLen > 0)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"list doesn't contain element %s", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX",
@@ -2774,7 +2789,10 @@ Tcl_LreplaceObjCmd(
* optimize this case away.
*/
- Tcl_ListObjReplace(NULL, listPtr, first, numToDelete, objc-4, objv+4);
+ if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
+ objc-4, objv+4)) {
+ return TCL_ERROR;
+ }
/*
* Set the interpreter's object result.
@@ -2889,7 +2907,8 @@ Tcl_LsearchObjCmd(
{
const char *bytes, *patternBytes;
int i, match, index, result, listc, length, elemLen, bisect;
- int dataType, isIncreasing, lower, upper, patInt, objInt, offset;
+ int dataType, isIncreasing, lower, upper, offset;
+ Tcl_WideInt patWide, objWide;
int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
double patDouble, objDouble;
SortInfo sortInfo;
@@ -3208,7 +3227,7 @@ Tcl_LsearchObjCmd(
patternBytes = TclGetStringFromObj(patObj, &length);
break;
case INTEGER:
- result = TclGetIntFromObj(interp, patObj, &patInt);
+ result = TclGetWideIntFromObj(interp, patObj, &patWide);
if (result != TCL_OK) {
goto done;
}
@@ -3277,13 +3296,13 @@ Tcl_LsearchObjCmd(
match = DictionaryCompare(patternBytes, bytes);
break;
case INTEGER:
- result = TclGetIntFromObj(interp, itemPtr, &objInt);
+ result = TclGetWideIntFromObj(interp, itemPtr, &objWide);
if (result != TCL_OK) {
goto done;
}
- if (patInt == objInt) {
+ if (patWide == objWide) {
match = 0;
- } else if (patInt < objInt) {
+ } else if (patWide < objWide) {
match = -1;
} else {
match = 1;
@@ -3396,14 +3415,14 @@ Tcl_LsearchObjCmd(
break;
case INTEGER:
- result = TclGetIntFromObj(interp, itemPtr, &objInt);
+ result = TclGetWideIntFromObj(interp, itemPtr, &objWide);
if (result != TCL_OK) {
if (listPtr != NULL) {
Tcl_DecrRefCount(listPtr);
}
goto done;
}
- match = (objInt == patInt);
+ match = (objWide == patWide);
break;
case REAL:
@@ -3967,13 +3986,13 @@ Tcl_LsortObjCmd(
if (sortMode == SORTMODE_ASCII) {
elementArray[i].collationKey.strValuePtr = TclGetString(indexPtr);
} else if (sortMode == SORTMODE_INTEGER) {
- long a;
+ Tcl_WideInt a;
- if (TclGetLongFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) {
+ if (TclGetWideIntFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) {
sortInfo.resultCode = TCL_ERROR;
goto done1;
}
- elementArray[i].collationKey.intValue = a;
+ elementArray[i].collationKey.wideValue = a;
} else if (sortMode == SORTMODE_REAL) {
double a;
@@ -4222,10 +4241,10 @@ SortCompare(
order = DictionaryCompare(elemPtr1->collationKey.strValuePtr,
elemPtr2->collationKey.strValuePtr);
} else if (infoPtr->sortMode == SORTMODE_INTEGER) {
- long a, b;
+ Tcl_WideInt a, b;
- a = elemPtr1->collationKey.intValue;
- b = elemPtr2->collationKey.intValue;
+ a = elemPtr1->collationKey.wideValue;
+ b = elemPtr2->collationKey.wideValue;
order = ((a >= b) - (a <= b));
} else if (infoPtr->sortMode == SORTMODE_REAL) {
double a, b;
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 5087fbb..13f9e7d 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) */
+;
/*
*----------------------------------------------------------------------
@@ -159,7 +161,7 @@ Tcl_RegexpObjCmd(
if (name[0] != '-') {
break;
}
- if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT,
+ if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", TCL_EXACT,
&index) != TCL_OK) {
goto optionError;
}
@@ -215,7 +217,7 @@ Tcl_RegexpObjCmd(
endOfForLoop:
if ((objc - i) < (2 - about)) {
Tcl_WrongNumArgs(interp, 1, objv,
- "?-switch ...? exp string ?matchVar? ?subMatchVar ...?");
+ "?-option ...? exp string ?matchVar? ?subMatchVar ...?");
goto optionError;
}
objc -= i;
@@ -229,6 +231,8 @@ Tcl_RegexpObjCmd(
if (doinline && ((objc - 2) != 0)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"regexp match variables not allowed when using -inline", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "REGEXP",
+ "MIX_VAR_INLINE", NULL);
goto optionError;
}
@@ -517,7 +521,7 @@ Tcl_RegsubObjCmd(
if (name[0] != '-') {
break;
}
- if (Tcl_GetIndexFromObj(interp, objv[idx], options, "switch",
+ if (Tcl_GetIndexFromObj(interp, objv[idx], options, "option",
TCL_EXACT, &index) != TCL_OK) {
goto optionError;
}
@@ -564,7 +568,7 @@ Tcl_RegsubObjCmd(
endOfForLoop:
if (objc-idx < 3 || objc-idx > 4) {
Tcl_WrongNumArgs(interp, 1, objv,
- "?-switch ...? exp string subSpec ?varName?");
+ "?-option ...? exp string subSpec ?varName?");
optionError:
if (startIndex) {
Tcl_DecrRefCount(startIndex);
@@ -2834,6 +2838,59 @@ StringCmpCmd(
/*
*----------------------------------------------------------------------
*
+ * StringCatCmd --
+ *
+ * This procedure is invoked to process the "string cat" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringCatCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int i;
+ Tcl_Obj *objResultPtr;
+
+ if (objc < 2) {
+ /*
+ * If there are no args, the result is an empty object.
+ * Just leave the preset empty interp result.
+ */
+ return TCL_OK;
+ }
+ if (objc == 2) {
+ /*
+ * Other trivial case, single arg, just return it.
+ */
+ Tcl_SetObjResult(interp, objv[1]);
+ return TCL_OK;
+ }
+ objResultPtr = objv[1];
+ if (Tcl_IsShared(objResultPtr)) {
+ objResultPtr = Tcl_DuplicateObj(objResultPtr);
+ }
+ for(i = 2;i < objc;i++) {
+ Tcl_AppendObjToObj(objResultPtr, objv[i]);
+ }
+ Tcl_SetObjResult(interp, objResultPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* StringBytesCmd --
*
* This procedure is invoked to process the "string bytelength" Tcl
@@ -3189,8 +3246,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;
@@ -3237,8 +3294,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;
@@ -3283,8 +3340,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;
@@ -3326,25 +3383,26 @@ TclInitStringCmd(
{
static const EnsembleImplMap stringImplMap[] = {
{"bytelength", StringBytesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"cat", StringCatCmd, TclCompileStringCatCmd, NULL, NULL, 0},
{"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0},
{"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}
@@ -3389,7 +3447,7 @@ TclSubstOptions(
for (i = 0; i < numOpts; i++) {
int optionIndex;
- if (Tcl_GetIndexFromObj(interp, opts[i], substOptions, "switch", 0,
+ if (Tcl_GetIndexFromObj(interp, opts[i], substOptions, "option", 0,
&optionIndex) != TCL_OK) {
return TCL_ERROR;
}
@@ -3589,7 +3647,7 @@ TclNRSwitchObjCmd(
finishedOptions:
if (objc - i < 2) {
Tcl_WrongNumArgs(interp, 1, objv,
- "?-switch ...? string ?pattern body ...? ?default body?");
+ "?-option ...? string ?pattern body ...? ?default body?");
return TCL_ERROR;
}
if (indexVarObj != NULL && mode != OPT_REGEXP) {
@@ -3636,7 +3694,7 @@ TclNRSwitchObjCmd(
if (objc < 1) {
Tcl_WrongNumArgs(interp, 1, savedObjv,
- "?-switch ...? string {?pattern body ...? ?default body?}");
+ "?-option ...? string {?pattern body ...? ?default body?}");
return TCL_ERROR;
}
objv = listv;
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 8edb2d9..3ab03cc 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -26,11 +26,23 @@ static void FreeDictUpdateInfo(ClientData clientData);
static void PrintDictUpdateInfo(ClientData clientData,
Tcl_Obj *appendObj, ByteCode *codePtr,
unsigned int pcOffset);
+static void DisassembleDictUpdateInfo(ClientData clientData,
+ Tcl_Obj *dictObj, ByteCode *codePtr,
+ unsigned int pcOffset);
static ClientData DupForeachInfo(ClientData clientData);
static void FreeForeachInfo(ClientData clientData);
static void PrintForeachInfo(ClientData clientData,
Tcl_Obj *appendObj, ByteCode *codePtr,
unsigned int pcOffset);
+static void DisassembleForeachInfo(ClientData clientData,
+ Tcl_Obj *dictObj, ByteCode *codePtr,
+ unsigned int pcOffset);
+static void PrintNewForeachInfo(ClientData clientData,
+ Tcl_Obj *appendObj, ByteCode *codePtr,
+ unsigned int pcOffset);
+static void DisassembleNewForeachInfo(ClientData clientData,
+ Tcl_Obj *dictObj, ByteCode *codePtr,
+ unsigned int pcOffset);
static int CompileEachloopCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
CompileEnv *envPtr, int collect);
@@ -42,23 +54,66 @@ static int CompileDictEachCmd(Tcl_Interp *interp,
* The structures below define the AuxData types defined in this file.
*/
-const AuxDataType tclForeachInfoType = {
+static const AuxDataType foreachInfoType = {
"ForeachInfo", /* name */
DupForeachInfo, /* dupProc */
FreeForeachInfo, /* freeProc */
- PrintForeachInfo /* printProc */
+ PrintForeachInfo, /* printProc */
+ DisassembleForeachInfo /* disassembleProc */
};
-const AuxDataType tclDictUpdateInfoType = {
+static const AuxDataType newForeachInfoType = {
+ "NewForeachInfo", /* name */
+ DupForeachInfo, /* dupProc */
+ FreeForeachInfo, /* freeProc */
+ PrintNewForeachInfo, /* printProc */
+ DisassembleNewForeachInfo /* disassembleProc */
+};
+
+static const AuxDataType dictUpdateInfoType = {
"DictUpdateInfo", /* name */
DupDictUpdateInfo, /* dupProc */
FreeDictUpdateInfo, /* freeProc */
- PrintDictUpdateInfo /* printProc */
+ PrintDictUpdateInfo, /* printProc */
+ DisassembleDictUpdateInfo /* disassembleProc */
};
/*
*----------------------------------------------------------------------
*
+ * TclGetAuxDataType --
+ *
+ * This procedure looks up an Auxdata type by name.
+ *
+ * Results:
+ * If an AuxData type with name matching "typeName" is found, a pointer
+ * to its AuxDataType structure is returned; otherwise, NULL is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+const AuxDataType *
+TclGetAuxDataType(
+ const char *typeName) /* Name of AuxData type to look up. */
+{
+ if (!strcmp(typeName, foreachInfoType.name)) {
+ return &foreachInfoType;
+ } else if (!strcmp(typeName, newForeachInfoType.name)) {
+ return &newForeachInfoType;
+ } else if (!strcmp(typeName, dictUpdateInfoType.name)) {
+ return &dictUpdateInfoType;
+ } else if (!strcmp(typeName, tclJumptableInfoType.name)) {
+ return &tclJumptableInfoType;
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclCompileAppendCmd --
*
* Procedure called to compile the "append" command.
@@ -155,9 +210,9 @@ TclCompileAppendCmd(
*/
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
- &localIndex, &isScalar, 1);
- if (!isScalar || localIndex < 0) {
+
+ localIndex = LocalScalarFromToken(varTokenPtr, envPtr);
+ if (localIndex < 0) {
return TCL_ERROR;
}
@@ -245,8 +300,8 @@ TclCompileArraySetCmd(
Tcl_Token *varTokenPtr, *dataTokenPtr;
int isScalar, localIndex, code = TCL_OK;
int isDataLiteral, isDataValid, isDataEven, len;
- int dataVar, iterVar, keyVar, valVar, infoIndex;
- int back, fwd, offsetBack, offsetFwd;
+ int keyVar, valVar, infoIndex;
+ int fwd, offsetBack, offsetFwd;
Tcl_Obj *literalObj;
ForeachInfo *infoPtr;
@@ -268,8 +323,8 @@ TclCompileArraySetCmd(
if (isDataValid && !isDataEven) {
PushStringLiteral(envPtr, "list must have an even number of elements");
- PushStringLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}");
- TclEmitInstInt4(INST_RETURN_IMM, 1, envPtr);
+ PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}");
+ TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR, envPtr);
TclEmitInt4( 0, envPtr);
goto done;
}
@@ -279,7 +334,8 @@ TclCompileArraySetCmd(
* a proc, we cannot do a better compile than generic.
*/
- if (envPtr->procPtr == NULL && !(isDataEven && len == 0)) {
+ if ((varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) ||
+ (envPtr->procPtr == NULL && !(isDataEven && len == 0))) {
code = TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
goto done;
}
@@ -290,6 +346,7 @@ TclCompileArraySetCmd(
code = TCL_ERROR;
goto done;
}
+
/*
* Special case: literal empty value argument is just an "ensure array"
* operation.
@@ -314,24 +371,34 @@ TclCompileArraySetCmd(
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 = TclFindCompiledLocal(varTokenPtr->start,
+ varTokenPtr->size, 1, envPtr);
+ PushStringLiteral(envPtr, "0");
+ TclEmitInstInt4(INST_REVERSE, 2, envPtr);
+ TclEmitInstInt4(INST_UPVAR, localIndex, envPtr);
+ TclEmitOpcode(INST_POP, envPtr);
+ }
+
/*
* Prepare for the internal foreach.
*/
- dataVar = AnonymousLocal(envPtr);
- iterVar = AnonymousLocal(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;
- infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr);
+ infoIndex = TclCreateAuxData(infoPtr, &newForeachInfoType, envPtr);
/*
* Start issuing instructions to write to the array.
@@ -353,61 +420,30 @@ TclCompileArraySetCmd(
offsetFwd = CurrentOffset(envPtr);
TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr);
PushStringLiteral(envPtr, "list must have an even number of elements");
- PushStringLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}");
- TclEmitInstInt4(INST_RETURN_IMM, 1, envPtr);
+ 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);
}
- Emit14Inst( INST_STORE_SCALAR, dataVar, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
- 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);
- 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);
- } 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);
- offsetFwd = CurrentOffset(envPtr);
- TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr);
- 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);
- fwd = CurrentOffset(envPtr) - offsetFwd;
- TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
- TclEmitOpcode( INST_POP, envPtr);
- }
- if (!isDataLiteral) {
- TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr);
- TclEmitInt4( dataVar, envPtr);
- }
+ 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:
+
+ done:
Tcl_DecrRefCount(literalObj);
return code;
}
@@ -500,17 +536,14 @@ TclCompileBreakCmd(
TclCleanupStackForBreakContinue(envPtr, auxPtr);
TclAddLoopBreakFixup(envPtr, auxPtr);
- TclAdjustStackDepth(1, envPtr);
} else {
/*
* Emit a real break.
*/
- PushStringLiteral(envPtr, "");
- TclEmitOpcode(INST_DUP, envPtr);
- TclEmitInstInt4(INST_RETURN_IMM, TCL_BREAK, envPtr);
- TclEmitInt4(0, envPtr);
+ TclEmitOpcode(INST_BREAK, envPtr);
}
+ TclAdjustStackDepth(1, envPtr);
return TCL_OK;
}
@@ -544,8 +577,9 @@ TclCompileCatchCmd(
{
JumpFixup jumpFixup;
Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
- int resultIndex, optsIndex, range;
+ 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.
@@ -593,11 +627,7 @@ TclCompileCatchCmd(
/*
* We will compile the catch command. Declare the exception range that it
* uses.
- */
-
- range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
-
- /*
+ *
* 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
@@ -610,6 +640,7 @@ TclCompileCatchCmd(
* begin by undeflowing the stack below the mark set by BEGIN_CATCH4.
*/
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
ExceptionRangeStarts(envPtr, range);
@@ -620,71 +651,51 @@ TclCompileCatchCmd(
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);
- PushStringLiteral(envPtr, "0");
- TclEmitInstInt1( INST_JUMP1, 3, envPtr);
- TclAdjustStackDepth(-1, envPtr);
- 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.
*/
+ 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.
*/
- TclAdjustStackDepth(-2, envPtr);
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) {
@@ -695,53 +706,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);
}
+ TclEmitInstInt4( INST_CONCAT_STK, i-1, envPtr);
+
return TCL_OK;
}
@@ -796,17 +872,14 @@ TclCompileContinueCmd(
TclCleanupStackForBreakContinue(envPtr, auxPtr);
TclAddLoopContinueFixup(envPtr, auxPtr);
- TclAdjustStackDepth(1, envPtr);
} else {
/*
* Emit a real continue.
*/
- PushStringLiteral(envPtr, "");
- TclEmitOpcode(INST_DUP, envPtr);
- TclEmitInstInt4(INST_RETURN_IMM, TCL_CONTINUE, envPtr);
- TclEmitInt4(0, envPtr);
+ TclEmitOpcode(INST_CONTINUE, envPtr);
}
+ TclAdjustStackDepth(1, envPtr);
return TCL_OK;
}
@@ -839,7 +912,7 @@ TclCompileDictSetCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr;
- int numWords, i, dictVarIndex;
+ int i, dictVarIndex;
DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr;
@@ -868,8 +941,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);
}
@@ -878,7 +950,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;
@@ -950,7 +1022,7 @@ TclCompileDictIncrCmd(
* 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;
@@ -966,7 +1038,7 @@ TclCompileDictGetCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr;
- int numWords, i;
+ int i;
DefineLineInformation; /* TIP #280 */
/*
@@ -979,17 +1051,16 @@ TclCompileDictGetCmd(
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;
}
@@ -1004,7 +1075,7 @@ TclCompileDictExistsCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr;
- int numWords, i;
+ int i;
DefineLineInformation; /* TIP #280 */
/*
@@ -1017,17 +1088,16 @@ TclCompileDictExistsCmd(
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;
}
@@ -1426,7 +1496,7 @@ CompileDictEachCmd(
* this point.
*/
- CompileWord(envPtr, dictTokenPtr, interp, 3);
+ CompileWord(envPtr, dictTokenPtr, interp, 2);
/*
* Now we catch errors from here on so that we can finalize the search
@@ -1632,10 +1702,10 @@ TclCompileDictUpdateCmd(
* can't be snagged by literal sharing and forced to shimmer dangerously.
*/
- infoIndex = TclCreateAuxData(duiPtr, &tclDictUpdateInfoType, envPtr);
+ infoIndex = TclCreateAuxData(duiPtr, &dictUpdateInfoType, 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);
@@ -1678,7 +1748,7 @@ TclCompileDictUpdateCmd(
TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr);
TclEmitInt4( infoIndex, envPtr);
- TclEmitOpcode( INST_RETURN_STK, envPtr);
+ TclEmitInvoke(envPtr,INST_RETURN_STK);
if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
@@ -1742,7 +1812,7 @@ TclCompileDictAppendCmd(
tokenPtr = TokenAfter(tokenPtr);
}
if (parsePtr->numWords > 4) {
- TclEmitInstInt1(INST_CONCAT1, parsePtr->numWords-3, envPtr);
+ TclEmitInstInt1(INST_STR_CONCAT1, parsePtr->numWords-3, envPtr);
}
/*
@@ -1792,8 +1862,8 @@ TclCompileDictLappendCmd(
* Issue the implementation.
*/
- CompileWord(envPtr, keyTokenPtr, interp, 3);
- CompileWord(envPtr, valueTokenPtr, interp, 4);
+ CompileWord(envPtr, keyTokenPtr, interp, 2);
+ CompileWord(envPtr, valueTokenPtr, interp, 3);
TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr);
return TCL_OK;
}
@@ -1878,7 +1948,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);
@@ -1905,7 +1975,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);
@@ -1919,7 +1989,7 @@ TclCompileDictWithCmd(
* 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);
PushStringLiteral(envPtr, "");
@@ -1954,13 +2024,13 @@ TclCompileDictWithCmd(
*/
if (dictVar == -1) {
- CompileWord(envPtr, varTokenPtr, interp, 0);
+ 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);
@@ -2036,7 +2106,7 @@ 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.
@@ -2061,11 +2131,13 @@ TclCompileDictWithCmd(
* DupDictUpdateInfo: a copy of the auxiliary data
* FreeDictUpdateInfo: none
* PrintDictUpdateInfo: none
+ * DisassembleDictUpdateInfo: none
*
* Side effects:
* DupDictUpdateInfo: allocates memory
* FreeDictUpdateInfo: releases memory
* PrintDictUpdateInfo: none
+ * DisassembleDictUpdateInfo: none
*
*----------------------------------------------------------------------
*/
@@ -2108,6 +2180,25 @@ PrintDictUpdateInfo(
Tcl_AppendPrintfToObj(appendObj, "%%v%u", duiPtr->varIndices[i]);
}
}
+
+static void
+DisassembleDictUpdateInfo(
+ ClientData clientData,
+ Tcl_Obj *dictObj,
+ ByteCode *codePtr,
+ unsigned int pcOffset)
+{
+ DictUpdateInfo *duiPtr = clientData;
+ int i;
+ Tcl_Obj *variables = Tcl_NewObj();
+
+ for (i=0 ; i<duiPtr->length ; i++) {
+ Tcl_ListObjAppendElement(NULL, variables,
+ Tcl_NewIntObj(duiPtr->varIndices[i]));
+ }
+ Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("variables", -1),
+ variables);
+}
/*
*----------------------------------------------------------------------
@@ -2138,19 +2229,48 @@ TclCompileErrorCmd(
{
/*
* General syntax: [error message ?errorInfo? ?errorCode?]
- * However, we only deal with the case where there is just a message.
*/
- Tcl_Token *messageTokenPtr;
+
+ Tcl_Token *tokenPtr;
DefineLineInformation; /* TIP #280 */
- if (parsePtr->numWords != 2) {
+ if (parsePtr->numWords < 2 || parsePtr->numWords > 4) {
return TCL_ERROR;
}
- messageTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushStringLiteral(envPtr, "-code error -level 0");
- CompileWord(envPtr, messageTokenPtr, interp, 1);
- TclEmitOpcode(INST_RETURN_STK, envPtr);
+ /*
+ * 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;
}
@@ -2228,7 +2348,7 @@ TclCompileForCmd(
{
Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
JumpFixup jumpEvalCondFixup;
- int testCodeOffset, bodyCodeOffset, nextCodeOffset, jumpDist;
+ int bodyCodeOffset, nextCodeOffset, jumpDist;
int bodyRange, nextRange;
DefineLineInformation; /* TIP #280 */
@@ -2309,13 +2429,9 @@ TclCompileForCmd(
* 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);
@@ -2444,33 +2560,17 @@ CompileEachloopCmd(
* (TCL_EACH_*) */
{
Proc *procPtr = envPtr->procPtr;
- ForeachInfo *infoPtr; /* Points to the structure describing this
+ ForeachInfo *infoPtr=NULL; /* 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;
- int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
+ int jumpBackOffset, infoIndex, range;
+ int numWords, numLists, i, j, code = TCL_OK;
+ Tcl_Obj *varListObj = NULL;
DefineLineInformation; /* TIP #280 */
/*
- * We parse the variable list argument words and create two arrays:
- * varcList[i] is number of variables in i-th var list.
- * varvList[i] points to array of var names in i-th var list.
- */
-
- int *varcList;
- const char ***varvList;
-
- /*
* If the foreach command isn't in a procedure, don't compile it inline:
* the payoff is too small.
*/
@@ -2498,260 +2598,148 @@ CompileEachloopCmd(
}
/*
- * Allocate storage for the varcList and varvList arrays if necessary.
+ * Create and initialize the ForeachInfo and ForeachVarList data
+ * structures describing this command. Then create a AuxData record
+ * pointing to the ForeachInfo structure.
*/
numLists = (numWords - 2)/2;
- varcList = TclStackAlloc(interp, numLists * sizeof(int));
- memset(varcList, 0, numLists * sizeof(int));
- varvList = (const char ***) TclStackAlloc(interp,
- numLists * sizeof(const char **));
- memset((char*) varvList, 0, numLists * sizeof(const char **));
+ infoPtr = ckalloc(sizeof(ForeachInfo)
+ + (numLists - 1) * sizeof(ForeachVarList *));
+ infoPtr->numLists = 0; /* Count this up as we go */
/*
- * Break up each var list and set the varcList and varvList arrays. Don't
+ * Parse each var list into sequence of var names. Don't
* compile the foreach inline if any var name needs substitutions or isn't
* a scalar, or if any var list needs substitutions.
*/
- loopIndex = 0;
+ varListObj = Tcl_NewObj();
for (i = 0, tokenPtr = parsePtr->tokenPtr;
i < numWords-1;
i++, tokenPtr = TokenAfter(tokenPtr)) {
- Tcl_DString varList;
+ ForeachVarList *varListPtr;
+ int numVars;
if (i%2 != 1) {
continue;
}
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- code = TCL_ERROR;
- goto done;
- }
-
- /*
- * Lots of copying going on here. Need a ListObj wizard to show a
- * better way.
- */
-
- Tcl_DStringInit(&varList);
- TclDStringAppendToken(&varList, &tokenPtr[1]);
- code = Tcl_SplitList(NULL, Tcl_DStringValue(&varList),
- &varcList[loopIndex], &varvList[loopIndex]);
- Tcl_DStringFree(&varList);
- if (code != TCL_OK) {
- code = TCL_ERROR;
- goto done;
- }
- numVars = varcList[loopIndex];
/*
* If the variable list is empty, we can enter an infinite loop when
- * the interpreted version would not. Take care to ensure this does
- * not happen. [Bug 1671138]
+ * the interpreted version would not. Take care to ensure this does
+ * not happen. [Bug 1671138]
*/
- if (numVars == 0) {
+ if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) ||
+ TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) ||
+ numVars == 0) {
code = TCL_ERROR;
goto done;
}
- for (j = 0; j < numVars; j++) {
- const char *varName = varvList[loopIndex][j];
+ varListPtr = ckalloc(sizeof(ForeachVarList)
+ + (numVars - 1) * sizeof(int));
+ varListPtr->numVars = numVars;
+ infoPtr->varLists[i/2] = varListPtr;
+ infoPtr->numLists++;
- if (!TclIsLocalScalar(varName, (int) strlen(varName))) {
+ for (j = 0; j < numVars; j++) {
+ Tcl_Obj *varNameObj;
+ const char *bytes;
+ int numBytes, varIndex;
+
+ Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
+ bytes = Tcl_GetStringFromObj(varNameObj, &numBytes);
+ varIndex = LocalScalar(bytes, numBytes, envPtr);
+ if (varIndex < 0) {
code = TCL_ERROR;
goto done;
}
+ varListPtr->varIndexes[j] = varIndex;
}
- loopIndex++;
+ Tcl_SetObjLength(varListObj, 0);
}
- if (collect == TCL_EACH_COLLECT) {
- collectVar = AnonymousLocal(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 = AnonymousLocal(envPtr);
- if (loopIndex == 0) {
- firstValueTemp = tempVar;
- }
- }
- loopCtTemp = AnonymousLocal(envPtr);
+ infoIndex = TclCreateAuxData(infoPtr, &newForeachInfoType, envPtr);
/*
- * Create and initialize the ForeachInfo and ForeachVarList data
- * structures describing this command. Then create a AuxData record
- * pointing to the ForeachInfo structure.
+ * Create the collecting object, unshared.
*/
- infoPtr = ckalloc(sizeof(ForeachInfo)
- + numLists * 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));
- varListPtr->numVars = numVars;
- for (j = 0; j < numVars; j++) {
- const char *varName = varvList[loopIndex][j];
- int nameChars = strlen(varName);
-
- varListPtr->varIndexes[j] = TclFindCompiledLocal(varName,
- nameChars, /*create*/ 1, envPtr);
- }
- infoPtr->varLists[loopIndex] = varListPtr;
+ if (collect == TCL_EACH_COLLECT) {
+ TclEmitInstInt4(INST_LIST, 0, envPtr);
}
- infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr);
-
- /*
- * Create an exception record to handle [break] and [continue].
- */
-
- range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, 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)) {
CompileWord(envPtr, tokenPtr, interp, i);
- tempVar = (firstValueTemp + loopIndex);
- Emit14Inst( INST_STORE_SCALAR, tempVar, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
- loopIndex++;
}
}
- /*
- * Create temporary variable to capture return values from loop body.
- */
-
- if (collect == TCL_EACH_COLLECT) {
- PushStringLiteral(envPtr, "");
- 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.
*/
+ range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+
ExceptionRangeStarts(envPtr, range);
BODY(bodyTokenPtr, numWords - 1);
ExceptionRangeEnds(envPtr, range);
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);
- TclFinalizeLoopExceptionRange(envPtr, range);
+ 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.
*/
- if (collect == TCL_EACH_COLLECT) {
- Emit14Inst( INST_LOAD_SCALAR, collectVar, envPtr);
- TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr);
- TclEmitInt4( collectVar, envPtr);
- } else {
+ if (collect != TCL_EACH_COLLECT) {
PushStringLiteral(envPtr, "");
}
- done:
- for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
- if (varvList[loopIndex] != NULL) {
- ckfree(varvList[loopIndex]);
- }
+ done:
+ if (code == TCL_ERROR) {
+ FreeForeachInfo(infoPtr);
}
- TclStackFree(interp, (void *)varvList);
- TclStackFree(interp, varcList);
+ Tcl_DecrRefCount(varListObj);
return code;
}
@@ -2845,10 +2833,10 @@ FreeForeachInfo(
/*
*----------------------------------------------------------------------
*
- * PrintForeachInfo --
+ * PrintForeachInfo, DisassembleForeachInfo --
*
- * Function to write a human-readable representation of a ForeachInfo
- * structure to stdout for debugging.
+ * Functions to write a human-readable or script-readablerepresentation
+ * of a ForeachInfo structure to a Tcl_Obj for debugging.
*
* Results:
* None.
@@ -2898,6 +2886,119 @@ 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);
+ }
+}
+
+static void
+DisassembleForeachInfo(
+ ClientData clientData,
+ Tcl_Obj *dictObj,
+ ByteCode *codePtr,
+ unsigned int pcOffset)
+{
+ register ForeachInfo *infoPtr = clientData;
+ register ForeachVarList *varsPtr;
+ int i, j;
+ Tcl_Obj *objPtr, *innerPtr;
+
+ /*
+ * Data stores.
+ */
+
+ objPtr = Tcl_NewObj();
+ for (i=0 ; i<infoPtr->numLists ; i++) {
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(infoPtr->firstValueTemp + i));
+ }
+ Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("data", -1), objPtr);
+
+ /*
+ * Loop counter.
+ */
+
+ Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("loop", -1),
+ Tcl_NewIntObj(infoPtr->loopCtTemp));
+
+ /*
+ * Assignment targets.
+ */
+
+ objPtr = Tcl_NewObj();
+ for (i=0 ; i<infoPtr->numLists ; i++) {
+ innerPtr = Tcl_NewObj();
+ varsPtr = infoPtr->varLists[i];
+ for (j=0 ; j<varsPtr->numVars ; j++) {
+ Tcl_ListObjAppendElement(NULL, innerPtr,
+ Tcl_NewIntObj(varsPtr->varIndexes[j]));
+ }
+ Tcl_ListObjAppendElement(NULL, objPtr, innerPtr);
+ }
+ Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr);
+}
+
+static void
+DisassembleNewForeachInfo(
+ ClientData clientData,
+ Tcl_Obj *dictObj,
+ ByteCode *codePtr,
+ unsigned int pcOffset)
+{
+ register ForeachInfo *infoPtr = clientData;
+ register ForeachVarList *varsPtr;
+ int i, j;
+ Tcl_Obj *objPtr, *innerPtr;
+
+ /*
+ * Jump offset.
+ */
+
+ Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("jumpOffset", -1),
+ Tcl_NewIntObj(infoPtr->loopCtTemp));
+
+ /*
+ * Assignment targets.
+ */
+
+ objPtr = Tcl_NewObj();
+ for (i=0 ; i<infoPtr->numLists ; i++) {
+ innerPtr = Tcl_NewObj();
+ varsPtr = infoPtr->varLists[i];
+ for (j=0 ; j<varsPtr->numVars ; j++) {
+ Tcl_ListObjAppendElement(NULL, innerPtr,
+ Tcl_NewIntObj(varsPtr->varIndexes[j]));
+ }
+ Tcl_ListObjAppendElement(NULL, objPtr, innerPtr);
+ }
+ Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr);
+}
/*
*----------------------------------------------------------------------
@@ -3104,7 +3205,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
@@ -3123,6 +3224,54 @@ TclCompileFormatCmd(
/*
*----------------------------------------------------------------------
*
+ * TclLocalScalarFromToken --
+ *
+ * Get the index into the table of compiled locals that corresponds
+ * to a local scalar variable name.
+ *
+ * Results:
+ * Returns the non-negative integer index value into the table of
+ * compiled locals corresponding to a local scalar variable name.
+ * If the arguments passed in do not identify a local scalar variable
+ * then return -1.
+ *
+ * Side effects:
+ * May add an entery into the table of compiled locals.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLocalScalarFromToken(
+ Tcl_Token *tokenPtr,
+ CompileEnv *envPtr)
+{
+ int isScalar, index;
+
+ TclPushVarName(NULL, tokenPtr, envPtr, TCL_NO_ELEMENT, &index, &isScalar);
+ if (!isScalar) {
+ index = -1;
+ }
+ return index;
+}
+
+int
+TclLocalScalar(
+ const char *bytes,
+ int numBytes,
+ CompileEnv *envPtr)
+{
+ Tcl_Token token[2] = {{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1},
+ {TCL_TOKEN_TEXT, NULL, 0, 0}};
+
+ token[1].start = bytes;
+ token[1].size = numBytes;
+ return TclLocalScalarFromToken(token, envPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclPushVarName --
*
* Procedure used in the compiling where pushing a variable name is
@@ -3178,16 +3327,7 @@ TclPushVarName(
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] != '{')) {
+ if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
/*
* A simple variable name. Divide it up into "name" and "elName"
* strings. If it is not a local variable, look it up at runtime.
@@ -3211,7 +3351,7 @@ TclPushVarName(
}
}
- if ((elName != NULL) && elNameChars) {
+ if (!(flags & TCL_NO_ELEMENT) && (elName != NULL) && elNameChars) {
/*
* An array element, the element name is a simple string:
* assemble the corresponding token.
@@ -3226,7 +3366,7 @@ TclPushVarName(
elemTokenCount = 1;
}
}
- } else if (((n = varTokenPtr->numComponents) > 1)
+ } else if (interp && ((n = varTokenPtr->numComponents) > 1)
&& (varTokenPtr[1].type == TCL_TOKEN_TEXT)
&& (varTokenPtr[n].type == TCL_TOKEN_TEXT)
&& (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
@@ -3262,9 +3402,10 @@ TclPushVarName(
nameChars = p - varTokenPtr[1].start;
elName = p + 1;
remainingChars = (varTokenPtr[2].start - p) - 1;
- elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 2;
+ elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 1;
- if (remainingChars) {
+ if (!(flags & TCL_NO_ELEMENT)) {
+ if (remainingChars) {
/*
* Make a first token with the extra characters in the first
* token.
@@ -3284,13 +3425,14 @@ TclPushVarName(
memcpy(elemTokenPtr+1, varTokenPtr+2,
(n-1) * sizeof(Tcl_Token));
- } else {
+ } else {
/*
* Use the already available tokens.
*/
elemTokenPtr = &varTokenPtr[2];
elemTokenCount = n - 1;
+ }
}
}
}
@@ -3325,7 +3467,7 @@ TclPushVarName(
localIndex = -1;
}
}
- if (localIndex < 0) {
+ if (interp && localIndex < 0) {
PushLiteral(envPtr, name, nameChars);
}
@@ -3342,7 +3484,7 @@ TclPushVarName(
PushStringLiteral(envPtr, "");
}
}
- } else {
+ } else if (interp) {
/*
* The var name isn't simple: compile and push it.
*/
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 150c378..ffe39ba 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -28,6 +28,58 @@ static void CompileReturnInternal(CompileEnv *envPtr,
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;
+}
/*
*----------------------------------------------------------------------
@@ -85,14 +137,17 @@ TclCompileGlobalCmd(
*/
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- for (i=2; i<=numWords; varTokenPtr = TokenAfter(varTokenPtr),i++) {
+ for (i=1; i<numWords; varTokenPtr = TokenAfter(varTokenPtr),i++) {
localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);
if (localIndex < 0) {
return TCL_ERROR;
}
- CompileWord(envPtr, varTokenPtr, interp, 1);
+ /* 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);
}
@@ -584,6 +639,7 @@ TclCompileInfoCommandsCmd(
* 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);
@@ -810,28 +866,16 @@ TclCompileLappendCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr, *valueTokenPtr;
- int isScalar, localIndex, numWords, i, fwd, offsetFwd;
+ int isScalar, localIndex, numWords, i;
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) {
+ if (numWords < 3) {
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.
- */
+ if (numWords != 3 || envPtr->procPtr == NULL) {
goto lappendMultiple;
}
@@ -885,42 +929,28 @@ TclCompileLappendCmd(
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,
+ PushVarNameWord(interp, varTokenPtr, envPtr, 0,
&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);
-
+ TclEmitInstInt4( INST_LIST, numWords-2, envPtr);
+ if (isScalar) {
+ if (localIndex < 0) {
+ TclEmitOpcode( INST_LAPPEND_LIST_STK, envPtr);
+ } else {
+ TclEmitInstInt4(INST_LAPPEND_LIST, localIndex, envPtr);
+ }
+ } else {
+ if (localIndex < 0) {
+ TclEmitOpcode( INST_LAPPEND_LIST_ARRAY_STK, envPtr);
+ } else {
+ TclEmitInstInt4(INST_LAPPEND_LIST_ARRAY, localIndex,envPtr);
+ }
+ }
return TCL_OK;
}
@@ -1023,7 +1053,7 @@ TclCompileLassignCmd(
*/
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr);
- TclEmitInt4( -2 /* == "end" */, envPtr);
+ TclEmitInt4( INDEX_END, envPtr);
return TCL_OK;
}
@@ -1056,7 +1086,7 @@ TclCompileLindexCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *idxTokenPtr, *valTokenPtr;
- int i, numWords = parsePtr->numWords;
+ int i, idx, numWords = parsePtr->numWords;
DefineLineInformation; /* TIP #280 */
/*
@@ -1074,46 +1104,28 @@ TclCompileLindexCmd(
}
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 (GetIndexFromToken(idxTokenPtr, &idx) == TCL_OK) {
/*
- * If the conversion failed or the value was negative, we just keep on
- * going with the more complex compilation.
+ * 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.
*/
@@ -1198,20 +1210,7 @@ TclCompileListCmd(
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);
- }
+ TclEmitPush(TclAddLiteralObj(envPtr, listObj, NULL), envPtr);
return TCL_OK;
}
@@ -1259,7 +1258,7 @@ TclCompileListCmd(
if (concat && numWords == 2) {
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
- TclEmitInt4( -2, envPtr);
+ TclEmitInt4( INDEX_END, envPtr);
}
return TCL_OK;
}
@@ -1326,8 +1325,7 @@ TclCompileLrangeCmd(
{
Tcl_Token *tokenPtr, *listTokenPtr;
DefineLineInformation; /* TIP #280 */
- Tcl_Obj *tmpObj;
- int idx1, idx2, result;
+ int idx1, idx2;
if (parsePtr->numWords != 4) {
return TCL_ERROR;
@@ -1335,56 +1333,18 @@ TclCompileLrangeCmd(
listTokenPtr = TokenAfter(parsePtr->tokenPtr);
/*
- * Parse the first index. Will only compile if it is constant and not an
+ * 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).
+ * end-relative indexing) or an end-based index greater than 'end' itself.
*/
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) {
+ if (GetIndexFromToken(tokenPtr, &idx1) != 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) {
+ if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
return TCL_ERROR;
}
@@ -1403,19 +1363,16 @@ TclCompileLrangeCmd(
/*
*----------------------------------------------------------------------
*
- * TclCompileLreplaceCmd --
+ * TclCompileLinsertCmd --
*
- * 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".)
+ * How to compile the "linsert" command. We only bother with the case
+ * where the index is constant.
*
*----------------------------------------------------------------------
*/
int
-TclCompileLreplaceCmd(
+TclCompileLinsertCmd(
Tcl_Interp *interp, /* Tcl interpreter for context. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the
* command. */
@@ -1425,101 +1382,331 @@ TclCompileLreplaceCmd(
{
Tcl_Token *tokenPtr, *listTokenPtr;
DefineLineInformation; /* TIP #280 */
- Tcl_Obj *tmpObj;
- int idx1, idx2, result, guaranteedDropAll = 0;
+ int idx, i;
- if (parsePtr->numWords != 4) {
+ if (parsePtr->numWords < 3) {
return TCL_ERROR;
}
listTokenPtr = TokenAfter(parsePtr->tokenPtr);
/*
- * Parse the first index. Will only compile if it is constant and not an
+ * 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).
+ * end-relative indexing) or an end-based index greater than 'end' itself.
*/
tokenPtr = TokenAfter(listTokenPtr);
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ if (GetIndexFromToken(tokenPtr, &idx) != TCL_OK) {
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;
- }
+
+ /*
+ * 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 {
- result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx1);
- if (result == TCL_OK && idx1 > -2) {
- result = TCL_ERROR;
+ 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);
}
- TclDecrRefCount(tmpObj);
- if (result != TCL_OK) {
+
+ 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, offset2;
+
+ if (parsePtr->numWords < 4) {
return TCL_ERROR;
}
+ listTokenPtr = TokenAfter(parsePtr->tokenPtr);
/*
- * Parse the second index. Will only compile if it is constant and not an
+ * 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).
+ * end-relative indexing) or an end-based index greater than 'end' itself.
*/
- tokenPtr = TokenAfter(tokenPtr);
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ tokenPtr = TokenAfter(listTokenPtr);
+ if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
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;
- }
+
+ tokenPtr = TokenAfter(tokenPtr);
+ if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
+ return TCL_ERROR;
}
- TclDecrRefCount(tmpObj);
- if (result != TCL_OK) {
+
+ /*
+ * idx1, idx2 are now in canonical form:
+ *
+ * - integer: [0,len+1]
+ * - end index: INDEX_END
+ * - -ive offset: INDEX_END-[len-1,0]
+ * - +ive offset: INDEX_END+1
+ */
+
+ /*
+ * Compilation fails when one index is end-based but the other isn't.
+ * Fixing this will require more bytecodes, but this is a workaround for
+ * now. [Bug 47ac84309b]
+ */
+
+ if ((idx1 <= INDEX_END) != (idx2 <= INDEX_END)) {
return TCL_ERROR;
}
+ if (idx2 != INDEX_END && idx2 >= 0 && idx2 < idx1) {
+ idx2 = idx1 - 1;
+ }
+
/*
- * 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].
+ * 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 (idx2 < idx1) {
+ idx2 = idx1 - 1;
+ }
+ 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 == -2) {
- guaranteedDropAll = 1;
+ if (idx2 == INDEX_END) {
+ goto replaceAll;
}
idx1 = idx2 + 1;
- idx2 = -2;
- } else if (idx2 == -2) {
+ idx2 = INDEX_END;
+ goto replaceHead;
+ } else if (idx2 == INDEX_END) {
idx2 = idx1 - 1;
idx1 = 0;
+ goto replaceTail;
} else {
- return TCL_ERROR;
+ if (idx2 < idx1) {
+ idx2 = idx1 - 1;
+ }
+ if (idx1 > 0) {
+ tmpObj = Tcl_NewIntObj(idx1);
+ Tcl_IncrRefCount(tmpObj);
+ }
+ goto replaceRange;
}
/*
- * 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.
+ * 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.
*/
- CompileWord(envPtr, listTokenPtr, interp, 1);
- if (guaranteedDropAll) {
+ dropAll: /* This just ensures the arg is a list. */
+ 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) {
+ /*
+ * Emit bytecode to check the list length.
+ */
+
+ TclEmitOpcode( INST_DUP, envPtr);
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
- PushStringLiteral(envPtr, "");
- } else {
- TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr);
- TclEmitInt4( idx2, envPtr);
+ TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL), envPtr);
+ TclEmitOpcode( INST_GE, envPtr);
+ offset = CurrentOffset(envPtr);
+ TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr);
+
+ /*
+ * Emit an error if we've been given an empty list.
+ */
+
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_LIST_LENGTH, envPtr);
+ offset2 = CurrentOffset(envPtr);
+ TclEmitInstInt1( INST_JUMP_FALSE1, 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);
+ TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
+ envPtr->codeStart + offset2 + 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) {
+ /*
+ * Emit bytecode to check the list length.
+ */
+
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_LIST_LENGTH, envPtr);
+
+ /*
+ * Check the list length vs idx1.
+ */
+
+ TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL), envPtr);
+ TclEmitOpcode( INST_GE, envPtr);
+ offset = CurrentOffset(envPtr);
+ TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr);
+
+ /*
+ * Emit an error if we've been given an empty list.
+ */
+
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_LIST_LENGTH, envPtr);
+ offset2 = CurrentOffset(envPtr);
+ TclEmitInstInt1( INST_JUMP_FALSE1, 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);
+ TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
+ envPtr->codeStart + offset2 + 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;
}
@@ -1787,6 +1974,28 @@ TclCompileNamespaceCodeCmd(
}
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
@@ -1869,7 +2078,7 @@ TclCompileNamespaceUpvarCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
- int isScalar, localIndex, numWords, i;
+ int localIndex, numWords, i;
DefineLineInformation; /* TIP #280 */
if (envPtr->procPtr == NULL) {
@@ -1899,15 +2108,13 @@ TclCompileNamespaceUpvarCmd(
*/
localTokenPtr = tokenPtr;
- for (i=3; i<=numWords; i+=2) {
+ for (i=2; i<numWords; i+=2) {
otherTokenPtr = TokenAfter(localTokenPtr);
localTokenPtr = TokenAfter(otherTokenPtr);
- CompileWord(envPtr, otherTokenPtr, interp, 1);
- PushVarNameWord(interp, localTokenPtr, envPtr, 0,
- &localIndex, &isScalar, 1);
-
- if ((localIndex < 0) || !isScalar) {
+ CompileWord(envPtr, otherTokenPtr, interp, i);
+ localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
+ if (localIndex < 0) {
return TCL_ERROR;
}
TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr);
@@ -2093,7 +2300,7 @@ TclCompileRegexpCmd(
* converted pattern as a literal.
*/
- if (TclReToGlob(NULL, varTokenPtr[1].start, len, &ds, &exact)
+ if (TclReToGlob(NULL, varTokenPtr[1].start, len, &ds, &exact, NULL)
== TCL_OK) {
simple = 1;
PushLiteral(envPtr, Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
@@ -2185,7 +2392,7 @@ TclCompileRegsubCmd(
Tcl_Obj *patternObj = NULL, *replacementObj = NULL;
Tcl_DString pattern;
const char *bytes;
- int len, exact, result = TCL_ERROR;
+ int len, exact, quantified, result = TCL_ERROR;
if (parsePtr->numWords < 5 || parsePtr->numWords > 6) {
return TCL_ERROR;
@@ -2245,7 +2452,8 @@ TclCompileRegsubCmd(
*/
bytes = Tcl_GetStringFromObj(patternObj, &len);
- if (TclReToGlob(NULL, bytes, len, &pattern, &exact) != TCL_OK || exact) {
+ if (TclReToGlob(NULL, bytes, len, &pattern, &exact, &quantified)
+ != TCL_OK || exact || quantified) {
goto done;
}
bytes = Tcl_DStringValue(&pattern);
@@ -2363,7 +2571,7 @@ TclCompileReturnCmd(
CompileWord(envPtr, optsTokenPtr, interp, 2);
CompileWord(envPtr, msgTokenPtr, interp, 3);
- TclEmitOpcode(INST_RETURN_STK, envPtr);
+ TclEmitInvoke(envPtr, INST_RETURN_STK);
return TCL_OK;
}
@@ -2377,6 +2585,10 @@ TclCompileReturnCmd(
* 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++) {
@@ -2384,7 +2596,7 @@ TclCompileReturnCmd(
Tcl_IncrRefCount(objv[objc]);
if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) {
/*
- * Non-literal, so punt to run-time.
+ * Non-literal, so punt to run-time assembly of the dictionary.
*/
for (; objc>=0 ; objc--) {
@@ -2505,7 +2717,7 @@ TclCompileReturnCmd(
* Issue the RETURN itself.
*/
- TclEmitOpcode(INST_RETURN_STK, envPtr);
+ TclEmitInvoke(envPtr, INST_RETURN_STK);
return TCL_OK;
}
@@ -2517,6 +2729,23 @@ CompileReturnInternal(
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);
@@ -2566,18 +2795,16 @@ TclCompileUpvarCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
- int isScalar, localIndex, numWords, i;
+ int localIndex, numWords, i;
DefineLineInformation; /* TIP #280 */
- Tcl_Obj *objPtr = Tcl_NewObj();
+ Tcl_Obj *objPtr;
if (envPtr->procPtr == NULL) {
- Tcl_DecrRefCount(objPtr);
return TCL_ERROR;
}
numWords = parsePtr->numWords;
if (numWords < 3) {
- Tcl_DecrRefCount(objPtr);
return TCL_ERROR;
}
@@ -2585,6 +2812,7 @@ TclCompileUpvarCmd(
* Push the frame index if it is known at compile time
*/
+ objPtr = Tcl_NewObj();
tokenPtr = TokenAfter(parsePtr->tokenPtr);
if (TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
CallFrame *framePtr;
@@ -2603,16 +2831,17 @@ TclCompileUpvarCmd(
if (numWords%2) {
return TCL_ERROR;
}
+ /* TODO: Push the known value instead? */
CompileWord(envPtr, tokenPtr, interp, 1);
otherTokenPtr = TokenAfter(tokenPtr);
- i = 4;
+ i = 2;
} else {
if (!(numWords%2)) {
return TCL_ERROR;
}
PushStringLiteral(envPtr, "1");
otherTokenPtr = tokenPtr;
- i = 3;
+ i = 1;
}
} else {
Tcl_DecrRefCount(objPtr);
@@ -2625,14 +2854,12 @@ TclCompileUpvarCmd(
* be called at runtime.
*/
- for (; i<=numWords; i+=2, otherTokenPtr = TokenAfter(localTokenPtr)) {
+ for (; i<numWords; i+=2, otherTokenPtr = TokenAfter(localTokenPtr)) {
localTokenPtr = TokenAfter(otherTokenPtr);
- CompileWord(envPtr, otherTokenPtr, interp, 1);
- PushVarNameWord(interp, localTokenPtr, envPtr, 0,
- &localIndex, &isScalar, 1);
-
- if ((localIndex < 0) || !isScalar) {
+ CompileWord(envPtr, otherTokenPtr, interp, i);
+ localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
+ if (localIndex < 0) {
return TCL_ERROR;
}
TclEmitInstInt4( INST_UPVAR, localIndex, envPtr);
@@ -2706,6 +2933,9 @@ TclCompileVariableCmd(
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);
@@ -2779,10 +3009,12 @@ IndexTailVarIfKnown(
} else {
full = 0;
lastTokenPtr = varTokenPtr + n;
- if (!TclWordKnownAtCompileTime(lastTokenPtr, tailPtr)) {
+
+ if (lastTokenPtr->type != TCL_TOKEN_TEXT) {
Tcl_DecrRefCount(tailPtr);
return -1;
}
+ Tcl_SetStringObj(tailPtr, lastTokenPtr->start, lastTokenPtr->size);
}
tailName = TclGetStringFromObj(tailPtr, &len);
@@ -2824,6 +3056,66 @@ IndexTailVarIfKnown(
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. */
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index d1eb9db..101edbd 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,6 +28,9 @@ static void FreeJumptableInfo(ClientData clientData);
static void PrintJumptableInfo(ClientData clientData,
Tcl_Obj *appendObj, ByteCode *codePtr,
unsigned int pcOffset);
+static void DisassembleJumptableInfo(ClientData clientData,
+ Tcl_Obj *dictObj, ByteCode *codePtr,
+ unsigned int pcOffset);
static int CompileAssociativeBinaryOpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, const char *identity,
int instruction, CompileEnv *envPtr);
@@ -71,7 +75,8 @@ const AuxDataType tclJumptableInfoType = {
"JumptableInfo", /* name */
DupJumptableInfo, /* dupProc */
FreeJumptableInfo, /* freeProc */
- PrintJumptableInfo /* printProc */
+ PrintJumptableInfo, /* printProc */
+ DisassembleJumptableInfo /* disassembleProc */
};
/*
@@ -99,6 +104,61 @@ const AuxDataType tclJumptableInfoType = {
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;
+}
/*
*----------------------------------------------------------------------
@@ -213,6 +273,78 @@ TclCompileSetCmd(
*/
int
+TclCompileStringCatCmd(
+ 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. */
+{
+ int i, numWords = parsePtr->numWords, numArgs;
+ Tcl_Token *wordTokenPtr;
+ Tcl_Obj *obj, *folded;
+ DefineLineInformation; /* TIP #280 */
+
+ /* Trivial case, no arg */
+
+ if (numWords<2) {
+ PushStringLiteral(envPtr, "");
+ return TCL_OK;
+ }
+
+ /* General case: issue CONCAT1's (by chunks of 254 if needed), folding
+ contiguous constants along the way */
+
+ numArgs = 0;
+ folded = NULL;
+ wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
+ for (i = 1; i < numWords; i++) {
+ obj = Tcl_NewObj();
+ if (TclWordKnownAtCompileTime(wordTokenPtr, obj)) {
+ if (folded) {
+ Tcl_AppendObjToObj(folded, obj);
+ Tcl_DecrRefCount(obj);
+ } else {
+ folded = obj;
+ }
+ } else {
+ Tcl_DecrRefCount(obj);
+ if (folded) {
+ int len;
+ const char *bytes = Tcl_GetStringFromObj(folded, &len);
+
+ PushLiteral(envPtr, bytes, len);
+ Tcl_DecrRefCount(folded);
+ folded = NULL;
+ numArgs ++;
+ }
+ CompileWord(envPtr, wordTokenPtr, interp, i);
+ numArgs ++;
+ if (numArgs >= 254) { /* 254 to take care of the possible +1 of "folded" above */
+ TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr);
+ numArgs = 1; /* concat pushes 1 obj, the result */
+ }
+ }
+ wordTokenPtr = TokenAfter(wordTokenPtr);
+ }
+ if (folded) {
+ int len;
+ const char *bytes = Tcl_GetStringFromObj(folded, &len);
+
+ PushLiteral(envPtr, bytes, len);
+ Tcl_DecrRefCount(folded);
+ folded = NULL;
+ numArgs ++;
+ }
+ if (numArgs > 1) {
+ TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr);
+ }
+
+ return TCL_OK;
+}
+
+int
TclCompileStringCmpCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
@@ -369,6 +501,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
@@ -563,8 +973,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;
@@ -574,50 +983,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;
}
@@ -631,7 +1003,7 @@ TclCompileStringRangeCmd(
/*
* Push the operands onto the stack and then the substring operation.
- */
+ */
nonConstantIndices:
CompileWord(envPtr, stringTokenPtr, interp, 1);
@@ -640,6 +1012,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}
+};
/*
*----------------------------------------------------------------------
@@ -750,7 +1436,7 @@ TclSubstCompile(
/*
* 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.
*/
@@ -815,11 +1501,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;
}
@@ -873,7 +1559,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);
@@ -939,7 +1625,7 @@ TclSubstCompile(
(int) (CurrentOffset(envPtr) - okFixup.codeOffset));
}
if (count > 1) {
- OP1(CONCAT1, count);
+ OP1(STR_CONCAT1, count);
count = 1;
}
@@ -952,11 +1638,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);
@@ -1342,7 +2028,7 @@ IssueSwitchChainedTests(
int foundDefault; /* Flag to indicate whether a "default" clause
* is present. */
JumpFixup *fixupArray; /* Array of forward-jump fixup records. */
- int *fixupTargetArray; /* Array of places for fixups to point at. */
+ unsigned int *fixupTargetArray; /* Array of places for fixups to point at. */
int fixupCount; /* Number of places to fix up. */
int contFixIndex; /* Where the first of the jumps due to a group
* of continuation bodies starts, or -1 if
@@ -1409,7 +2095,7 @@ IssueSwitchChainedTests(
*/
if (TclReToGlob(NULL, bodyToken[i]->start,
- bodyToken[i]->size, &ds, &exact) == TCL_OK) {
+ bodyToken[i]->size, &ds, &exact, NULL) == TCL_OK){
simple = 1;
PushLiteral(envPtr, Tcl_DStringValue(&ds),
Tcl_DStringLength(&ds));
@@ -1496,7 +2182,7 @@ IssueSwitchChainedTests(
}
/*
- * Now do the actual compilation. Note that we do not use BODY()
+ * Now do the actual compilation. Note that we do not use BODY()
* because we may have synthesized the tokens in a non-standard
* pattern.
*/
@@ -1759,11 +2445,13 @@ IssueSwitchJumpTable(
* DupJumptableInfo: a copy of the jump-table
* FreeJumptableInfo: none
* PrintJumptableInfo: none
+ * DisassembleJumptableInfo: none
*
* Side effects:
* DupJumptableInfo: allocates memory
* FreeJumptableInfo: releases memory
* PrintJumptableInfo: none
+ * DisassembleJumptableInfo: none
*
*----------------------------------------------------------------------
*/
@@ -1826,6 +2514,30 @@ PrintJumptableInfo(
keyPtr, pcOffset + offset);
}
}
+
+static void
+DisassembleJumptableInfo(
+ ClientData clientData,
+ Tcl_Obj *dictObj,
+ ByteCode *codePtr,
+ unsigned int pcOffset)
+{
+ register JumptableInfo *jtPtr = clientData;
+ Tcl_Obj *mapping = Tcl_NewObj();
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ const char *keyPtr;
+ int offset;
+
+ hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
+ for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) {
+ keyPtr = Tcl_GetHashKey(&jtPtr->hashTable, hPtr);
+ offset = PTR2INT(Tcl_GetHashValue(hPtr));
+ Tcl_DictObjPut(NULL, mapping, Tcl_NewStringObj(keyPtr, -1),
+ Tcl_NewIntObj(offset));
+ }
+ Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("mapping", -1), mapping);
+}
/*
*----------------------------------------------------------------------
@@ -1864,6 +2576,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);
@@ -1927,7 +2640,7 @@ TclCompileThrowCmd(
}
CompileWord(envPtr, msgToken, interp, 2);
- codeIsList = codeKnown && (TCL_OK ==
+ codeIsList = codeKnown && (TCL_OK ==
Tcl_ListObjLength(interp, objPtr, &len));
codeIsValid = codeIsList && (len != 0);
@@ -1964,7 +2677,7 @@ TclCompileThrowCmd(
OP( LIST_LENGTH);
OP1( JUMP_FALSE1, 16);
OP4( LIST, 2);
- OP44( RETURN_IMM, 1, 0);
+ OP44( RETURN_IMM, TCL_ERROR, 0);
TclAdjustStackDepth(2, envPtr);
OP( POP);
OP( POP);
@@ -1973,7 +2686,7 @@ TclCompileThrowCmd(
PUSH( "type must be non-empty list");
PUSH( "-errorcode {TCL OPERATION THROW BADEXCEPTION}");
}
- OP44( RETURN_IMM, 1, 0);
+ OP44( RETURN_IMM, TCL_ERROR, 0);
return TCL_OK;
}
@@ -2355,6 +3068,7 @@ IssueTryClausesInstructions(
if (!handlerTokens[i]) {
forwardsNeedFixing = 1;
JUMP4( JUMP, forwardsToFix[i]);
+ TclAdjustStackDepth(1, envPtr);
} else {
int dontChangeOptions;
@@ -2395,7 +3109,7 @@ IssueTryClausesInstructions(
TclAdjustStackDepth(-1, envPtr);
FIXJUMP1( dontChangeOptions);
OP4( REVERSE, 2);
- OP( RETURN_STK);
+ INVOKE( RETURN_STK);
}
JUMP4( JUMP, addrsToFix[i]);
@@ -2414,7 +3128,7 @@ IssueTryClausesInstructions(
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
@@ -2723,7 +3437,7 @@ IssueTryClausesFinallyInstructions(
FIXJUMP1( finalOK);
LOAD( optionsVar);
LOAD( resultVar);
- OP( RETURN_STK);
+ INVOKE( RETURN_STK);
return TCL_OK;
}
@@ -2782,7 +3496,7 @@ IssueTryFinallyInstructions(
OP1( JUMP1, 7);
FIXJUMP1( jumpOK);
OP4( REVERSE, 2);
- OP( RETURN_STK);
+ INVOKE( RETURN_STK);
return TCL_OK;
}
@@ -2814,39 +3528,81 @@ TclCompileUnsetCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr;
- int isScalar, localIndex, numWords, flags, i;
- Tcl_Obj *leadingWord;
+ int isScalar, localIndex, flags = 1, i, varCount = 0, haveFlags = 0;
DefineLineInformation; /* TIP #280 */
/* TODO: Consider support for compiling expanded args. */
- 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.
- */
+ /*
+ * 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 (varCount == 0) {
+ const char *bytes;
+ int len;
+
+ bytes = Tcl_GetStringFromObj(leadingWord, &len);
+ if (i == 1 && len == 11 && !strncmp("-nocomplain", bytes, 11)) {
+ flags = 0;
+ haveFlags++;
+ } else if (i == (2 - flags) && len == 2 && !strncmp("--", bytes, 2)) {
+ haveFlags++;
+ } 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);
+ for (i=0; i<haveFlags;i++) {
+ 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
@@ -2856,7 +3612,7 @@ TclCompileUnsetCmd(
*/
PushVarNameWord(interp, varTokenPtr, envPtr, 0,
- &localIndex, &isScalar, 1);
+ &localIndex, &isScalar, i);
/*
* Emit instructions to unset the variable.
@@ -3106,6 +3862,51 @@ TclCompileYieldCmd(
/*
*----------------------------------------------------------------------
*
+ * TclCompileYieldToCmd --
+ *
+ * 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 "yieldto" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileYieldToCmd(
+ 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);
+ int i;
+
+ if (parsePtr->numWords < 2) {
+ return TCL_ERROR;
+ }
+
+ OP( NS_CURRENT);
+ for (i = 1 ; i < parsePtr->numWords ; i++) {
+ CompileWord(envPtr, tokenPtr, interp, i);
+ tokenPtr = TokenAfter(tokenPtr);
+ }
+ OP4( LIST, i);
+ OP( YIELD_TO_INVOKE);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* CompileUnaryOpCmd --
*
* Utility routine to compile the unary operator commands.
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 2a48117..4390282 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -365,7 +365,7 @@ static const unsigned char prec[] = {
0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0,
+ 0,
/* Unary operator lexemes */
PREC_UNARY, /* UNARY_PLUS */
PREC_UNARY, /* UNARY_MINUS */
@@ -420,7 +420,7 @@ static const unsigned char instruction[] = {
0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0,
+ 0,
/* Unary operator lexemes */
INST_UPLUS, /* UNARY_PLUS */
INST_UMINUS, /* UNARY_MINUS */
@@ -488,15 +488,8 @@ static const unsigned char Lexeme[] = {
typedef struct JumpList {
JumpFixup jump; /* Pass this argument to matching calls of
- * TclEmitForwardJump() and
+ * 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;
@@ -571,13 +564,13 @@ ParseExpr(
{
OpNode *nodes = NULL; /* Pointer to the OpNode storage array where
* we build the parse tree. */
- int nodesAvailable = 64; /* Initial size of the storage array. This
+ unsigned int nodesAvailable = 64; /* Initial size of the storage array. This
* value establishes a minimum tree memory
* cost of only about 1 kibyte, and is large
* enough for most expressions to parse with
* no need for array growth and
* reallocation. */
- int nodesUsed = 0; /* Number of OpNodes filled. */
+ unsigned int nodesUsed = 0; /* Number of OpNodes filled. */
int scanned = 0; /* Capture number of byte scanned by parsing
* routines. */
int lastParsed; /* Stores info about what the lexeme parsed
@@ -669,11 +662,13 @@ ParseExpr(
*/
if (nodesUsed >= nodesAvailable) {
- int size = nodesUsed * 2;
- OpNode *newPtr;
+ unsigned int size = nodesUsed * 2;
+ OpNode *newPtr = NULL;
do {
+ if (size <= UINT_MAX/sizeof(OpNode)) {
newPtr = attemptckrealloc(nodes, size * sizeof(OpNode));
+ }
} while ((newPtr == NULL)
&& ((size -= (size - nodesUsed) / 2) > nodesUsed));
if (newPtr == NULL) {
@@ -845,7 +840,7 @@ ParseExpr(
switch (lexeme) {
case NUMBER:
- case BOOLEAN:
+ case BOOLEAN:
/*
* TODO: Consider using a dict or hash to collapse all
* duplicate literals into a single representative value.
@@ -868,7 +863,7 @@ ParseExpr(
start += scanned;
numBytes -= scanned;
continue;
-
+
default:
break;
}
@@ -1331,7 +1326,7 @@ ParseExpr(
nodePtr->mark = MARK_LEFT;
nodePtr->left = complete;
- /*
+ /*
* The COMMA operator cannot be optimized, since the function
* needs all of its arguments, and optimization would reduce the
* number. Other binary operators root constant expressions when
@@ -1553,7 +1548,7 @@ ConvertTreeToTokens(
* Tcl_ParseExpr() we do not change them now. Internally, we can
* do better.
*/
-
+
int toCopy = tokenPtr->numComponents + 1;
if (tokenPtr->numComponents == tokenPtr[1].numComponents + 1) {
@@ -1569,7 +1564,7 @@ ConvertTreeToTokens(
subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
parsePtr->numTokens += toCopy;
} else {
- /*
+ /*
* Multiple element word. Create a TCL_TOKEN_SUB_EXPR token to
* lead, with fields initialized from the leading token, then
* copy entire set of word tokens.
@@ -1618,7 +1613,7 @@ ConvertTreeToTokens(
case COMMA:
case COLON:
- /*
+ /*
* Historical practice has been to have no Tcl_Tokens for
* these operators.
*/
@@ -1754,7 +1749,7 @@ ConvertTreeToTokens(
/*
* Before we leave this node/operator/subexpression for the
* last time, finish up its tokens....
- *
+ *
* Our current position scanning the string is where the
* substring for the subexpression ends.
*/
@@ -1974,7 +1969,7 @@ ParseLexeme(
case 'i':
if ((numBytes > 1) && (start[1] == 'n')
- && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
+ && ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
/*
* Must make this check so we can tell the difference between the
* "in" operator and the "int" function name and the "infinity"
@@ -1988,14 +1983,15 @@ ParseLexeme(
case 'e':
if ((numBytes > 1) && (start[1] == 'q')
- && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
+ && ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
*lexemePtr = STREQ;
return 2;
}
break;
case 'n':
- if ((numBytes > 1) && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
+ if ((numBytes > 1)
+ && ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
switch (start[1]) {
case 'e':
*lexemePtr = STRNEQ;
@@ -2010,9 +2006,8 @@ ParseLexeme(
literal = Tcl_NewObj();
if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end,
TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
- if (end < start + numBytes && !isalnum(UCHAR(*end))
- && UCHAR(*end) != '_') {
-
+ if (end < start + numBytes && !TclIsBareword(*end)) {
+
number:
TclInitStringRep(literal, start, end-start);
*lexemePtr = NUMBER;
@@ -2036,9 +2031,9 @@ ParseLexeme(
const char *p = start;
while (p < end) {
- if (!isalnum(UCHAR(*p++))) {
+ if (!TclIsBareword(*p++)) {
/*
- * The number has non-bareword characters, so we
+ * The number has non-bareword characters, so we
* must treat it as a number.
*/
goto number;
@@ -2061,33 +2056,30 @@ ParseLexeme(
}
}
- if (Tcl_UtfCharComplete(start, numBytes)) {
- scanned = Tcl_UtfToUniChar(start, &ch);
- } else {
- char utfBytes[TCL_UTF_MAX];
+ /*
+ * We reject leading underscores in bareword. No sensible reason why.
+ * Might be inspired by reserved identifier rules in C, which of course
+ * have no direct relevance here.
+ */
- memcpy(utfBytes, start, (size_t) numBytes);
- utfBytes[numBytes] = '\0';
- scanned = Tcl_UtfToUniChar(utfBytes, &ch);
- }
- if (!isalnum(UCHAR(ch))) {
- *lexemePtr = INVALID;
- Tcl_DecrRefCount(literal);
- return scanned;
- }
- end = start;
- while (isalnum(UCHAR(ch)) || (UCHAR(ch) == '_')) {
- end += scanned;
- numBytes -= scanned;
- if (Tcl_UtfCharComplete(end, numBytes)) {
- scanned = Tcl_UtfToUniChar(end, &ch);
+ if (!TclIsBareword(*start) || *start == '_') {
+ if (Tcl_UtfCharComplete(start, numBytes)) {
+ scanned = Tcl_UtfToUniChar(start, &ch);
} else {
char utfBytes[TCL_UTF_MAX];
- memcpy(utfBytes, end, (size_t) numBytes);
+ memcpy(utfBytes, start, (size_t) numBytes);
utfBytes[numBytes] = '\0';
scanned = Tcl_UtfToUniChar(utfBytes, &ch);
}
+ *lexemePtr = INVALID;
+ Tcl_DecrRefCount(literal);
+ return scanned;
+ }
+ end = start;
+ while (numBytes && TclIsBareword(*end)) {
+ end += 1;
+ numBytes -= 1;
}
*lexemePtr = BAREWORD;
if (literalPtr) {
@@ -2105,7 +2097,7 @@ ParseLexeme(
* TclCompileExpr --
*
* This procedure compiles a string containing a Tcl expression into Tcl
- * bytecodes.
+ * bytecodes.
*
* Results:
* None.
@@ -2261,30 +2253,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 +2287,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:
@@ -2352,11 +2332,11 @@ CompileExprTree(
* Use the numWords count we've kept to invoke the function
* command with the correct number of arguments.
*/
-
+
if (numWords < 255) {
- TclEmitInstInt1(INST_INVOKE_STK1, numWords, envPtr);
+ TclEmitInvoke(envPtr, INST_INVOKE_STK1, numWords);
} else {
- TclEmitInstInt4(INST_INVOKE_STK4, numWords, envPtr);
+ TclEmitInvoke(envPtr, INST_INVOKE_STK4, numWords);
}
/*
@@ -2375,18 +2355,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,30 +2376,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);
+ pc2 = CurrentOffset(envPtr);
+ TclEmitInstInt1(INST_JUMP1, 0, envPtr);
TclAdjustStackDepth(-1, envPtr);
- TclFixupForwardJumpToHere(envPtr, &jumpPtr->next->jump, 127);
+ 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);
@@ -2450,7 +2426,7 @@ CompileExprTree(
const char *bytes = TclGetStringFromObj(literal, &length);
int index = TclRegisterNewLiteral(envPtr, bytes, length);
Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index);
-
+
if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
/*
* Would like to do this:
@@ -2593,7 +2569,7 @@ TclSingleOpCmd(
*
* TclSortingOpCmd --
* Implements the commands:
- * <, <=, >, >=, ==, eq
+ * <, <=, >, >=, ==, eq
* in the ::tcl::mathop namespace. These commands are defined for
* arbitrary number of arguments by computing the AND of the base
* operator applied to all neighbor argument pairs.
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index f5c8d41..c0b5dcc 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -17,15 +17,6 @@
#include <assert.h>
/*
- * Table of all AuxData types.
- */
-
-static Tcl_HashTable auxDataTypeTable;
-static int auxDataTypeTableInitialized; /* 0 means not yet initialized. */
-
-TCL_DECLARE_MUTEX(tableMutex)
-
-/*
* Variable that controls whether compilation tracing is enabled and, if so,
* what level of tracing is desired:
* 0: no compilation tracing
@@ -55,15 +46,15 @@ InstructionDesc const tclInstructionTable[] = {
/* Name Bytes stackEffect #Opnds Operand types */
{"done", 1, -1, 0, {OPERAND_NONE}},
/* Finish ByteCode execution and return stktop (top stack item) */
- {"push1", 2, +1, 1, {OPERAND_UINT1}},
+ {"push1", 2, +1, 1, {OPERAND_LIT1}},
/* Push object at ByteCode objArray[op1] */
- {"push4", 5, +1, 1, {OPERAND_UINT4}},
+ {"push4", 5, +1, 1, {OPERAND_LIT4}},
/* Push object at ByteCode objArray[op4] */
{"pop", 1, -1, 0, {OPERAND_NONE}},
/* 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> */
@@ -125,17 +116,17 @@ InstructionDesc const tclInstructionTable[] = {
{"incrStkImm", 2, 0, 1, {OPERAND_INT1}},
/* Incr general variable; unparsed name is top, amount is op1 */
- {"jump1", 2, 0, 1, {OPERAND_INT1}},
+ {"jump1", 2, 0, 1, {OPERAND_OFFSET1}},
/* Jump relative to (pc + op1) */
- {"jump4", 5, 0, 1, {OPERAND_INT4}},
+ {"jump4", 5, 0, 1, {OPERAND_OFFSET4}},
/* Jump relative to (pc + op4) */
- {"jumpTrue1", 2, -1, 1, {OPERAND_INT1}},
+ {"jumpTrue1", 2, -1, 1, {OPERAND_OFFSET1}},
/* Jump relative to (pc + op1) if stktop expr object is true */
- {"jumpTrue4", 5, -1, 1, {OPERAND_INT4}},
+ {"jumpTrue4", 5, -1, 1, {OPERAND_OFFSET4}},
/* Jump relative to (pc + op4) if stktop expr object is true */
- {"jumpFalse1", 2, -1, 1, {OPERAND_INT1}},
+ {"jumpFalse1", 2, -1, 1, {OPERAND_OFFSET1}},
/* Jump relative to (pc + op1) if stktop expr object is false */
- {"jumpFalse4", 5, -1, 1, {OPERAND_INT4}},
+ {"jumpFalse4", 5, -1, 1, {OPERAND_OFFSET4}},
/* Jump relative to (pc + op4) if stktop expr object is false */
{"lor", 1, -1, 0, {OPERAND_NONE}},
@@ -298,7 +289,7 @@ InstructionDesc const tclInstructionTable[] = {
/* List Index: push (lindex stktop op4) */
{"listRangeImm", 9, 0, 2, {OPERAND_IDX4, OPERAND_IDX4}},
/* List Range: push (lrange stktop op4 op4) */
- {"startCommand", 9, 0, 2, {OPERAND_INT4,OPERAND_UINT4}},
+ {"startCommand", 9, 0, 2, {OPERAND_OFFSET4, OPERAND_UINT4}},
/* Start of bytecoded command: op is the length of the cmd's code, op2
* is number of commands here */
@@ -356,7 +347,7 @@ InstructionDesc const tclInstructionTable[] = {
/* Create the variables (described in the aux data referred to by the
* second immediate argument) to mirror the state of the dictionary in
* the variable referred to by the first immediate argument. The list
- * of keys (top of the stack, not poppsed) must be the same length as
+ * of keys (top of the stack, not popped) must be the same length as
* the list of variables.
* Stack: ... keyList => ... keyList */
{"dictUpdateEnd", 9, -1, 2, {OPERAND_LVT4, OPERAND_AUX4}},
@@ -493,6 +484,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. */
@@ -517,7 +509,7 @@ InstructionDesc const tclInstructionTable[] = {
* case. Also runs the whole-array trace on the named variable, so can
* throw anything.
* Stack: ... varName => ... boolean */
- {"arrayExistsImm", 5, +1, 1, {OPERAND_UINT4}},
+ {"arrayExistsImm", 5, +1, 1, {OPERAND_LVT4}},
/* Looks up the variable indexed by opnd and tests whether it is an
* array. Pushes a boolean describing whether this is the case. Also
* runs the whole-array trace on the named variable, so can throw
@@ -527,7 +519,7 @@ InstructionDesc const tclInstructionTable[] = {
/* Forces the element on the top of the stack to be the name of an
* array.
* Stack: ... varName => ... */
- {"arrayMakeImm", 5, 0, 1, {OPERAND_UINT4}},
+ {"arrayMakeImm", 5, 0, 1, {OPERAND_LVT4}},
/* Forces the variable indexed by opnd to be an array. Does not touch
* the stack. */
@@ -545,6 +537,123 @@ InstructionDesc const tclInstructionTable[] = {
/* 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 */
+
+ {"lappendList", 5, 0, 1, {OPERAND_LVT4}},
+ /* Lappend list to scalar variable at op4 in frame.
+ * Stack: ... list => ... listVarContents */
+ {"lappendListArray", 5, -1, 1, {OPERAND_LVT4}},
+ /* Lappend list to array element; array at op4.
+ * Stack: ... elem list => ... listVarContents */
+ {"lappendListArrayStk", 1, -2, 0, {OPERAND_NONE}},
+ /* Lappend list to array element.
+ * Stack: ... arrayName elem list => ... listVarContents */
+ {"lappendListStk", 1, -1, 0, {OPERAND_NONE}},
+ /* Lappend list to general variable.
+ * Stack: ... varName list => ... listVarContents */
+
{NULL, 0, 0, 0, {OPERAND_NONE}}
};
@@ -570,15 +679,9 @@ static int IsCompactibleCompileEnv(Tcl_Interp *interp,
#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,
- const char *stringPtr, int maxChars);
-static void UpdateStringOfInstName(Tcl_Obj *objPtr);
/*
* TIP #280: Helper for building the per-word line information of all compiled
@@ -617,19 +720,6 @@ static const Tcl_ObjType substCodeType = {
};
/*
- * The structure below defines an instruction name Tcl object to allow
- * reporting of inner contexts in errorstack without string allocation.
- */
-
-static const Tcl_ObjType tclInstNameType = {
- "instname", /* name */
- NULL, /* freeIntRepProc */
- NULL, /* dupIntRepProc */
- UpdateStringOfInstName, /* updateStringProc */
- NULL, /* setFromAnyProc */
-};
-
-/*
* Helper macros.
*/
@@ -754,7 +844,9 @@ TclSetByteCodeFromAny(
* instruction generator boundaries.
*/
- TclOptimizeBytecode(&compEnv);
+ if (iPtr->extra.optimizer) {
+ (iPtr->extra.optimizer)(&compEnv);
+ }
/*
* Invoke the compilation hook procedure if one exists.
@@ -876,8 +968,7 @@ FreeByteCodeInternalRep(
register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
objPtr->typePtr = NULL;
- codePtr->refCount--;
- if (codePtr->refCount <= 0) {
+ if (codePtr->refCount-- <= 1) {
TclCleanupByteCode(codePtr);
}
}
@@ -1193,8 +1284,8 @@ CompileSubstObj(
if (objPtr->typePtr == &substCodeType) {
Namespace *nsPtr = iPtr->varFramePtr->nsPtr;
- codePtr = objPtr->internalRep.ptrAndLongRep.ptr;
- if ((unsigned long)flags != objPtr->internalRep.ptrAndLongRep.value
+ codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ if (flags != PTR2INT(objPtr->internalRep.twoPtrValue.ptr2)
|| ((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != nsPtr)
@@ -1220,8 +1311,8 @@ CompileSubstObj(
TclFreeCompileEnv(&compEnv);
codePtr = objPtr->internalRep.twoPtrValue.ptr1;
- objPtr->internalRep.ptrAndLongRep.ptr = codePtr;
- objPtr->internalRep.ptrAndLongRep.value = flags;
+ objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(flags);
if (iPtr->varFramePtr->localCachePtr) {
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
@@ -1260,11 +1351,10 @@ static void
FreeSubstCodeInternalRep(
register Tcl_Obj *objPtr) /* Object whose internal rep to free. */
{
- register ByteCode *codePtr = objPtr->internalRep.ptrAndLongRep.ptr;
+ register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
objPtr->typePtr = NULL;
- codePtr->refCount--;
- if (codePtr->refCount <= 0) {
+ if (codePtr->refCount-- <= 1) {
TclCleanupByteCode(codePtr);
}
}
@@ -1524,7 +1614,7 @@ TclFreeCompileEnv(
envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets;
}
if (envPtr->iPtr) {
- /*
+ /*
* We never converted to Bytecode, so free the things we would
* have transferred to it.
*/
@@ -1709,7 +1799,7 @@ TclCompileInvocation(
int numWords,
CompileEnv *envPtr)
{
- int wordIdx = 0;
+ int wordIdx = 0, depth = TclGetStackDepth(envPtr);
DefineLineInformation;
if (cmdObj) {
@@ -1738,10 +1828,11 @@ TclCompileInvocation(
}
if (wordIdx <= 255) {
- TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
+ TclEmitInvoke(envPtr, INST_INVOKE_STK1, wordIdx);
} else {
- TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr);
+ TclEmitInvoke(envPtr, INST_INVOKE_STK4, wordIdx);
}
+ TclCheckStackDepth(depth+1, envPtr);
}
static void
@@ -1754,7 +1845,7 @@ CompileExpanded(
{
int wordIdx = 0;
DefineLineInformation;
-
+ int depth = TclGetStackDepth(envPtr);
StartExpanding(envPtr);
if (cmdObj) {
@@ -1787,27 +1878,24 @@ CompileExpanded(
}
/*
- * 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 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).
+ * 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.
+ * Note that the estimates are not correct while the command is being
+ * prepared and run, INST_EXPAND_STKTOP is not stack-neutral in general.
*/
- TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
- envPtr->expandCount--;
- TclAdjustStackDepth(1 - wordIdx, envPtr);
+ TclEmitInvoke(envPtr, INST_INVOKE_EXPANDED, wordIdx);
+ TclCheckStackDepth(depth+1, envPtr);
}
-static int
+static int
CompileCmdCompileProc(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
@@ -1816,10 +1904,11 @@ CompileCmdCompileProc(
{
int unwind = 0, incrOffset = -1;
DefineLineInformation;
+ int depth = TclGetStackDepth(envPtr);
/*
- * Emit of the INST_START_CMD instruction is controlled by
- * the value of envPtr->atCmdStart:
+ * 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.
@@ -1850,9 +1939,10 @@ CompileCmdCompileProc(
if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, 1, cmdPtr, envPtr)) {
if (incrOffset >= 0) {
/*
- * We successfully compiled a command. Increment the number
- * of commands that start at the currently active INST_START_CMD.
+ * We successfully compiled a command. Increment the number of
+ * commands that start at the currently active INST_START_CMD.
*/
+
unsigned char *incrPtr = envPtr->codeStart + incrOffset;
unsigned char *startPtr = incrPtr - 5;
@@ -1862,15 +1952,16 @@ CompileCmdCompileProc(
TclStoreInt4AtPtr(envPtr->codeNext - startPtr, startPtr + 1);
}
}
+ TclCheckStackDepth(depth+1, envPtr);
return TCL_OK;
}
envPtr->codeNext -= unwind; /* Unwind INST_START_CMD */
/*
- * Throw out any line information generated by the failed
- * compile attempt.
+ * Throw out any line information generated by the failed compile attempt.
*/
+
while (mapPtr->nuloc - 1 > eclIndex) {
mapPtr->nuloc--;
ckfree(mapPtr->loc[mapPtr->nuloc].line);
@@ -1878,11 +1969,11 @@ CompileCmdCompileProc(
}
/*
- * Reset the index of next command.
- * Toss out any from failed nested partial compiles.
+ * Reset the index of next command. Toss out any from failed nested
+ * partial compiles.
*/
- envPtr->numCommands = mapPtr->nuloc;
+ envPtr->numCommands = mapPtr->nuloc;
return TCL_ERROR;
}
@@ -1904,6 +1995,7 @@ CompileCommandTokens(
int *clNext = envPtr->clNext;
int cmdIdx = envPtr->numCommands;
int startCodeOffset = envPtr->codeNext - envPtr->codeStart;
+ int depth = TclGetStackDepth(envPtr);
assert (parsePtr->numWords > 0);
@@ -1914,11 +2006,10 @@ CompileCommandTokens(
parsePtr->commandStart - envPtr->source, startCodeOffset);
/*
- * 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,
@@ -1940,8 +2031,8 @@ CompileCommandTokens(
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
if (cmdPtr) {
/*
- * Found a command. Test the ways we can be told
- * not to attempt to compile it.
+ * 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)
@@ -1985,8 +2076,8 @@ CompileCommandTokens(
(envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
/*
- * TIP #280: Free full form of per-word line data and insert the
- * reduced form now
+ * TIP #280: Free full form of per-word line data and insert the reduced
+ * form now
*/
envPtr->line = cmdLine;
@@ -1996,6 +2087,7 @@ CompileCommandTokens(
eclPtr->loc[wlineat].line = wlines;
eclPtr->loc[wlineat].next = NULL;
+ TclCheckStackDepth(depth, envPtr);
return cmdIdx;
}
@@ -2015,6 +2107,7 @@ TclCompileScript(
* 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");
@@ -2071,20 +2164,20 @@ TclCompileScript(
if (parse.numWords == 0) {
/*
- * 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 "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.
+ * can be written with an assumption that parse.numWords > 0, with
+ * the implication the CCT() always generates bytecode.
*/
continue;
}
@@ -2103,27 +2196,30 @@ TclCompileScript(
if (lastCmdIdx == -1) {
/*
- * 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.
+ * 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.
*/
+
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.
+ * 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.
*/
+
envPtr->cmdMapPtr[lastCmdIdx].numCodeBytes--;
envPtr->codeNext--;
envPtr->currStackDepth++;
}
+ TclCheckStackDepth(depth+1, envPtr);
}
/*
@@ -2229,11 +2325,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
@@ -2266,6 +2363,7 @@ TclCompileTokens(
clPosition = ckalloc(maxNumCL * sizeof(int));
}
+ adjust = 0;
Tcl_DStringInit(&textBuffer);
numObjsToConcat = 0;
for ( ; count > 0; count--, tokenPtr++) {
@@ -2309,6 +2407,7 @@ TclCompileTokens(
clPosition[numCL] = clPos;
numCL ++;
}
+ adjust++;
}
break;
@@ -2331,8 +2430,10 @@ TclCompileTokens(
numCL = 0;
}
+ envPtr->line += adjust;
TclCompileScript(interp, tokenPtr->start+1,
tokenPtr->size-2, envPtr);
+ envPtr->line -= adjust;
numObjsToConcat++;
break;
@@ -2383,11 +2484,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);
}
/*
@@ -2407,6 +2508,7 @@ TclCompileTokens(
if (maxNumCL) {
ckfree(clPosition);
}
+ TclCheckStackDepth(depth+1, envPtr);
}
/*
@@ -2454,7 +2556,7 @@ TclCompileCmdWord(
*/
TclCompileTokens(interp, tokenPtr, count, envPtr);
- TclEmitOpcode(INST_EVAL_STK, envPtr);
+ TclEmitInvoke(envPtr, INST_EVAL_STK);
}
}
@@ -2518,11 +2620,11 @@ TclCompileExprWords(
}
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);
}
@@ -3258,26 +3360,25 @@ TclGetInnermostExceptionRange(
int returnCode,
ExceptionAux **auxPtrPtr)
{
- int exnIdx = -1, i;
+ int i = envPtr->exceptArrayNext;
+ ExceptionRange *rangePtr = envPtr->exceptArrayPtr + i;
- for (i=0 ; i<envPtr->exceptArrayNext ; i++) {
- ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[i];
+ while (i > 0) {
+ rangePtr--; 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 (auxPtrPtr) {
+ *auxPtrPtr = envPtr->exceptAuxArrayPtr + i;
+ }
+ return rangePtr;
}
}
- if (exnIdx == -1) {
- return NULL;
- }
- if (auxPtrPtr) {
- *auxPtrPtr = &envPtr->exceptAuxArrayPtr[exnIdx];
- }
- return &envPtr->exceptArrayPtr[exnIdx];
+ return NULL;
}
/*
@@ -3351,9 +3452,9 @@ TclAddLoopContinueFixup(
*
* 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.
+ * 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.
*
* ---------------------------------------------------------------------
*/
@@ -3367,23 +3468,16 @@ TclCleanupStackForBreakContinue(
int toPop = envPtr->expandCount - auxPtr->expandTarget;
if (toPop > 0) {
- while (toPop > 0) {
+ while (toPop --> 0) {
TclEmitOpcode(INST_EXPAND_DROP, envPtr);
- toPop--;
}
TclAdjustStackDepth(auxPtr->expandTargetDepth - envPtr->currStackDepth,
envPtr);
- toPop = auxPtr->expandTargetDepth - auxPtr->stackDepth;
- while (toPop > 0) {
- TclEmitOpcode(INST_POP, envPtr);
- toPop--;
- }
- } else {
- toPop = envPtr->currStackDepth - auxPtr->stackDepth;
- while (toPop > 0) {
- TclEmitOpcode(INST_POP, envPtr);
- toPop--;
- }
+ envPtr->currStackDepth = auxPtr->expandTargetDepth;
+ }
+ toPop = envPtr->currStackDepth - auxPtr->stackDepth;
+ while (toPop --> 0) {
+ TclEmitOpcode(INST_POP, envPtr);
}
envPtr->currStackDepth = savedStackDepth;
}
@@ -3900,185 +3994,219 @@ TclFixupForwardJump(
/*
*----------------------------------------------------------------------
*
- * TclGetInstructionTable --
+ * TclEmitInvoke --
*
- * Returns a pointer to the table describing Tcl bytecode instructions.
- * This procedure is defined so that clients can access the pointer from
- * outside the TCL DLLs.
+ * 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:
- * Returns a pointer to the global instruction table, same as the
- * expression (&tclInstructionTable[0]).
+ * None
*
* Side effects:
- * None.
+ * 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.
*
*----------------------------------------------------------------------
*/
-const void * /* == InstructionDesc* == */
-TclGetInstructionTable(void)
-{
- return &tclInstructionTable[0];
-}
-
-/*
- *--------------------------------------------------------------
- *
- * RegisterAuxDataType --
- *
- * This procedure is called to register a new AuxData type in the table
- * of all AuxData types supported by Tcl.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The type is registered in the AuxData type table. If there was already
- * a type with the same name as in typePtr, it is replaced with the new
- * type.
- *
- *--------------------------------------------------------------
- */
-
-static void
-RegisterAuxDataType(
- const AuxDataType *typePtr) /* Information about object type; storage must
- * be statically allocated (must live forever;
- * will not be deallocated). */
+void
+TclEmitInvoke(
+ CompileEnv *envPtr,
+ int opcode,
+ ...)
{
- register Tcl_HashEntry *hPtr;
- int isNew;
-
- Tcl_MutexLock(&tableMutex);
- if (!auxDataTypeTableInitialized) {
- TclInitAuxDataTypeTable();
- }
+ 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);
/*
- * If there's already a type with the given name, remove it.
+ * Parse the arguments.
*/
- hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typePtr->name);
- if (hPtr != NULL) {
- Tcl_DeleteHashEntry(hPtr);
+ 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);
/*
- * Now insert the new object type.
+ * Determine if we need to handle break and continue exceptions with a
+ * special handling exception range (so that we can correctly unwind the
+ * stack).
+ *
+ * These must be done separately; they can be different (especially for
+ * calls from inside a [for] increment clause).
*/
- hPtr = Tcl_CreateHashEntry(&auxDataTypeTable, typePtr->name, &isNew);
- if (isNew) {
- Tcl_SetHashValue(hPtr, typePtr);
+ 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 = auxContinuePtr - envPtr->exceptAuxArrayPtr;
}
- Tcl_MutexUnlock(&tableMutex);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetAuxDataType --
- *
- * This procedure looks up an Auxdata type by name.
- *
- * Results:
- * If an AuxData type with name matching "typeName" is found, a pointer
- * to its AuxDataType structure is returned; otherwise, NULL is returned.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-const AuxDataType *
-TclGetAuxDataType(
- const char *typeName) /* Name of AuxData type to look up. */
-{
- register Tcl_HashEntry *hPtr;
- const AuxDataType *typePtr = NULL;
- Tcl_MutexLock(&tableMutex);
- if (!auxDataTypeTableInitialized) {
- TclInitAuxDataTypeTable();
+ rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxBreakPtr);
+ if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) {
+ auxBreakPtr = NULL;
+ } else if (auxContinuePtr == NULL
+ && auxBreakPtr->stackDepth == envPtr->currStackDepth-wordCount
+ && auxBreakPtr->expandTarget == envPtr->expandCount-expandCount) {
+ auxBreakPtr = NULL;
+ } else {
+ breakRange = auxBreakPtr - envPtr->exceptAuxArrayPtr;
}
- hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typeName);
- if (hPtr != NULL) {
- typePtr = Tcl_GetHashValue(hPtr);
+ if (auxBreakPtr != NULL || auxContinuePtr != NULL) {
+ loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+ ExceptionRangeStarts(envPtr, loopRange);
}
- Tcl_MutexUnlock(&tableMutex);
- return typePtr;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * TclInitAuxDataTypeTable --
- *
- * This procedure is invoked to perform once-only initialization of the
- * AuxData type table. It also registers the AuxData types defined in
- * this file.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Initializes the table of defined AuxData types "auxDataTypeTable" with
- * builtin AuxData types defined in this file.
- *
- *--------------------------------------------------------------
- */
-
-void
-TclInitAuxDataTypeTable(void)
-{
/*
- * The table mutex must already be held before this routine is invoked.
+ * Issue the invoke itself.
*/
- auxDataTypeTableInitialized = 1;
- Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS);
+ 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;
+ }
/*
- * There are only three AuxData types at this time, so register them here.
+ * If we're generating a special wrapper exception range, we need to
+ * finish that up now.
*/
- RegisterAuxDataType(&tclForeachInfoType);
- RegisterAuxDataType(&tclJumptableInfoType);
- RegisterAuxDataType(&tclDictUpdateInfoType);
+ if (auxBreakPtr != NULL || auxContinuePtr != NULL) {
+ int savedStackDepth = envPtr->currStackDepth;
+ int savedExpandCount = envPtr->expandCount;
+ JumpFixup nonTrapFixup;
+
+ if (auxBreakPtr != NULL) {
+ auxBreakPtr = envPtr->exceptAuxArrayPtr + breakRange;
+ }
+ if (auxContinuePtr != NULL) {
+ auxContinuePtr = envPtr->exceptAuxArrayPtr + continueRange;
+ }
+
+ ExceptionRangeEnds(envPtr, loopRange);
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &nonTrapFixup);
+
+ /*
+ * 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.
+ */
+
+ if (auxBreakPtr != NULL) {
+ TclAdjustStackDepth(-1, envPtr);
+
+ ExceptionRangeTarget(envPtr, loopRange, breakOffset);
+ TclCleanupStackForBreakContinue(envPtr, auxBreakPtr);
+ TclAddLoopBreakFixup(envPtr, auxBreakPtr);
+ TclAdjustStackDepth(1, envPtr);
+
+ envPtr->currStackDepth = savedStackDepth;
+ envPtr->expandCount = savedExpandCount;
+ }
+
+ if (auxContinuePtr != NULL) {
+ TclAdjustStackDepth(-1, envPtr);
+
+ ExceptionRangeTarget(envPtr, loopRange, continueOffset);
+ TclCleanupStackForBreakContinue(envPtr, auxContinuePtr);
+ TclAddLoopContinueFixup(envPtr, auxContinuePtr);
+ TclAdjustStackDepth(1, envPtr);
+
+ envPtr->currStackDepth = savedStackDepth;
+ envPtr->expandCount = savedExpandCount;
+ }
+
+ TclFinalizeLoopExceptionRange(envPtr, loopRange);
+ TclFixupForwardJumpToHere(envPtr, &nonTrapFixup, 127);
+ }
+ TclCheckStackDepth(depth+1-cleanup, envPtr);
}
/*
*----------------------------------------------------------------------
*
- * TclFinalizeAuxDataTypeTable --
+ * TclGetInstructionTable --
*
- * This procedure is called by Tcl_Finalize after all exit handlers have
- * been run to free up storage associated with the table of AuxData
- * types. This procedure is called by TclFinalizeExecution() which is
- * called by Tcl_Finalize().
+ * Returns a pointer to the table describing Tcl bytecode instructions.
+ * This procedure is defined so that clients can access the pointer from
+ * outside the TCL DLLs.
*
* Results:
- * None.
+ * Returns a pointer to the global instruction table, same as the
+ * expression (&tclInstructionTable[0]).
*
* Side effects:
- * Deletes all entries in the hash table of AuxData types.
+ * None.
*
*----------------------------------------------------------------------
*/
-void
-TclFinalizeAuxDataTypeTable(void)
+const void * /* == InstructionDesc* == */
+TclGetInstructionTable(void)
{
- Tcl_MutexLock(&tableMutex);
- if (auxDataTypeTableInitialized) {
- Tcl_DeleteHashTable(&auxDataTypeTable);
- auxDataTypeTableInitialized = 0;
- }
- Tcl_MutexUnlock(&tableMutex);
+ return &tclInstructionTable[0];
}
/*
@@ -4279,773 +4407,6 @@ EncodeCmdLocMap(
return p;
}
-#ifdef TCL_COMPILE_DEBUG
-/*
- *----------------------------------------------------------------------
- *
- * TclPrintByteCodeObj --
- *
- * This procedure prints ("disassembles") the instructions of a bytecode
- * object to stdout.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclPrintByteCodeObj(
- Tcl_Interp *interp, /* Used only for Tcl_GetStringFromObj. */
- Tcl_Obj *objPtr) /* The bytecode object to disassemble. */
-{
- Tcl_Obj *bufPtr = TclDisassembleByteCodeObj(objPtr);
-
- fprintf(stdout, "\n%s", TclGetString(bufPtr));
- Tcl_DecrRefCount(bufPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclPrintInstruction --
- *
- * This procedure prints ("disassembles") one instruction from a bytecode
- * object to stdout.
- *
- * Results:
- * Returns the length in bytes of the current instruiction.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclPrintInstruction(
- ByteCode *codePtr, /* Bytecode containing the instruction. */
- const unsigned char *pc) /* Points to first byte of instruction. */
-{
- Tcl_Obj *bufferObj;
- int numBytes;
-
- TclNewObj(bufferObj);
- numBytes = FormatInstruction(codePtr, pc, bufferObj);
- fprintf(stdout, "%s", TclGetString(bufferObj));
- Tcl_DecrRefCount(bufferObj);
- return numBytes;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclPrintObject --
- *
- * This procedure prints up to a specified number of characters from the
- * argument Tcl object's string representation to a specified file.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Outputs characters to the specified file.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclPrintObject(
- FILE *outFile, /* The file to print the source to. */
- Tcl_Obj *objPtr, /* Points to the Tcl object whose string
- * representation should be printed. */
- int maxChars) /* Maximum number of chars to print. */
-{
- char *bytes;
- int length;
-
- bytes = Tcl_GetStringFromObj(objPtr, &length);
- TclPrintSource(outFile, bytes, TclMin(length, maxChars));
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclPrintSource --
- *
- * This procedure prints up to a specified number of characters from the
- * argument string to a specified file. It tries to produce legible
- * output by adding backslashes as necessary.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Outputs characters to the specified file.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclPrintSource(
- FILE *outFile, /* The file to print the source to. */
- const char *stringPtr, /* The string to print. */
- int maxChars) /* Maximum number of chars to print. */
-{
- Tcl_Obj *bufferObj;
-
- TclNewObj(bufferObj);
- PrintSourceToObj(bufferObj, stringPtr, maxChars);
- fprintf(outFile, "%s", TclGetString(bufferObj));
- Tcl_DecrRefCount(bufferObj);
-}
-#endif /* TCL_COMPILE_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * TclDisassembleByteCodeObj --
- *
- * Given an object which is of bytecode type, return a disassembled
- * version of the bytecode (in a new refcount 0 object). No guarantees
- * are made about the details of the contents of the result.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclDisassembleByteCodeObj(
- Tcl_Obj *objPtr) /* The bytecode object to disassemble. */
-{
- ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
- unsigned char *codeStart, *codeLimit, *pc;
- unsigned char *codeDeltaNext, *codeLengthNext;
- unsigned char *srcDeltaNext, *srcLengthNext;
- int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i;
- Interp *iPtr = (Interp *) *codePtr->interpHandle;
- Tcl_Obj *bufferObj;
- char ptrBuf1[20], ptrBuf2[20];
-
- TclNewObj(bufferObj);
- if (codePtr->refCount <= 0) {
- return bufferObj; /* Already freed. */
- }
-
- codeStart = codePtr->codeStart;
- codeLimit = codeStart + codePtr->numCodeBytes;
- numCmds = codePtr->numCommands;
-
- /*
- * Print header lines describing the ByteCode.
- */
-
- sprintf(ptrBuf1, "%p", codePtr);
- sprintf(ptrBuf2, "%p", iPtr);
- Tcl_AppendPrintfToObj(bufferObj,
- "ByteCode 0x%s, refCt %u, epoch %u, interp 0x%s (epoch %u)\n",
- ptrBuf1, codePtr->refCount, codePtr->compileEpoch, ptrBuf2,
- iPtr->compileEpoch);
- Tcl_AppendToObj(bufferObj, " Source ", -1);
- PrintSourceToObj(bufferObj, codePtr->source,
- TclMin(codePtr->numSrcBytes, 55));
- Tcl_AppendPrintfToObj(bufferObj,
- "\n Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
- numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
- codePtr->numLitObjects, codePtr->numAuxDataItems,
- codePtr->maxStackDepth,
-#ifdef TCL_COMPILE_STATS
- codePtr->numSrcBytes?
- codePtr->structureSize/(float)codePtr->numSrcBytes :
-#endif
- 0.0);
-
-#ifdef TCL_COMPILE_STATS
- Tcl_AppendPrintfToObj(bufferObj,
- " Code %lu = header %lu+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n",
- (unsigned long) codePtr->structureSize,
- (unsigned long) (sizeof(ByteCode) - sizeof(size_t) - sizeof(Tcl_Time)),
- codePtr->numCodeBytes,
- (unsigned long) (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
- (unsigned long) (codePtr->numExceptRanges*sizeof(ExceptionRange)),
- (unsigned long) (codePtr->numAuxDataItems * sizeof(AuxData)),
- codePtr->numCmdLocBytes);
-#endif /* TCL_COMPILE_STATS */
-
- /*
- * If the ByteCode is the compiled body of a Tcl procedure, print
- * information about that procedure. Note that we don't know the
- * procedure's name since ByteCode's can be shared among procedures.
- */
-
- if (codePtr->procPtr != NULL) {
- Proc *procPtr = codePtr->procPtr;
- int numCompiledLocals = procPtr->numCompiledLocals;
-
- sprintf(ptrBuf1, "%p", procPtr);
- Tcl_AppendPrintfToObj(bufferObj,
- " Proc 0x%s, refCt %d, args %d, compiled locals %d\n",
- ptrBuf1, procPtr->refCount, procPtr->numArgs,
- numCompiledLocals);
- if (numCompiledLocals > 0) {
- CompiledLocal *localPtr = procPtr->firstLocalPtr;
-
- for (i = 0; i < numCompiledLocals; i++) {
- Tcl_AppendPrintfToObj(bufferObj,
- " slot %d%s%s%s%s%s%s", i,
- (localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar",
- (localPtr->flags & VAR_ARRAY) ? ", array" : "",
- (localPtr->flags & VAR_LINK) ? ", link" : "",
- (localPtr->flags & VAR_ARGUMENT) ? ", arg" : "",
- (localPtr->flags & VAR_TEMPORARY) ? ", temp" : "",
- (localPtr->flags & VAR_RESOLVED) ? ", resolved" : "");
- if (TclIsVarTemporary(localPtr)) {
- Tcl_AppendToObj(bufferObj, "\n", -1);
- } else {
- Tcl_AppendPrintfToObj(bufferObj, ", \"%s\"\n",
- localPtr->name);
- }
- localPtr = localPtr->nextPtr;
- }
- }
- }
-
- /*
- * Print the ExceptionRange array.
- */
-
- if (codePtr->numExceptRanges > 0) {
- Tcl_AppendPrintfToObj(bufferObj, " Exception ranges %d, depth %d:\n",
- codePtr->numExceptRanges, codePtr->maxExceptDepth);
- for (i = 0; i < codePtr->numExceptRanges; i++) {
- ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];
-
- Tcl_AppendPrintfToObj(bufferObj,
- " %d: level %d, %s, pc %d-%d, ",
- i, rangePtr->nestingLevel,
- (rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"),
- rangePtr->codeOffset,
- (rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
- switch (rangePtr->type) {
- case LOOP_EXCEPTION_RANGE:
- Tcl_AppendPrintfToObj(bufferObj, "continue %d, break %d\n",
- rangePtr->continueOffset, rangePtr->breakOffset);
- break;
- case CATCH_EXCEPTION_RANGE:
- Tcl_AppendPrintfToObj(bufferObj, "catch %d\n",
- rangePtr->catchOffset);
- break;
- default:
- Tcl_Panic("TclDisassembleByteCodeObj: bad ExceptionRange type %d",
- rangePtr->type);
- }
- }
- }
-
- /*
- * If there were no commands (e.g., an expression or an empty string was
- * compiled), just print all instructions and return.
- */
-
- if (numCmds == 0) {
- pc = codeStart;
- while (pc < codeLimit) {
- Tcl_AppendToObj(bufferObj, " ", -1);
- pc += FormatInstruction(codePtr, pc, bufferObj);
- }
- return bufferObj;
- }
-
- /*
- * Print table showing the code offset, source offset, and source length
- * for each command. These are encoded as a sequence of bytes.
- */
-
- Tcl_AppendPrintfToObj(bufferObj, " Commands %d:", numCmds);
- codeDeltaNext = codePtr->codeDeltaStart;
- codeLengthNext = codePtr->codeLengthStart;
- srcDeltaNext = codePtr->srcDeltaStart;
- srcLengthNext = codePtr->srcLengthStart;
- codeOffset = srcOffset = 0;
- for (i = 0; i < numCmds; i++) {
- if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
- codeDeltaNext++;
- delta = TclGetInt4AtPtr(codeDeltaNext);
- codeDeltaNext += 4;
- } else {
- delta = TclGetInt1AtPtr(codeDeltaNext);
- codeDeltaNext++;
- }
- codeOffset += delta;
-
- if ((unsigned) *codeLengthNext == (unsigned) 0xFF) {
- codeLengthNext++;
- codeLen = TclGetInt4AtPtr(codeLengthNext);
- codeLengthNext += 4;
- } else {
- codeLen = TclGetInt1AtPtr(codeLengthNext);
- codeLengthNext++;
- }
-
- if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
- srcDeltaNext++;
- delta = TclGetInt4AtPtr(srcDeltaNext);
- srcDeltaNext += 4;
- } else {
- delta = TclGetInt1AtPtr(srcDeltaNext);
- srcDeltaNext++;
- }
- srcOffset += delta;
-
- if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
- srcLengthNext++;
- srcLen = TclGetInt4AtPtr(srcLengthNext);
- srcLengthNext += 4;
- } else {
- srcLen = TclGetInt1AtPtr(srcLengthNext);
- srcLengthNext++;
- }
-
- Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d",
- ((i % 2)? " " : "\n "),
- (i+1), codeOffset, (codeOffset + codeLen - 1),
- srcOffset, (srcOffset + srcLen - 1));
- }
- if (numCmds > 0) {
- Tcl_AppendToObj(bufferObj, "\n", -1);
- }
-
- /*
- * Print each instruction. If the instruction corresponds to the start of
- * a command, print the command's source. Note that we don't need the code
- * length here.
- */
-
- codeDeltaNext = codePtr->codeDeltaStart;
- srcDeltaNext = codePtr->srcDeltaStart;
- srcLengthNext = codePtr->srcLengthStart;
- codeOffset = srcOffset = 0;
- pc = codeStart;
- for (i = 0; i < numCmds; i++) {
- if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
- codeDeltaNext++;
- delta = TclGetInt4AtPtr(codeDeltaNext);
- codeDeltaNext += 4;
- } else {
- delta = TclGetInt1AtPtr(codeDeltaNext);
- codeDeltaNext++;
- }
- codeOffset += delta;
-
- if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
- srcDeltaNext++;
- delta = TclGetInt4AtPtr(srcDeltaNext);
- srcDeltaNext += 4;
- } else {
- delta = TclGetInt1AtPtr(srcDeltaNext);
- srcDeltaNext++;
- }
- srcOffset += delta;
-
- if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
- srcLengthNext++;
- srcLen = TclGetInt4AtPtr(srcLengthNext);
- srcLengthNext += 4;
- } else {
- srcLen = TclGetInt1AtPtr(srcLengthNext);
- srcLengthNext++;
- }
-
- /*
- * Print instructions before command i.
- */
-
- while ((pc-codeStart) < codeOffset) {
- Tcl_AppendToObj(bufferObj, " ", -1);
- pc += FormatInstruction(codePtr, pc, bufferObj);
- }
-
- Tcl_AppendPrintfToObj(bufferObj, " Command %d: ", i+1);
- PrintSourceToObj(bufferObj, (codePtr->source + srcOffset),
- TclMin(srcLen, 55));
- Tcl_AppendToObj(bufferObj, "\n", -1);
- }
- if (pc < codeLimit) {
- /*
- * Print instructions after the last command.
- */
-
- while (pc < codeLimit) {
- Tcl_AppendToObj(bufferObj, " ", -1);
- pc += FormatInstruction(codePtr, pc, bufferObj);
- }
- }
- return bufferObj;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FormatInstruction --
- *
- * Appends a representation of a bytecode instruction to a Tcl_Obj.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-FormatInstruction(
- ByteCode *codePtr, /* Bytecode containing the instruction. */
- const unsigned char *pc, /* Points to first byte of instruction. */
- Tcl_Obj *bufferObj) /* Object to append instruction info to. */
-{
- Proc *procPtr = codePtr->procPtr;
- unsigned char opCode = *pc;
- register const InstructionDesc *instDesc = &tclInstructionTable[opCode];
- unsigned char *codeStart = codePtr->codeStart;
- unsigned pcOffset = pc - codeStart;
- int opnd = 0, i, j, numBytes = 1;
- int localCt = procPtr ? procPtr->numCompiledLocals : 0;
- CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL;
- char suffixBuffer[128]; /* Additional info to print after main opcode
- * and immediates. */
- char *suffixSrc = NULL;
- Tcl_Obj *suffixObj = NULL;
- AuxData *auxPtr = NULL;
-
- suffixBuffer[0] = '\0';
- Tcl_AppendPrintfToObj(bufferObj, "(%u) %s ", pcOffset, instDesc->name);
- for (i = 0; i < instDesc->numOperands; i++) {
- switch (instDesc->opTypes[i]) {
- case OPERAND_INT1:
- opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++;
- if (opCode == INST_JUMP1 || opCode == INST_JUMP_TRUE1
- || opCode == INST_JUMP_FALSE1) {
- sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
- }
- Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
- break;
- case OPERAND_INT4:
- opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
- if (opCode == INST_JUMP4 || opCode == INST_JUMP_TRUE4
- || opCode == INST_JUMP_FALSE4) {
- sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
- } else if (opCode == INST_START_CMD) {
- sprintf(suffixBuffer, "next cmd at pc %u", pcOffset+opnd);
- }
- Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
- break;
- case OPERAND_UINT1:
- opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
- if (opCode == INST_PUSH1) {
- suffixObj = codePtr->objArrayPtr[opnd];
- }
- Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
- break;
- case OPERAND_AUX4:
- case OPERAND_UINT4:
- opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
- if (opCode == INST_PUSH4) {
- suffixObj = codePtr->objArrayPtr[opnd];
- } else if (opCode == INST_START_CMD && opnd != 1) {
- sprintf(suffixBuffer+strlen(suffixBuffer),
- ", %u cmds start here", opnd);
- }
- Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
- if (instDesc->opTypes[i] == OPERAND_AUX4) {
- auxPtr = &codePtr->auxDataArrayPtr[opnd];
- }
- break;
- case OPERAND_IDX4:
- opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
- if (opnd >= -1) {
- Tcl_AppendPrintfToObj(bufferObj, "%d ", opnd);
- } else if (opnd == -2) {
- Tcl_AppendPrintfToObj(bufferObj, "end ");
- } else {
- Tcl_AppendPrintfToObj(bufferObj, "end-%d ", -2-opnd);
- }
- break;
- case OPERAND_LVT1:
- opnd = TclGetUInt1AtPtr(pc+numBytes);
- numBytes++;
- goto printLVTindex;
- case OPERAND_LVT4:
- opnd = TclGetUInt4AtPtr(pc+numBytes);
- numBytes += 4;
- printLVTindex:
- if (localPtr != NULL) {
- if (opnd >= localCt) {
- Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)",
- (unsigned) opnd, localCt);
- }
- for (j = 0; j < opnd; j++) {
- localPtr = localPtr->nextPtr;
- }
- if (TclIsVarTemporary(localPtr)) {
- sprintf(suffixBuffer, "temp var %u", (unsigned) opnd);
- } else {
- sprintf(suffixBuffer, "var ");
- suffixSrc = localPtr->name;
- }
- }
- Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", (unsigned) opnd);
- break;
- case OPERAND_NONE:
- default:
- break;
- }
- }
- if (suffixObj) {
- const char *bytes;
- int length;
-
- Tcl_AppendToObj(bufferObj, "\t# ", -1);
- bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length);
- PrintSourceToObj(bufferObj, bytes, TclMin(length, 40));
- } else if (suffixBuffer[0]) {
- Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer);
- if (suffixSrc) {
- PrintSourceToObj(bufferObj, suffixSrc, 40);
- }
- }
- Tcl_AppendToObj(bufferObj, "\n", -1);
- if (auxPtr && auxPtr->type->printProc) {
- Tcl_AppendToObj(bufferObj, "\t\t[", -1);
- auxPtr->type->printProc(auxPtr->clientData, bufferObj, codePtr,
- pcOffset);
- Tcl_AppendToObj(bufferObj, "]\n", -1);
- }
- return numBytes;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetInnerContext --
- *
- * If possible, returns a list capturing the inner context. Otherwise
- * return NULL.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclGetInnerContext(
- Tcl_Interp *interp,
- const unsigned char *pc,
- Tcl_Obj **tosPtr)
-{
- int objc = 0, off = 0;
- Tcl_Obj *result;
- Interp *iPtr = (Interp *) interp;
-
- switch (*pc) {
- case INST_STR_LEN:
- case INST_LNOT:
- case INST_BITNOT:
- case INST_UMINUS:
- case INST_UPLUS:
- case INST_TRY_CVT_TO_NUMERIC:
- case INST_EXPAND_STKTOP:
- case INST_EXPR_STK:
- objc = 1;
- break;
-
- case INST_LIST_IN:
- case INST_LIST_NOT_IN: /* Basic list containment operators. */
- case INST_STR_EQ:
- case INST_STR_NEQ: /* String (in)equality check */
- case INST_STR_CMP: /* String compare. */
- case INST_STR_INDEX:
- case INST_STR_MATCH:
- case INST_REGEXP:
- case INST_EQ:
- case INST_NEQ:
- case INST_LT:
- case INST_GT:
- case INST_LE:
- 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:
- objc = 2;
- break;
-
- case INST_RETURN_STK:
- /* early pop. TODO: dig out opt dict too :/ */
- objc = 1;
- break;
-
- case INST_SYNTAX:
- case INST_RETURN_IMM:
- objc = 2;
- break;
-
- case INST_INVOKE_STK4:
- objc = TclGetUInt4AtPtr(pc+1);
- break;
-
- case INST_INVOKE_STK1:
- objc = TclGetUInt1AtPtr(pc+1);
- break;
- }
-
- result = iPtr->innerContext;
- if (Tcl_IsShared(result)) {
- Tcl_DecrRefCount(result);
- iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL);
- Tcl_IncrRefCount(result);
- } else {
- int len;
-
- /*
- * Reset while keeping the list intrep as much as possible.
- */
-
- Tcl_ListObjLength(interp, result, &len);
- Tcl_ListObjReplace(interp, result, 0, len, 0, NULL);
- }
- Tcl_ListObjAppendElement(NULL, result, TclNewInstNameObj(*pc));
-
- for (; objc>0 ; objc--) {
- Tcl_Obj *objPtr;
-
- objPtr = tosPtr[1 - objc + off];
- if (!objPtr) {
- Tcl_Panic("InnerContext: bad tos -- appending null object");
- }
- if ((objPtr->refCount<=0)
-#ifdef TCL_MEM_DEBUG
- || (objPtr->refCount==0x61616161)
-#endif
- ) {
- Tcl_Panic("InnerContext: bad tos -- appending freed object %p",
- objPtr);
- }
- Tcl_ListObjAppendElement(NULL, result, objPtr);
- }
-
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclNewInstNameObj --
- *
- * Creates a new InstName Tcl_Obj based on the given instruction
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclNewInstNameObj(
- unsigned char inst)
-{
- Tcl_Obj *objPtr = Tcl_NewObj();
-
- objPtr->typePtr = &tclInstNameType;
- objPtr->internalRep.longValue = (long) inst;
- objPtr->bytes = NULL;
-
- return objPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * UpdateStringOfInstName --
- *
- * Update the string representation for an instruction name object.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-UpdateStringOfInstName(
- Tcl_Obj *objPtr)
-{
- int inst = objPtr->internalRep.longValue;
- char *s, buf[20];
- int len;
-
- if ((inst < 0) || (inst > LAST_INST_OPCODE)) {
- sprintf(buf, "inst_%d", inst);
- s = buf;
- } else {
- s = (char *) tclInstructionTable[objPtr->internalRep.longValue].name;
- }
- len = strlen(s);
- objPtr->bytes = ckalloc(len + 1);
- memcpy(objPtr->bytes, s, len + 1);
- objPtr->length = len;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PrintSourceToObj --
- *
- * Appends a quoted representation of a string to a Tcl_Obj.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-PrintSourceToObj(
- Tcl_Obj *appendObj, /* The object to print the source to. */
- const char *stringPtr, /* The string to print. */
- int maxChars) /* Maximum number of chars to print. */
-{
- register const char *p;
- register int i = 0;
-
- if (stringPtr == NULL) {
- Tcl_AppendToObj(appendObj, "\"\"", -1);
- return;
- }
-
- Tcl_AppendToObj(appendObj, "\"", -1);
- p = stringPtr;
- for (; (*p != '\0') && (i < maxChars); p++, i++) {
- switch (*p) {
- case '"':
- Tcl_AppendToObj(appendObj, "\\\"", -1);
- continue;
- case '\f':
- Tcl_AppendToObj(appendObj, "\\f", -1);
- continue;
- case '\n':
- Tcl_AppendToObj(appendObj, "\\n", -1);
- continue;
- case '\r':
- Tcl_AppendToObj(appendObj, "\\r", -1);
- continue;
- case '\t':
- Tcl_AppendToObj(appendObj, "\\t", -1);
- continue;
- case '\v':
- Tcl_AppendToObj(appendObj, "\\v", -1);
- continue;
- default:
- Tcl_AppendPrintfToObj(appendObj, "%c", *p);
- continue;
- }
- }
- Tcl_AppendToObj(appendObj, "\"", -1);
-}
-
#ifdef TCL_COMPILE_STATS
/*
*----------------------------------------------------------------------
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 5660055..d5bc86b 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -48,6 +48,13 @@ MODULE_SCOPE int tclTraceCompile;
MODULE_SCOPE int tclTraceExec;
#endif
+
+/*
+ * The type of lambda expressions. Note that every lambda will *always* have a
+ * string representation.
+ */
+
+MODULE_SCOPE const Tcl_ObjType tclLambdaType;
/*
*------------------------------------------------------------------------
@@ -128,7 +135,7 @@ typedef struct ExceptionAux {
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
+ unsigned 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
@@ -138,7 +145,7 @@ typedef struct ExceptionAux {
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
+ unsigned 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
@@ -238,6 +245,16 @@ typedef struct AuxDataType {
AuxDataPrintProc *printProc;/* Callback function to invoke when printing
* the aux data as part of debugging. NULL
* means that the data can't be printed. */
+ AuxDataPrintProc *disassembleProc;
+ /* Callback function to invoke when doing a
+ * disassembly of the aux data (like the
+ * printProc, except that the output is
+ * intended to be script-readable). The
+ * appendObj argument should be filled in with
+ * a descriptive dictionary; it will start out
+ * with "name" mapped to the content of the
+ * name field. NULL means that the printProc
+ * should be used instead. */
} AuxDataType;
/*
@@ -512,7 +529,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
@@ -586,8 +603,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
@@ -751,6 +768,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
@@ -768,8 +787,42 @@ typedef struct ByteCode {
#define INST_EXPAND_DROP 165
+/* New foreach implementation */
+#define INST_FOREACH_START 166
+#define INST_FOREACH_STEP 167
+#define INST_FOREACH_END 168
+#define INST_LMAP_COLLECT 169
+
+/* For compilation of [string trim] and related */
+#define INST_STR_TRIM 170
+#define INST_STR_TRIM_LEFT 171
+#define INST_STR_TRIM_RIGHT 172
+
+#define INST_CONCAT_STK 173
+
+#define INST_STR_UPPER 174
+#define INST_STR_LOWER 175
+#define INST_STR_TITLE 176
+#define INST_STR_REPLACE 177
+
+#define INST_ORIGIN_COMMAND 178
+
+#define INST_TCLOO_NEXT 179
+#define INST_TCLOO_NEXT_CLASS 180
+
+#define INST_YIELD_TO_INVOKE 181
+
+#define INST_NUM_TYPE 182
+#define INST_TRY_CVT_TO_BOOLEAN 183
+#define INST_STR_CLASS 184
+
+#define INST_LAPPEND_LIST 185
+#define INST_LAPPEND_LIST_ARRAY 186
+#define INST_LAPPEND_LIST_ARRAY_STK 187
+#define INST_LAPPEND_LIST_STK 188
+
/* The last opcode */
-#define LAST_INST_OPCODE 165
+#define LAST_INST_OPCODE 188
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
@@ -794,8 +847,15 @@ 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_OFFSET1, /* One byte signed jump offset. */
+ OPERAND_OFFSET4, /* Four byte signed jump offset. */
+ OPERAND_LIT1, /* One byte unsigned index into table of
+ * literals. */
+ OPERAND_LIT4, /* Four byte unsigned index into table of
+ * literals. */
+ OPERAND_SCLS1 /* Index into tclStringClassTable. */
} InstOperandType;
typedef struct InstructionDesc {
@@ -814,6 +874,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
@@ -834,7 +928,7 @@ typedef enum {
typedef struct JumpFixup {
TclJumpType jumpType; /* Indicates the kind of jump. */
- int codeOffset; /* Offset of the first byte of the one-byte
+ unsigned int codeOffset; /* Offset of the first byte of the one-byte
* forward jump's code. */
int cmdIndex; /* Index of the first command after the one
* for which the jump was emitted. Used to
@@ -901,11 +995,6 @@ typedef struct ForeachInfo {
* LAST FIELD IN THE STRUCTURE! */
} ForeachInfo;
-MODULE_SCOPE const AuxDataType tclForeachInfoType;
-
-#define FOREACHINFO(envPtr, index) \
- ((ForeachInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData))
-
/*
* Structure used to hold information about a switch command that is needed
* during program execution. These structures are stored in CompileEnv and
@@ -938,11 +1027,6 @@ typedef struct {
* STRUCTURE. */
} DictUpdateInfo;
-MODULE_SCOPE const AuxDataType tclDictUpdateInfoType;
-
-#define DICTUPDATEINFO(envPtr, index) \
- ((DictUpdateInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData))
-
/*
* ClientData type used by the math operator commands.
*/
@@ -1021,13 +1105,13 @@ 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 int TclFixupForwardJump(CompileEnv *envPtr,
@@ -1035,7 +1119,6 @@ MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr,
int distThreshold);
MODULE_SCOPE void TclFreeCompileEnv(CompileEnv *envPtr);
MODULE_SCOPE void TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
-MODULE_SCOPE void TclInitAuxDataTypeTable(void);
MODULE_SCOPE void TclInitByteCodeObj(Tcl_Obj *objPtr,
CompileEnv *envPtr);
MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp,
@@ -1055,7 +1138,11 @@ MODULE_SCOPE void TclFinalizeLoopExceptionRange(CompileEnv *envPtr,
MODULE_SCOPE char * TclLiteralStats(LiteralTable *tablePtr);
MODULE_SCOPE int TclLog2(int value);
#endif
-MODULE_SCOPE void TclOptimizeBytecode(CompileEnv *envPtr);
+MODULE_SCOPE int TclLocalScalar(const char *bytes, int numBytes,
+ CompileEnv *envPtr);
+MODULE_SCOPE int TclLocalScalarFromToken(Tcl_Token *tokenPtr,
+ CompileEnv *envPtr);
+MODULE_SCOPE void TclOptimizeBytecode(void *envPtr);
#ifdef TCL_COMPILE_DEBUG
MODULE_SCOPE void TclPrintByteCodeObj(Tcl_Interp *interp,
Tcl_Obj *objPtr);
@@ -1070,10 +1157,8 @@ MODULE_SCOPE void TclPushVarName(Tcl_Interp *interp,
Tcl_Token *varTokenPtr, CompileEnv *envPtr,
int flags, int *localIndexPtr,
int *isScalarPtr);
-MODULE_SCOPE int TclRegisterLiteral(CompileEnv *envPtr,
- char *bytes, int length, int flags);
MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
-MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp,
+MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp,
const char *name, Namespace *nsPtr);
MODULE_SCOPE int TclSingleOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
@@ -1094,12 +1179,15 @@ MODULE_SCOPE void TclVerifyLocalLiteralTable(CompileEnv *envPtr);
MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
Tcl_Obj *valuePtr);
MODULE_SCOPE void TclLogCommandInfo(Tcl_Interp *interp,
- const char *script,
- const char *command, int length,
- const unsigned char *pc, Tcl_Obj **tosPtr);
+ const char *script, const char *command,
+ int length, const unsigned char *pc,
+ Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj *TclGetInnerContext(Tcl_Interp *interp,
- const unsigned char *pc, Tcl_Obj **tosPtr);
+ const unsigned char *pc, Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
+MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData,
+ register Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[], int isLambda);
/*
@@ -1162,6 +1250,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.
@@ -1544,7 +1647,7 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
#define PushVarNameWord(i,v,e,f,l,sc,word) \
SetLineInformation(word); \
- TclPushVarName(i,v,e,f,l,sc)
+ TclPushVarName(i,v,e,f,l,sc)
/*
* Often want to issue one of two versions of an instruction based on whether
@@ -1566,11 +1669,9 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
#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)))
+ TclLocalScalar(chars, len, envPtr)
#define LocalScalarFromToken(tokenPtr,envPtr) \
- ((tokenPtr)->type != TCL_TOKEN_SIMPLE_WORD ? -1 : \
- LocalScalar((tokenPtr)[1].start, (tokenPtr)[1].size, (envPtr)))
+ TclLocalScalarFromToken(tokenPtr, envPtr)
/*
* Flags bits used by TclPushVarName.
diff --git a/generic/tclDate.c b/generic/tclDate.c
index 6222a8a..e4dd000 100644
--- a/generic/tclDate.c
+++ b/generic/tclDate.c
@@ -359,14 +359,8 @@ typedef short int yytype_int16;
#ifndef YYSIZE_T
# ifdef __SIZE_TYPE__
# define YYSIZE_T __SIZE_TYPE__
-# elif defined size_t
-# define YYSIZE_T size_t
-# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
-# include <stddef.h> /* INFRINGES ON USER NAME SPACE */
-# define YYSIZE_T size_t
# else
-# define YYSIZE_T unsigned int
+# define YYSIZE_T size_t
# endif
#endif
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 4d40be1..b022d3c 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:
*/
@@ -44,7 +48,7 @@ EXTERN CONST84_RETURN char * Tcl_PkgRequireEx(Tcl_Interp *interp,
const char *name, const char *version,
int exact, void *clientDataPtr);
/* 2 */
-EXTERN void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
+EXTERN TCL_NORETURN void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
/* 3 */
EXTERN char * Tcl_Alloc(unsigned int size);
/* 4 */
@@ -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 */
@@ -413,7 +417,7 @@ EXTERN int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
EXTERN void Tcl_EventuallyFree(ClientData clientData,
Tcl_FreeProc *freeProc);
/* 133 */
-EXTERN void Tcl_Exit(int status);
+EXTERN TCL_NORETURN void Tcl_Exit(int status);
/* 134 */
EXTERN int Tcl_ExposeCommand(Tcl_Interp *interp,
const char *hiddenCmdToken,
@@ -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,
@@ -682,7 +686,8 @@ EXTERN void Tcl_SetErrorCode(Tcl_Interp *interp, ...);
/* 229 */
EXTERN void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr);
/* 230 */
-EXTERN void Tcl_SetPanicProc(Tcl_PanicProc *panicProc);
+EXTERN void Tcl_SetPanicProc(
+ TCL_NORETURN1 Tcl_PanicProc *panicProc);
/* 231 */
EXTERN int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth);
/* 232 */
@@ -831,7 +836,7 @@ EXTERN int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList);
/* 277 */
EXTERN Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options);
/* 278 */
-EXTERN void Tcl_PanicVA(const char *format, va_list argList);
+EXTERN TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList);
/* 279 */
EXTERN void Tcl_GetVersion(int *major, int *minor,
int *patchLevel, int *type);
@@ -1495,7 +1500,7 @@ EXTERN void Tcl_GetCommandFullName(Tcl_Interp *interp,
EXTERN int Tcl_FSEvalFileEx(Tcl_Interp *interp,
Tcl_Obj *fileName, const char *encodingName);
/* 519 */
-EXTERN Tcl_ExitProc * Tcl_SetExitProc(Tcl_ExitProc *proc);
+EXTERN Tcl_ExitProc * Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc);
/* 520 */
EXTERN void Tcl_LimitAddHandler(Tcl_Interp *interp, int type,
Tcl_LimitHandlerProc *handlerProc,
@@ -1824,26 +1829,26 @@ typedef struct TclStubs {
int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */
CONST84_RETURN char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */
- void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */
+ TCL_NORETURN1 void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */
char * (*tcl_Alloc) (unsigned int size); /* 3 */
void (*tcl_Free) (char *ptr); /* 4 */
char * (*tcl_Realloc) (char *ptr, unsigned int size); /* 5 */
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 */
@@ -1971,7 +1976,7 @@ typedef struct TclStubs {
int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */
int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */
void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */
- void (*tcl_Exit) (int status); /* 133 */
+ TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */
int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */
int (*tcl_ExprBoolean) (Tcl_Interp *interp, const char *expr, int *ptr); /* 135 */
int (*tcl_ExprBooleanObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr); /* 136 */
@@ -2005,10 +2010,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 */
@@ -2076,7 +2081,7 @@ typedef struct TclStubs {
void (*tcl_SetErrno) (int err); /* 227 */
void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...); /* 228 */
void (*tcl_SetMaxBlockTime) (const Tcl_Time *timePtr); /* 229 */
- void (*tcl_SetPanicProc) (Tcl_PanicProc *panicProc); /* 230 */
+ void (*tcl_SetPanicProc) (TCL_NORETURN1 Tcl_PanicProc *panicProc); /* 230 */
int (*tcl_SetRecursionLimit) (Tcl_Interp *interp, int depth); /* 231 */
void (*tcl_SetResult) (Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc); /* 232 */
int (*tcl_SetServiceMode) (int mode); /* 233 */
@@ -2124,7 +2129,7 @@ typedef struct TclStubs {
void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
- void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */
+ TCL_NORETURN1 void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */
void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */
void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */
Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 281 */
@@ -2365,7 +2370,7 @@ typedef struct TclStubs {
Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 516 */
void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 517 */
int (*tcl_FSEvalFileEx) (Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName); /* 518 */
- Tcl_ExitProc * (*tcl_SetExitProc) (Tcl_ExitProc *proc); /* 519 */
+ Tcl_ExitProc * (*tcl_SetExitProc) (TCL_NORETURN1 Tcl_ExitProc *proc); /* 519 */
void (*tcl_LimitAddHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 520 */
void (*tcl_LimitRemoveHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData); /* 521 */
int (*tcl_LimitReady) (Tcl_Interp *interp); /* 522 */
@@ -2479,10 +2484,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 +2514,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 +2522,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 +2842,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 */
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index e31d708..c8474e6 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -155,6 +155,13 @@ typedef struct Dict {
} Dict;
/*
+ * Accessor macro for converting between a Tcl_Obj* and a Dict. Note that this
+ * must be assignable as well as readable.
+ */
+
+#define DICT(dictObj) (*((Dict **)&(dictObj)->internalRep.twoPtrValue.ptr1))
+
+/*
* The structure below defines the dictionary object type by means of
* functions that can be invoked by generic object code.
*/
@@ -312,6 +319,7 @@ DeleteChainEntry(
return 0;
} else {
Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);
+
TclDecrRefCount(valuePtr);
}
@@ -361,7 +369,7 @@ DupDictInternalRep(
Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr)
{
- Dict *oldDict = srcPtr->internalRep.twoPtrValue.ptr1;
+ Dict *oldDict = DICT(srcPtr);
Dict *newDict = ckalloc(sizeof(Dict));
ChainEntry *cPtr;
@@ -396,7 +404,8 @@ DupDictInternalRep(
* Store in the object.
*/
- copyPtr->internalRep.twoPtrValue.ptr1 = newDict;
+ DICT(copyPtr) = newDict;
+ copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
copyPtr->typePtr = &tclDictType;
}
@@ -422,7 +431,7 @@ static void
FreeDictInternalRep(
Tcl_Obj *dictPtr)
{
- Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ Dict *dict = DICT(dictPtr);
dict->refcount--;
if (dict->refcount <= 0) {
@@ -487,7 +496,7 @@ UpdateStringOfDict(
{
#define LOCAL_SIZE 20
int localFlags[LOCAL_SIZE], *flagPtr = NULL;
- Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ Dict *dict = DICT(dictPtr);
ChainEntry *cPtr;
Tcl_Obj *keyPtr, *valuePtr;
int i, length, bytesNeeded = 0;
@@ -600,7 +609,7 @@ SetDictFromAny(
Tcl_Obj *objPtr)
{
Tcl_HashEntry *hPtr;
- int isNew, result;
+ int isNew;
Dict *dict = ckalloc(sizeof(Dict));
InitChainTable(dict);
@@ -622,7 +631,7 @@ SetDictFromAny(
}
for (i=0 ; i<objc ; i+=2) {
-
+
/* Store key and value in the hash table we're building. */
hPtr = CreateChainEntry(dict, objv[i], &isNew);
if (!isNew) {
@@ -651,10 +660,9 @@ SetDictFromAny(
const char *elemStart;
int elemSize, literal;
- result = TclFindElement(interp, nextElem, (limit - nextElem),
- &elemStart, &nextElem, &elemSize, &literal);
- if (result != TCL_OK) {
- goto errorExit;
+ if (TclFindDictElement(interp, nextElem, (limit - nextElem),
+ &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
+ goto errorInFindDictElement;
}
if (elemStart == limit) {
break;
@@ -673,11 +681,10 @@ SetDictFromAny(
keyPtr->bytes);
}
- result = TclFindElement(interp, nextElem, (limit - nextElem),
- &elemStart, &nextElem, &elemSize, &literal);
- if (result != TCL_OK) {
+ if (TclFindDictElement(interp, nextElem, (limit - nextElem),
+ &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
TclDecrRefCount(keyPtr);
- goto errorExit;
+ goto errorInFindDictElement;
}
if (literal) {
@@ -713,7 +720,8 @@ SetDictFromAny(
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- objPtr->internalRep.twoPtrValue.ptr1 = dict;
+ DICT(objPtr) = dict;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = &tclDictType;
return TCL_OK;
@@ -723,15 +731,10 @@ SetDictFromAny(
"missing value to go with key", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
}
- result = TCL_ERROR;
-
- errorExit:
- if (interp != NULL) {
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
- }
+ errorInFindDictElement:
DeleteChainTable(dict);
ckfree(dict);
- return result;
+ return TCL_ERROR;
}
/*
@@ -777,12 +780,11 @@ TclTraceDictPath(
Dict *dict, *newDict;
int i;
- if (dictPtr->typePtr != &tclDictType) {
- if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
- return NULL;
- }
+ if (dictPtr->typePtr != &tclDictType
+ && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ return NULL;
}
- dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ dict = DICT(dictPtr);
if (flags & DICT_PATH_UPDATE) {
dict->chain = NULL;
}
@@ -818,14 +820,13 @@ TclTraceDictPath(
Tcl_SetHashValue(hPtr, tmpObj);
} else {
tmpObj = Tcl_GetHashValue(hPtr);
- if (tmpObj->typePtr != &tclDictType) {
- if (SetDictFromAny(interp, tmpObj) != TCL_OK) {
- return NULL;
- }
+ if (tmpObj->typePtr != &tclDictType
+ && SetDictFromAny(interp, tmpObj) != TCL_OK) {
+ return NULL;
}
}
- newDict = tmpObj->internalRep.twoPtrValue.ptr1;
+ newDict = DICT(tmpObj);
if (flags & DICT_PATH_UPDATE) {
if (Tcl_IsShared(tmpObj)) {
TclDecrRefCount(tmpObj);
@@ -833,7 +834,7 @@ TclTraceDictPath(
Tcl_IncrRefCount(tmpObj);
Tcl_SetHashValue(hPtr, tmpObj);
dict->epoch++;
- newDict = tmpObj->internalRep.twoPtrValue.ptr1;
+ newDict = DICT(tmpObj);
}
newDict->chain = dictPtr;
@@ -868,7 +869,7 @@ static void
InvalidateDictChain(
Tcl_Obj *dictObj)
{
- Dict *dict = dictObj->internalRep.twoPtrValue.ptr1;
+ Dict *dict = DICT(dictObj);
do {
TclInvalidateStringRep(dictObj);
@@ -878,7 +879,7 @@ InvalidateDictChain(
break;
}
dict->chain = NULL;
- dict = dictObj->internalRep.twoPtrValue.ptr1;
+ dict = DICT(dictObj);
} while (dict != NULL);
}
@@ -916,18 +917,15 @@ Tcl_DictObjPut(
Tcl_Panic("%s called with shared object", "Tcl_DictObjPut");
}
- if (dictPtr->typePtr != &tclDictType) {
- int result = SetDictFromAny(interp, dictPtr);
-
- if (result != TCL_OK) {
- return result;
- }
+ if (dictPtr->typePtr != &tclDictType
+ && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ return TCL_ERROR;
}
if (dictPtr->bytes != NULL) {
TclInvalidateStringRep(dictPtr);
}
- dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ dict = DICT(dictPtr);
hPtr = CreateChainEntry(dict, keyPtr, &isNew);
Tcl_IncrRefCount(valuePtr);
if (!isNew) {
@@ -970,15 +968,13 @@ Tcl_DictObjGet(
Dict *dict;
Tcl_HashEntry *hPtr;
- if (dictPtr->typePtr != &tclDictType) {
- int result = SetDictFromAny(interp, dictPtr);
- if (result != TCL_OK) {
- *valuePtrPtr = NULL;
- return result;
- }
+ if (dictPtr->typePtr != &tclDictType
+ && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ *valuePtrPtr = NULL;
+ return TCL_ERROR;
}
- dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ dict = DICT(dictPtr);
hPtr = Tcl_FindHashEntry(&dict->table, keyPtr);
if (hPtr == NULL) {
*valuePtrPtr = NULL;
@@ -1019,18 +1015,16 @@ Tcl_DictObjRemove(
Tcl_Panic("%s called with shared object", "Tcl_DictObjRemove");
}
- if (dictPtr->typePtr != &tclDictType) {
- int result = SetDictFromAny(interp, dictPtr);
- if (result != TCL_OK) {
- return result;
- }
+ if (dictPtr->typePtr != &tclDictType
+ && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ return TCL_ERROR;
}
- if (dictPtr->bytes != NULL) {
- TclInvalidateStringRep(dictPtr);
- }
- dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ dict = DICT(dictPtr);
if (DeleteChainEntry(dict, keyPtr)) {
+ if (dictPtr->bytes != NULL) {
+ TclInvalidateStringRep(dictPtr);
+ }
dict->epoch++;
}
return TCL_OK;
@@ -1062,14 +1056,12 @@ Tcl_DictObjSize(
{
Dict *dict;
- if (dictPtr->typePtr != &tclDictType) {
- int result = SetDictFromAny(interp, dictPtr);
- if (result != TCL_OK) {
- return result;
- }
+ if (dictPtr->typePtr != &tclDictType
+ && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ return TCL_ERROR;
}
- dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ dict = DICT(dictPtr);
*sizePtr = dict->table.numEntries;
return TCL_OK;
}
@@ -1116,15 +1108,12 @@ Tcl_DictObjFirst(
Dict *dict;
ChainEntry *cPtr;
- if (dictPtr->typePtr != &tclDictType) {
- int result = SetDictFromAny(interp, dictPtr);
-
- if (result != TCL_OK) {
- return result;
- }
+ if (dictPtr->typePtr != &tclDictType
+ && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ return TCL_ERROR;
}
- dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ dict = DICT(dictPtr);
cPtr = dict->entryChainHead;
if (cPtr == NULL) {
searchPtr->epoch = -1;
@@ -1299,11 +1288,12 @@ Tcl_DictObjPutKeyList(
return TCL_ERROR;
}
- dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ dict = DICT(dictPtr);
hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew);
Tcl_IncrRefCount(valuePtr);
if (!isNew) {
Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr);
+
TclDecrRefCount(oldValuePtr);
}
Tcl_SetHashValue(hPtr, valuePtr);
@@ -1355,7 +1345,7 @@ Tcl_DictObjRemoveKeyList(
return TCL_ERROR;
}
- dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ dict = DICT(dictPtr);
DeleteChainEntry(dict, keyv[keyc-1]);
InvalidateDictChain(dictPtr);
return TCL_OK;
@@ -1401,7 +1391,8 @@ Tcl_NewDictObj(void)
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- dictPtr->internalRep.twoPtrValue.ptr1 = dict;
+ DICT(dictPtr) = dict;
+ dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
dictPtr->typePtr = &tclDictType;
return dictPtr;
#endif
@@ -1450,7 +1441,8 @@ Tcl_DbNewDictObj(
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- dictPtr->internalRep.twoPtrValue.ptr1 = dict;
+ DICT(dictPtr) = dict;
+ dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
dictPtr->typePtr = &tclDictType;
return dictPtr;
#else /* !TCL_MEM_DEBUG */
@@ -1504,7 +1496,7 @@ DictCreateCmd(
/*
* The next command is assumed to never fail...
*/
- Tcl_DictObjPut(interp, dictObj, objv[i], objv[i+1]);
+ Tcl_DictObjPut(NULL, dictObj, objv[i], objv[i+1]);
}
Tcl_SetObjResult(interp, dictObj);
return TCL_OK;
@@ -1629,8 +1621,7 @@ DictReplaceCmd(
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr;
- int i, result;
- int allocatedDict = 0;
+ int i;
if ((objc < 2) || (objc & 1)) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key value ...?");
@@ -1638,18 +1629,18 @@ DictReplaceCmd(
}
dictPtr = objv[1];
+ if (dictPtr->typePtr != &tclDictType
+ && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
if (Tcl_IsShared(dictPtr)) {
dictPtr = Tcl_DuplicateObj(dictPtr);
- allocatedDict = 1;
+ }
+ if (dictPtr->bytes != NULL) {
+ TclInvalidateStringRep(dictPtr);
}
for (i=2 ; i<objc ; i+=2) {
- result = Tcl_DictObjPut(interp, dictPtr, objv[i], objv[i+1]);
- if (result != TCL_OK) {
- if (allocatedDict) {
- TclDecrRefCount(dictPtr);
- }
- return TCL_ERROR;
- }
+ Tcl_DictObjPut(NULL, dictPtr, objv[i], objv[i+1]);
}
Tcl_SetObjResult(interp, dictPtr);
return TCL_OK;
@@ -1681,8 +1672,7 @@ DictRemoveCmd(
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr;
- int i, result;
- int allocatedDict = 0;
+ int i;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...?");
@@ -1690,18 +1680,18 @@ DictRemoveCmd(
}
dictPtr = objv[1];
+ if (dictPtr->typePtr != &tclDictType
+ && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
if (Tcl_IsShared(dictPtr)) {
dictPtr = Tcl_DuplicateObj(dictPtr);
- allocatedDict = 1;
+ }
+ if (dictPtr->bytes != NULL) {
+ TclInvalidateStringRep(dictPtr);
}
for (i=2 ; i<objc ; i++) {
- result = Tcl_DictObjRemove(interp, dictPtr, objv[i]);
- if (result != TCL_OK) {
- if (allocatedDict) {
- TclDecrRefCount(dictPtr);
- }
- return TCL_ERROR;
- }
+ Tcl_DictObjRemove(NULL, dictPtr, objv[i]);
}
Tcl_SetObjResult(interp, dictPtr);
return TCL_OK;
@@ -1750,10 +1740,9 @@ DictMergeCmd(
*/
targetObj = objv[1];
- if (targetObj->typePtr != &tclDictType) {
- if (SetDictFromAny(interp, targetObj) != TCL_OK) {
- return TCL_ERROR;
- }
+ if (targetObj->typePtr != &tclDictType
+ && SetDictFromAny(interp, targetObj) != TCL_OK) {
+ return TCL_ERROR;
}
if (objc == 2) {
@@ -1835,12 +1824,9 @@ DictKeysCmd(
* need. [Bug 1705778, leak K04]
*/
- if (objv[1]->typePtr != &tclDictType) {
- int result = SetDictFromAny(interp, objv[1]);
-
- if (result != TCL_OK) {
- return result;
- }
+ if (objv[1]->typePtr != &tclDictType
+ && SetDictFromAny(interp, objv[1]) != TCL_OK) {
+ return TCL_ERROR;
}
if (objc == 3) {
@@ -2056,13 +2042,11 @@ DictInfoCmd(
}
dictPtr = objv[1];
- if (dictPtr->typePtr != &tclDictType) {
- int result = SetDictFromAny(interp, dictPtr);
- if (result != TCL_OK) {
- return result;
- }
+ if (dictPtr->typePtr != &tclDictType
+ && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ return TCL_ERROR;
}
- dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ dict = DICT(dictPtr);
statsStr = Tcl_HashStats(&dict->table);
Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1));
@@ -2099,7 +2083,7 @@ DictIncrCmd(
Tcl_Obj *dictPtr, *valuePtr = NULL;
if (objc < 3 || objc > 4) {
- Tcl_WrongNumArgs(interp, 1, objv, "varName key ?increment?");
+ Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?increment?");
return TCL_ERROR;
}
@@ -2152,10 +2136,10 @@ DictIncrCmd(
*/
mp_clear(&increment);
- Tcl_DictObjPut(interp, dictPtr, objv[2], objv[3]);
+ Tcl_DictObjPut(NULL, dictPtr, objv[2], objv[3]);
}
} else {
- Tcl_DictObjPut(interp, dictPtr, objv[2], Tcl_NewIntObj(1));
+ Tcl_DictObjPut(NULL, dictPtr, objv[2], Tcl_NewIntObj(1));
}
} else {
/*
@@ -2164,7 +2148,7 @@ DictIncrCmd(
if (Tcl_IsShared(valuePtr)) {
valuePtr = Tcl_DuplicateObj(valuePtr);
- Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
+ Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
}
if (objc == 4) {
code = TclIncrObj(interp, valuePtr, objv[3]);
@@ -2173,7 +2157,7 @@ DictIncrCmd(
Tcl_IncrRefCount(incrPtr);
code = TclIncrObj(interp, valuePtr, incrPtr);
- Tcl_DecrRefCount(incrPtr);
+ TclDecrRefCount(incrPtr);
}
}
if (code == TCL_OK) {
@@ -2186,7 +2170,7 @@ DictIncrCmd(
Tcl_SetObjResult(interp, valuePtr);
}
} else if (dictPtr->refCount == 0) {
- Tcl_DecrRefCount(dictPtr);
+ TclDecrRefCount(dictPtr);
}
return code;
}
@@ -2220,7 +2204,7 @@ DictLappendCmd(
int i, allocatedDict = 0, allocatedValue = 0;
if (objc < 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "varName key ?value ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?");
return TCL_ERROR;
}
@@ -2264,7 +2248,7 @@ DictLappendCmd(
}
if (allocatedValue) {
- Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
+ Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
} else if (dictPtr->bytes != NULL) {
TclInvalidateStringRep(dictPtr);
}
@@ -2307,7 +2291,7 @@ DictAppendCmd(
int i, allocatedDict = 0;
if (objc < 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "varName key ?value ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?");
return TCL_ERROR;
}
@@ -2329,17 +2313,15 @@ DictAppendCmd(
if (valuePtr == NULL) {
TclNewObj(valuePtr);
- } else {
- if (Tcl_IsShared(valuePtr)) {
- valuePtr = Tcl_DuplicateObj(valuePtr);
- }
+ } else if (Tcl_IsShared(valuePtr)) {
+ valuePtr = Tcl_DuplicateObj(valuePtr);
}
for (i=3 ; i<objc ; i++) {
Tcl_AppendObjToObj(valuePtr, objv[i]);
}
- Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
+ Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
TCL_LEAVE_ERR_MSG);
@@ -2383,7 +2365,7 @@ DictForNRCmd(
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv,
- "{keyVar valueVar} dictionary script");
+ "{keyVarName valueVarName} dictionary script");
return TCL_ERROR;
}
@@ -2397,6 +2379,7 @@ DictForNRCmd(
if (varc != 2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"must have exactly two variable names", -1));
+ Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "for", NULL);
return TCL_ERROR;
}
searchPtr = TclStackAlloc(interp, sizeof(Tcl_DictSearch));
@@ -2430,12 +2413,14 @@ DictForNRCmd(
*/
Tcl_IncrRefCount(valueObj);
- if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) {
+ if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj,
+ TCL_LEAVE_ERR_MSG) == NULL) {
TclDecrRefCount(valueObj);
goto error;
}
TclDecrRefCount(valueObj);
- if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) {
+ if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj,
+ TCL_LEAVE_ERR_MSG) == NULL) {
goto error;
}
@@ -2574,7 +2559,7 @@ DictMapNRCmd(
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv,
- "{keyVar valueVar} dictionary script");
+ "{keyVarName valueVarName} dictionary script");
return TCL_ERROR;
}
@@ -2588,6 +2573,7 @@ DictMapNRCmd(
if (varc != 2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"must have exactly two variable names", -1));
+ Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "map", NULL);
return TCL_ERROR;
}
storagePtr = TclStackAlloc(interp, sizeof(DictMapStorage));
@@ -2782,7 +2768,7 @@ DictSetCmd(
int result, allocatedDict = 0;
if (objc < 4) {
- Tcl_WrongNumArgs(interp, 1, objv, "varName key ?key ...? value");
+ Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?key ...? value");
return TCL_ERROR;
}
@@ -2842,7 +2828,7 @@ DictUnsetCmd(
int result, allocatedDict = 0;
if (objc < 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "varName key ?key ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?key ...?");
return TCL_ERROR;
}
@@ -2949,12 +2935,12 @@ DictFilterCmd(
Tcl_DictObjDone(&search);
Tcl_DictObjGet(interp, objv[1], objv[3], &valueObj);
if (valueObj != NULL) {
- Tcl_DictObjPut(interp, resultObj, objv[3], valueObj);
+ Tcl_DictObjPut(NULL, resultObj, objv[3], valueObj);
}
} else {
while (!done) {
if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
- Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+ Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
}
Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
}
@@ -2972,7 +2958,7 @@ DictFilterCmd(
for (i=3 ; i<objc ; i++) {
pattern = TclGetString(objv[i]);
if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
- Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+ Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
break; /* stop inner loop */
}
}
@@ -2998,7 +2984,7 @@ DictFilterCmd(
for (i=3 ; i<objc ; i++) {
pattern = TclGetString(objv[i]);
if (Tcl_StringMatch(TclGetString(valueObj), pattern)) {
- Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+ Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
break; /* stop inner loop */
}
}
@@ -3010,7 +2996,7 @@ DictFilterCmd(
case FILTER_SCRIPT:
if (objc != 5) {
Tcl_WrongNumArgs(interp, 1, objv,
- "dictionary script {keyVar valueVar} filterScript");
+ "dictionary script {keyVarName valueVarName} filterScript");
return TCL_ERROR;
}
@@ -3026,6 +3012,7 @@ DictFilterCmd(
if (varc != 2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"must have exactly two variable names", -1));
+ Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "filter", NULL);
return TCL_ERROR;
}
keyVarObj = varv[0];
@@ -3064,19 +3051,15 @@ DictFilterCmd(
Tcl_IncrRefCount(valueObj);
if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj,
TCL_LEAVE_ERR_MSG) == NULL) {
- Tcl_ResetResult(interp);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't set key variable: \"%s\"",
- TclGetString(keyVarObj)));
+ Tcl_AddErrorInfo(interp,
+ "\n (\"dict filter\" filter script key variable)");
result = TCL_ERROR;
goto abnormalResult;
}
if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj,
TCL_LEAVE_ERR_MSG) == NULL) {
- Tcl_ResetResult(interp);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't set value variable: \"%s\"",
- TclGetString(valueVarObj)));
+ Tcl_AddErrorInfo(interp,
+ "\n (\"dict filter\" filter script value variable)");
result = TCL_ERROR;
goto abnormalResult;
}
@@ -3099,7 +3082,7 @@ DictFilterCmd(
}
TclDecrRefCount(boolObj);
if (satisfied) {
- Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+ Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
}
break;
case TCL_BREAK:
@@ -3190,7 +3173,7 @@ DictUpdateCmd(
if (objc < 5 || !(objc & 1)) {
Tcl_WrongNumArgs(interp, 1, objv,
- "varName key varName ?key varName ...? script");
+ "dictVarName key varName ?key varName ...? script");
return TCL_ERROR;
}
@@ -3287,18 +3270,17 @@ FinalizeDictUpdate(
for (i=0 ; i<objc ; i+=2) {
objPtr = Tcl_ObjGetVar2(interp, objv[i+1], NULL, 0);
if (objPtr == NULL) {
- Tcl_DictObjRemove(interp, dictPtr, objv[i]);
+ Tcl_DictObjRemove(NULL, dictPtr, objv[i]);
} else if (objPtr == dictPtr) {
/*
* Someone is messing us around, trying to build a recursive
* structure. [Bug 1786481]
*/
- Tcl_DictObjPut(interp, dictPtr, objv[i],
- Tcl_DuplicateObj(objPtr));
+ Tcl_DictObjPut(NULL, dictPtr, objv[i], Tcl_DuplicateObj(objPtr));
} else {
/* Shouldn't fail */
- Tcl_DictObjPut(interp, dictPtr, objv[i], objPtr);
+ Tcl_DictObjPut(NULL, dictPtr, objv[i], objPtr);
}
}
TclDecrRefCount(argsObj);
@@ -3347,7 +3329,7 @@ DictWithCmd(
Tcl_Obj *dictPtr, *keysPtr, *pathPtr;
if (objc < 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "dictVar ?key ...? script");
+ Tcl_WrongNumArgs(interp, 1, objv, "dictVarName ?key ...? script");
return TCL_ERROR;
}
diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c
new file mode 100644
index 0000000..c85fe13
--- /dev/null
+++ b/generic/tclDisassemble.c
@@ -0,0 +1,1503 @@
+/*
+ * tclDisassemble.c --
+ *
+ * This file contains procedures that disassemble bytecode into either
+ * human-readable or Tcl-processable forms.
+ *
+ * Copyright (c) 1996-1998 Sun Microsystems, Inc.
+ * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 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.
+ */
+
+#include "tclInt.h"
+#include "tclCompile.h"
+#include "tclOOInt.h"
+#include <assert.h>
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static Tcl_Obj * DisassembleByteCodeAsDicts(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
+static Tcl_Obj * DisassembleByteCodeObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
+static int FormatInstruction(ByteCode *codePtr,
+ const unsigned char *pc, Tcl_Obj *bufferObj);
+static void GetLocationInformation(Tcl_Interp *interp,
+ Proc *procPtr, Tcl_Obj **fileObjPtr,
+ int *linePtr);
+static void PrintSourceToObj(Tcl_Obj *appendObj,
+ const char *stringPtr, int maxChars);
+static void UpdateStringOfInstName(Tcl_Obj *objPtr);
+
+/*
+ * The structure below defines an instruction name Tcl object to allow
+ * reporting of inner contexts in errorstack without string allocation.
+ */
+
+static const Tcl_ObjType tclInstNameType = {
+ "instname", /* name */
+ NULL, /* freeIntRepProc */
+ NULL, /* dupIntRepProc */
+ UpdateStringOfInstName, /* updateStringProc */
+ NULL, /* setFromAnyProc */
+};
+
+/*
+ * How to get the bytecode out of a Tcl_Obj.
+ */
+
+#define BYTECODE(objPtr) \
+ ((ByteCode *) (objPtr)->internalRep.twoPtrValue.ptr1)
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetLocationInformation --
+ *
+ * This procedure looks up the information about where a procedure was
+ * originally declared.
+ *
+ * Results:
+ * Writes to the variables pointed at by fileObjPtr and linePtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetLocationInformation(
+ Tcl_Interp *interp, /* Where to look up the location
+ * information. */
+ Proc *procPtr, /* What to look up the information for. */
+ Tcl_Obj **fileObjPtr, /* Where to write the information about what
+ * file the code came from. Will be written
+ * to, either with the object (assume shared!)
+ * that describes what the file was, or with
+ * NULL if the information is not
+ * available. */
+ int *linePtr) /* Where to write the information about what
+ * line number represented the start of the
+ * code in question. Will be written to,
+ * either with the line number or with -1 if
+ * the information is not available. */
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_HashEntry *hePtr;
+ CmdFrame *cfPtr;
+
+ *fileObjPtr = NULL;
+ *linePtr = -1;
+ if (iPtr != NULL && procPtr != NULL) {
+ hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, procPtr);
+ if (hePtr != NULL && (cfPtr = Tcl_GetHashValue(hePtr)) != NULL) {
+ *linePtr = cfPtr->line[0];
+ if (cfPtr->type == TCL_LOCATION_SOURCE) {
+ *fileObjPtr = cfPtr->data.eval.path;
+ }
+ }
+ }
+}
+
+#ifdef TCL_COMPILE_DEBUG
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintByteCodeObj --
+ *
+ * This procedure prints ("disassembles") the instructions of a bytecode
+ * object to stdout.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPrintByteCodeObj(
+ Tcl_Interp *interp, /* Used only for getting location info. */
+ Tcl_Obj *objPtr) /* The bytecode object to disassemble. */
+{
+ Tcl_Obj *bufPtr = DisassembleByteCodeObj(interp, objPtr);
+
+ fprintf(stdout, "\n%s", TclGetString(bufPtr));
+ Tcl_DecrRefCount(bufPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintInstruction --
+ *
+ * This procedure prints ("disassembles") one instruction from a bytecode
+ * object to stdout.
+ *
+ * Results:
+ * Returns the length in bytes of the current instruiction.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclPrintInstruction(
+ ByteCode *codePtr, /* Bytecode containing the instruction. */
+ const unsigned char *pc) /* Points to first byte of instruction. */
+{
+ Tcl_Obj *bufferObj;
+ int numBytes;
+
+ TclNewObj(bufferObj);
+ numBytes = FormatInstruction(codePtr, pc, bufferObj);
+ fprintf(stdout, "%s", TclGetString(bufferObj));
+ Tcl_DecrRefCount(bufferObj);
+ return numBytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintObject --
+ *
+ * This procedure prints up to a specified number of characters from the
+ * argument Tcl object's string representation to a specified file.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Outputs characters to the specified file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPrintObject(
+ FILE *outFile, /* The file to print the source to. */
+ Tcl_Obj *objPtr, /* Points to the Tcl object whose string
+ * representation should be printed. */
+ int maxChars) /* Maximum number of chars to print. */
+{
+ char *bytes;
+ int length;
+
+ bytes = Tcl_GetStringFromObj(objPtr, &length);
+ TclPrintSource(outFile, bytes, TclMin(length, maxChars));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintSource --
+ *
+ * This procedure prints up to a specified number of characters from the
+ * argument string to a specified file. It tries to produce legible
+ * output by adding backslashes as necessary.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Outputs characters to the specified file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPrintSource(
+ FILE *outFile, /* The file to print the source to. */
+ const char *stringPtr, /* The string to print. */
+ int maxChars) /* Maximum number of chars to print. */
+{
+ Tcl_Obj *bufferObj;
+
+ TclNewObj(bufferObj);
+ PrintSourceToObj(bufferObj, stringPtr, maxChars);
+ fprintf(outFile, "%s", TclGetString(bufferObj));
+ Tcl_DecrRefCount(bufferObj);
+}
+#endif /* TCL_COMPILE_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisassembleByteCodeObj --
+ *
+ * Given an object which is of bytecode type, return a disassembled
+ * version of the bytecode (in a new refcount 0 object). No guarantees
+ * are made about the details of the contents of the result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+DisassembleByteCodeObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr) /* The bytecode object to disassemble. */
+{
+ ByteCode *codePtr = BYTECODE(objPtr);
+ unsigned char *codeStart, *codeLimit, *pc;
+ unsigned char *codeDeltaNext, *codeLengthNext;
+ unsigned char *srcDeltaNext, *srcLengthNext;
+ int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line;
+ Interp *iPtr = (Interp *) *codePtr->interpHandle;
+ Tcl_Obj *bufferObj, *fileObj;
+ char ptrBuf1[20], ptrBuf2[20];
+
+ TclNewObj(bufferObj);
+ if (codePtr->refCount <= 0) {
+ return bufferObj; /* Already freed. */
+ }
+
+ codeStart = codePtr->codeStart;
+ codeLimit = codeStart + codePtr->numCodeBytes;
+ numCmds = codePtr->numCommands;
+
+ /*
+ * Print header lines describing the ByteCode.
+ */
+
+ sprintf(ptrBuf1, "%p", codePtr);
+ sprintf(ptrBuf2, "%p", iPtr);
+ Tcl_AppendPrintfToObj(bufferObj,
+ "ByteCode 0x%s, refCt %u, epoch %u, interp 0x%s (epoch %u)\n",
+ ptrBuf1, codePtr->refCount, codePtr->compileEpoch, ptrBuf2,
+ iPtr->compileEpoch);
+ Tcl_AppendToObj(bufferObj, " Source ", -1);
+ PrintSourceToObj(bufferObj, codePtr->source,
+ TclMin(codePtr->numSrcBytes, 55));
+ GetLocationInformation(interp, codePtr->procPtr, &fileObj, &line);
+ if (line > -1 && fileObj != NULL) {
+ Tcl_AppendPrintfToObj(bufferObj, "\n File \"%s\" Line %d",
+ Tcl_GetString(fileObj), line);
+ }
+ Tcl_AppendPrintfToObj(bufferObj,
+ "\n Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
+ numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
+ codePtr->numLitObjects, codePtr->numAuxDataItems,
+ codePtr->maxStackDepth,
+#ifdef TCL_COMPILE_STATS
+ codePtr->numSrcBytes?
+ codePtr->structureSize/(float)codePtr->numSrcBytes :
+#endif
+ 0.0);
+
+#ifdef TCL_COMPILE_STATS
+ Tcl_AppendPrintfToObj(bufferObj,
+ " Code %lu = header %lu+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n",
+ (unsigned long) codePtr->structureSize,
+ (unsigned long) (sizeof(ByteCode) - sizeof(size_t) - sizeof(Tcl_Time)),
+ codePtr->numCodeBytes,
+ (unsigned long) (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
+ (unsigned long) (codePtr->numExceptRanges*sizeof(ExceptionRange)),
+ (unsigned long) (codePtr->numAuxDataItems * sizeof(AuxData)),
+ codePtr->numCmdLocBytes);
+#endif /* TCL_COMPILE_STATS */
+
+ /*
+ * If the ByteCode is the compiled body of a Tcl procedure, print
+ * information about that procedure. Note that we don't know the
+ * procedure's name since ByteCode's can be shared among procedures.
+ */
+
+ if (codePtr->procPtr != NULL) {
+ Proc *procPtr = codePtr->procPtr;
+ int numCompiledLocals = procPtr->numCompiledLocals;
+
+ sprintf(ptrBuf1, "%p", procPtr);
+ Tcl_AppendPrintfToObj(bufferObj,
+ " Proc 0x%s, refCt %d, args %d, compiled locals %d\n",
+ ptrBuf1, procPtr->refCount, procPtr->numArgs,
+ numCompiledLocals);
+ if (numCompiledLocals > 0) {
+ CompiledLocal *localPtr = procPtr->firstLocalPtr;
+
+ for (i = 0; i < numCompiledLocals; i++) {
+ Tcl_AppendPrintfToObj(bufferObj,
+ " slot %d%s%s%s%s%s%s", i,
+ (localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar",
+ (localPtr->flags & VAR_ARRAY) ? ", array" : "",
+ (localPtr->flags & VAR_LINK) ? ", link" : "",
+ (localPtr->flags & VAR_ARGUMENT) ? ", arg" : "",
+ (localPtr->flags & VAR_TEMPORARY) ? ", temp" : "",
+ (localPtr->flags & VAR_RESOLVED) ? ", resolved" : "");
+ if (TclIsVarTemporary(localPtr)) {
+ Tcl_AppendToObj(bufferObj, "\n", -1);
+ } else {
+ Tcl_AppendPrintfToObj(bufferObj, ", \"%s\"\n",
+ localPtr->name);
+ }
+ localPtr = localPtr->nextPtr;
+ }
+ }
+ }
+
+ /*
+ * Print the ExceptionRange array.
+ */
+
+ if (codePtr->numExceptRanges > 0) {
+ Tcl_AppendPrintfToObj(bufferObj, " Exception ranges %d, depth %d:\n",
+ codePtr->numExceptRanges, codePtr->maxExceptDepth);
+ for (i = 0; i < codePtr->numExceptRanges; i++) {
+ ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];
+
+ Tcl_AppendPrintfToObj(bufferObj,
+ " %d: level %d, %s, pc %d-%d, ",
+ i, rangePtr->nestingLevel,
+ (rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"),
+ rangePtr->codeOffset,
+ (rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
+ switch (rangePtr->type) {
+ case LOOP_EXCEPTION_RANGE:
+ Tcl_AppendPrintfToObj(bufferObj, "continue %d, break %d\n",
+ rangePtr->continueOffset, rangePtr->breakOffset);
+ break;
+ case CATCH_EXCEPTION_RANGE:
+ Tcl_AppendPrintfToObj(bufferObj, "catch %d\n",
+ rangePtr->catchOffset);
+ break;
+ default:
+ Tcl_Panic("DisassembleByteCodeObj: bad ExceptionRange type %d",
+ rangePtr->type);
+ }
+ }
+ }
+
+ /*
+ * If there were no commands (e.g., an expression or an empty string was
+ * compiled), just print all instructions and return.
+ */
+
+ if (numCmds == 0) {
+ pc = codeStart;
+ while (pc < codeLimit) {
+ Tcl_AppendToObj(bufferObj, " ", -1);
+ pc += FormatInstruction(codePtr, pc, bufferObj);
+ }
+ return bufferObj;
+ }
+
+ /*
+ * Print table showing the code offset, source offset, and source length
+ * for each command. These are encoded as a sequence of bytes.
+ */
+
+ Tcl_AppendPrintfToObj(bufferObj, " Commands %d:", numCmds);
+ codeDeltaNext = codePtr->codeDeltaStart;
+ codeLengthNext = codePtr->codeLengthStart;
+ srcDeltaNext = codePtr->srcDeltaStart;
+ srcLengthNext = codePtr->srcLengthStart;
+ codeOffset = srcOffset = 0;
+ for (i = 0; i < numCmds; i++) {
+ if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
+ codeDeltaNext++;
+ delta = TclGetInt4AtPtr(codeDeltaNext);
+ codeDeltaNext += 4;
+ } else {
+ delta = TclGetInt1AtPtr(codeDeltaNext);
+ codeDeltaNext++;
+ }
+ codeOffset += delta;
+
+ if ((unsigned) *codeLengthNext == (unsigned) 0xFF) {
+ codeLengthNext++;
+ codeLen = TclGetInt4AtPtr(codeLengthNext);
+ codeLengthNext += 4;
+ } else {
+ codeLen = TclGetInt1AtPtr(codeLengthNext);
+ codeLengthNext++;
+ }
+
+ if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
+ srcDeltaNext++;
+ delta = TclGetInt4AtPtr(srcDeltaNext);
+ srcDeltaNext += 4;
+ } else {
+ delta = TclGetInt1AtPtr(srcDeltaNext);
+ srcDeltaNext++;
+ }
+ srcOffset += delta;
+
+ if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
+ srcLengthNext++;
+ srcLen = TclGetInt4AtPtr(srcLengthNext);
+ srcLengthNext += 4;
+ } else {
+ srcLen = TclGetInt1AtPtr(srcLengthNext);
+ srcLengthNext++;
+ }
+
+ Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d",
+ ((i % 2)? " " : "\n "),
+ (i+1), codeOffset, (codeOffset + codeLen - 1),
+ srcOffset, (srcOffset + srcLen - 1));
+ }
+ if (numCmds > 0) {
+ Tcl_AppendToObj(bufferObj, "\n", -1);
+ }
+
+ /*
+ * Print each instruction. If the instruction corresponds to the start of
+ * a command, print the command's source. Note that we don't need the code
+ * length here.
+ */
+
+ codeDeltaNext = codePtr->codeDeltaStart;
+ srcDeltaNext = codePtr->srcDeltaStart;
+ srcLengthNext = codePtr->srcLengthStart;
+ codeOffset = srcOffset = 0;
+ pc = codeStart;
+ for (i = 0; i < numCmds; i++) {
+ if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
+ codeDeltaNext++;
+ delta = TclGetInt4AtPtr(codeDeltaNext);
+ codeDeltaNext += 4;
+ } else {
+ delta = TclGetInt1AtPtr(codeDeltaNext);
+ codeDeltaNext++;
+ }
+ codeOffset += delta;
+
+ if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
+ srcDeltaNext++;
+ delta = TclGetInt4AtPtr(srcDeltaNext);
+ srcDeltaNext += 4;
+ } else {
+ delta = TclGetInt1AtPtr(srcDeltaNext);
+ srcDeltaNext++;
+ }
+ srcOffset += delta;
+
+ if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
+ srcLengthNext++;
+ srcLen = TclGetInt4AtPtr(srcLengthNext);
+ srcLengthNext += 4;
+ } else {
+ srcLen = TclGetInt1AtPtr(srcLengthNext);
+ srcLengthNext++;
+ }
+
+ /*
+ * Print instructions before command i.
+ */
+
+ while ((pc-codeStart) < codeOffset) {
+ Tcl_AppendToObj(bufferObj, " ", -1);
+ pc += FormatInstruction(codePtr, pc, bufferObj);
+ }
+
+ Tcl_AppendPrintfToObj(bufferObj, " Command %d: ", i+1);
+ PrintSourceToObj(bufferObj, (codePtr->source + srcOffset),
+ TclMin(srcLen, 55));
+ Tcl_AppendToObj(bufferObj, "\n", -1);
+ }
+ if (pc < codeLimit) {
+ /*
+ * Print instructions after the last command.
+ */
+
+ while (pc < codeLimit) {
+ Tcl_AppendToObj(bufferObj, " ", -1);
+ pc += FormatInstruction(codePtr, pc, bufferObj);
+ }
+ }
+ return bufferObj;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FormatInstruction --
+ *
+ * Appends a representation of a bytecode instruction to a Tcl_Obj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FormatInstruction(
+ ByteCode *codePtr, /* Bytecode containing the instruction. */
+ const unsigned char *pc, /* Points to first byte of instruction. */
+ Tcl_Obj *bufferObj) /* Object to append instruction info to. */
+{
+ Proc *procPtr = codePtr->procPtr;
+ unsigned char opCode = *pc;
+ register const InstructionDesc *instDesc = &tclInstructionTable[opCode];
+ unsigned char *codeStart = codePtr->codeStart;
+ unsigned pcOffset = pc - codeStart;
+ int opnd = 0, i, j, numBytes = 1;
+ int localCt = procPtr ? procPtr->numCompiledLocals : 0;
+ CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL;
+ char suffixBuffer[128]; /* Additional info to print after main opcode
+ * and immediates. */
+ char *suffixSrc = NULL;
+ Tcl_Obj *suffixObj = NULL;
+ AuxData *auxPtr = NULL;
+
+ suffixBuffer[0] = '\0';
+ Tcl_AppendPrintfToObj(bufferObj, "(%u) %s ", pcOffset, instDesc->name);
+ for (i = 0; i < instDesc->numOperands; i++) {
+ switch (instDesc->opTypes[i]) {
+ case OPERAND_INT1:
+ opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++;
+ Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
+ break;
+ case OPERAND_INT4:
+ opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
+ Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
+ break;
+ case OPERAND_UINT1:
+ opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
+ Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
+ break;
+ case OPERAND_UINT4:
+ opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
+ if (opCode == INST_START_CMD) {
+ sprintf(suffixBuffer+strlen(suffixBuffer),
+ ", %u cmds start here", opnd);
+ }
+ Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
+ break;
+ case OPERAND_OFFSET1:
+ opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++;
+ sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
+ Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
+ break;
+ case OPERAND_OFFSET4:
+ opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
+ if (opCode == INST_START_CMD) {
+ sprintf(suffixBuffer, "next cmd at pc %u", pcOffset+opnd);
+ } else {
+ sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
+ }
+ Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
+ break;
+ case OPERAND_LIT1:
+ opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
+ suffixObj = codePtr->objArrayPtr[opnd];
+ Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
+ break;
+ case OPERAND_LIT4:
+ opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
+ suffixObj = codePtr->objArrayPtr[opnd];
+ Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
+ break;
+ case OPERAND_AUX4:
+ opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
+ Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
+ auxPtr = &codePtr->auxDataArrayPtr[opnd];
+ break;
+ case OPERAND_IDX4:
+ opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
+ if (opnd >= -1) {
+ Tcl_AppendPrintfToObj(bufferObj, "%d ", opnd);
+ } else if (opnd == -2) {
+ Tcl_AppendPrintfToObj(bufferObj, "end ");
+ } else {
+ Tcl_AppendPrintfToObj(bufferObj, "end-%d ", -2-opnd);
+ }
+ break;
+ case OPERAND_LVT1:
+ opnd = TclGetUInt1AtPtr(pc+numBytes);
+ numBytes++;
+ goto printLVTindex;
+ case OPERAND_LVT4:
+ opnd = TclGetUInt4AtPtr(pc+numBytes);
+ numBytes += 4;
+ printLVTindex:
+ if (localPtr != NULL) {
+ if (opnd >= localCt) {
+ Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)",
+ (unsigned) opnd, localCt);
+ }
+ for (j = 0; j < opnd; j++) {
+ localPtr = localPtr->nextPtr;
+ }
+ if (TclIsVarTemporary(localPtr)) {
+ sprintf(suffixBuffer, "temp var %u", (unsigned) opnd);
+ } else {
+ sprintf(suffixBuffer, "var ");
+ suffixSrc = localPtr->name;
+ }
+ }
+ 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;
+ }
+ }
+ if (suffixObj) {
+ const char *bytes;
+ int length;
+
+ Tcl_AppendToObj(bufferObj, "\t# ", -1);
+ bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length);
+ PrintSourceToObj(bufferObj, bytes, TclMin(length, 40));
+ } else if (suffixBuffer[0]) {
+ Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer);
+ if (suffixSrc) {
+ PrintSourceToObj(bufferObj, suffixSrc, 40);
+ }
+ }
+ Tcl_AppendToObj(bufferObj, "\n", -1);
+ if (auxPtr && auxPtr->type->printProc) {
+ Tcl_AppendToObj(bufferObj, "\t\t[", -1);
+ auxPtr->type->printProc(auxPtr->clientData, bufferObj, codePtr,
+ pcOffset);
+ Tcl_AppendToObj(bufferObj, "]\n", -1);
+ }
+ return numBytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetInnerContext --
+ *
+ * If possible, returns a list capturing the inner context. Otherwise
+ * return NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclGetInnerContext(
+ Tcl_Interp *interp,
+ const unsigned char *pc,
+ Tcl_Obj **tosPtr)
+{
+ int objc = 0, off = 0;
+ Tcl_Obj *result;
+ Interp *iPtr = (Interp *) interp;
+
+ switch (*pc) {
+ case INST_STR_LEN:
+ case INST_LNOT:
+ case INST_BITNOT:
+ case INST_UMINUS:
+ case INST_UPLUS:
+ case INST_TRY_CVT_TO_NUMERIC:
+ case INST_EXPAND_STKTOP:
+ case INST_EXPR_STK:
+ objc = 1;
+ break;
+
+ case INST_LIST_IN:
+ case INST_LIST_NOT_IN: /* Basic list containment operators. */
+ case INST_STR_EQ:
+ case INST_STR_NEQ: /* String (in)equality check */
+ case INST_STR_CMP: /* String compare. */
+ case INST_STR_INDEX:
+ case INST_STR_MATCH:
+ case INST_REGEXP:
+ case INST_EQ:
+ case INST_NEQ:
+ case INST_LT:
+ case INST_GT:
+ case INST_LE:
+ 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:
+ objc = 2;
+ break;
+
+ case INST_RETURN_STK:
+ /* early pop. TODO: dig out opt dict too :/ */
+ objc = 1;
+ break;
+
+ case INST_SYNTAX:
+ case INST_RETURN_IMM:
+ objc = 2;
+ break;
+
+ case INST_INVOKE_STK4:
+ objc = TclGetUInt4AtPtr(pc+1);
+ break;
+
+ case INST_INVOKE_STK1:
+ objc = TclGetUInt1AtPtr(pc+1);
+ break;
+ }
+
+ result = iPtr->innerContext;
+ if (Tcl_IsShared(result)) {
+ Tcl_DecrRefCount(result);
+ iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL);
+ Tcl_IncrRefCount(result);
+ } else {
+ int len;
+
+ /*
+ * Reset while keeping the list intrep as much as possible.
+ */
+
+ Tcl_ListObjLength(interp, result, &len);
+ Tcl_ListObjReplace(interp, result, 0, len, 0, NULL);
+ }
+ Tcl_ListObjAppendElement(NULL, result, TclNewInstNameObj(*pc));
+
+ for (; objc>0 ; objc--) {
+ Tcl_Obj *objPtr;
+
+ objPtr = tosPtr[1 - objc + off];
+ if (!objPtr) {
+ Tcl_Panic("InnerContext: bad tos -- appending null object");
+ }
+ if ((objPtr->refCount<=0)
+#ifdef TCL_MEM_DEBUG
+ || (objPtr->refCount==0x61616161)
+#endif
+ ) {
+ Tcl_Panic("InnerContext: bad tos -- appending freed object %p",
+ objPtr);
+ }
+ Tcl_ListObjAppendElement(NULL, result, objPtr);
+ }
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNewInstNameObj --
+ *
+ * Creates a new InstName Tcl_Obj based on the given instruction
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclNewInstNameObj(
+ unsigned char inst)
+{
+ Tcl_Obj *objPtr = Tcl_NewObj();
+
+ objPtr->typePtr = &tclInstNameType;
+ objPtr->internalRep.longValue = (long) inst;
+ objPtr->bytes = NULL;
+
+ return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfInstName --
+ *
+ * Update the string representation for an instruction name object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfInstName(
+ Tcl_Obj *objPtr)
+{
+ int inst = objPtr->internalRep.longValue;
+ char *s, buf[20];
+ int len;
+
+ if ((inst < 0) || (inst > LAST_INST_OPCODE)) {
+ sprintf(buf, "inst_%d", inst);
+ s = buf;
+ } else {
+ s = (char *) tclInstructionTable[objPtr->internalRep.longValue].name;
+ }
+ len = strlen(s);
+ objPtr->bytes = ckalloc(len + 1);
+ memcpy(objPtr->bytes, s, len + 1);
+ objPtr->length = len;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PrintSourceToObj --
+ *
+ * Appends a quoted representation of a string to a Tcl_Obj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PrintSourceToObj(
+ Tcl_Obj *appendObj, /* The object to print the source to. */
+ const char *stringPtr, /* The string to print. */
+ int maxChars) /* Maximum number of chars to print. */
+{
+ register const char *p;
+ register int i = 0, len;
+ Tcl_UniChar ch = 0;
+
+ if (stringPtr == NULL) {
+ Tcl_AppendToObj(appendObj, "\"\"", -1);
+ return;
+ }
+
+ Tcl_AppendToObj(appendObj, "\"", -1);
+ p = stringPtr;
+ for (; (*p != '\0') && (i < maxChars); p+=len) {
+
+ 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:
+#if TCL_UTF_MAX > 4
+ if (ch > 0xffff) {
+ Tcl_AppendPrintfToObj(appendObj, "\\U%08x", ch);
+ i += 10;
+ } else
+#elif TCL_UTF_MAX > 3
+ /* If len == 0, this means we have a char > 0xffff, resulting in
+ * TclUtfToUniChar producing a surrogate pair. We want to output
+ * this pair as a single Unicode character.
+ */
+ if (len == 0) {
+ int upper = ((ch & 0x3ff) + 1) << 10;
+ len = TclUtfToUniChar(p, &ch);
+ Tcl_AppendPrintfToObj(appendObj, "\\U%08x", upper + (ch & 0x3ff));
+ i += 10;
+ } else
+#endif
+ if (ch < 0x20 || ch >= 0x7f) {
+ Tcl_AppendPrintfToObj(appendObj, "\\u%04x", ch);
+ i += 6;
+ } else {
+ Tcl_AppendPrintfToObj(appendObj, "%c", ch);
+ i++;
+ }
+ continue;
+ }
+ }
+ if (*p != '\0') {
+ Tcl_AppendToObj(appendObj, "...", -1);
+ }
+ Tcl_AppendToObj(appendObj, "\"", -1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisassembleByteCodeAsDicts --
+ *
+ * Given an object which is of bytecode type, return a disassembled
+ * version of the bytecode (in a new refcount 0 object) in a dictionary.
+ * No guarantees are made about the details of the contents of the
+ * result, but it is intended to be more readable than the old output
+ * format.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+DisassembleByteCodeAsDicts(
+ Tcl_Interp *interp, /* Used for looking up the CmdFrame for the
+ * procedure, if one exists. */
+ Tcl_Obj *objPtr) /* The bytecode-holding value to take apart */
+{
+ ByteCode *codePtr = BYTECODE(objPtr);
+ Tcl_Obj *description, *literals, *variables, *instructions, *inst;
+ Tcl_Obj *aux, *exn, *commands, *file;
+ unsigned char *pc, *opnd, *codeOffPtr, *codeLenPtr, *srcOffPtr, *srcLenPtr;
+ int codeOffset, codeLength, sourceOffset, sourceLength;
+ int i, val, line;
+
+ /*
+ * Get the literals from the bytecode.
+ */
+
+ literals = Tcl_NewObj();
+ for (i=0 ; i<codePtr->numLitObjects ; i++) {
+ Tcl_ListObjAppendElement(NULL, literals, codePtr->objArrayPtr[i]);
+ }
+
+ /*
+ * Get the variables from the bytecode.
+ */
+
+ variables = Tcl_NewObj();
+ if (codePtr->procPtr) {
+ int localCount = codePtr->procPtr->numCompiledLocals;
+ CompiledLocal *localPtr = codePtr->procPtr->firstLocalPtr;
+
+ for (i=0 ; i<localCount ; i++,localPtr=localPtr->nextPtr) {
+ Tcl_Obj *descriptor[2];
+
+ descriptor[0] = Tcl_NewObj();
+ if (!(localPtr->flags & (VAR_ARRAY|VAR_LINK))) {
+ Tcl_ListObjAppendElement(NULL, descriptor[0],
+ Tcl_NewStringObj("scalar", -1));
+ }
+ if (localPtr->flags & VAR_ARRAY) {
+ Tcl_ListObjAppendElement(NULL, descriptor[0],
+ Tcl_NewStringObj("array", -1));
+ }
+ if (localPtr->flags & VAR_LINK) {
+ Tcl_ListObjAppendElement(NULL, descriptor[0],
+ Tcl_NewStringObj("link", -1));
+ }
+ if (localPtr->flags & VAR_ARGUMENT) {
+ Tcl_ListObjAppendElement(NULL, descriptor[0],
+ Tcl_NewStringObj("arg", -1));
+ }
+ if (localPtr->flags & VAR_TEMPORARY) {
+ Tcl_ListObjAppendElement(NULL, descriptor[0],
+ Tcl_NewStringObj("temp", -1));
+ }
+ if (localPtr->flags & VAR_RESOLVED) {
+ Tcl_ListObjAppendElement(NULL, descriptor[0],
+ Tcl_NewStringObj("resolved", -1));
+ }
+ if (localPtr->flags & VAR_TEMPORARY) {
+ Tcl_ListObjAppendElement(NULL, variables,
+ Tcl_NewListObj(1, descriptor));
+ } else {
+ descriptor[1] = Tcl_NewStringObj(localPtr->name, -1);
+ Tcl_ListObjAppendElement(NULL, variables,
+ Tcl_NewListObj(2, descriptor));
+ }
+ }
+ }
+
+ /*
+ * Get the instructions from the bytecode.
+ */
+
+ instructions = Tcl_NewObj();
+ for (pc=codePtr->codeStart; pc<codePtr->codeStart+codePtr->numCodeBytes;){
+ const InstructionDesc *instDesc = &tclInstructionTable[*pc];
+ int address = pc - codePtr->codeStart;
+
+ inst = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, inst, Tcl_NewStringObj(
+ instDesc->name, -1));
+ opnd = pc + 1;
+ for (i=0 ; i<instDesc->numOperands ; i++) {
+ switch (instDesc->opTypes[i]) {
+ case OPERAND_INT1:
+ val = TclGetInt1AtPtr(opnd);
+ opnd += 1;
+ goto formatNumber;
+ case OPERAND_UINT1:
+ val = TclGetUInt1AtPtr(opnd);
+ opnd += 1;
+ goto formatNumber;
+ case OPERAND_INT4:
+ val = TclGetInt4AtPtr(opnd);
+ opnd += 4;
+ goto formatNumber;
+ case OPERAND_UINT4:
+ val = TclGetUInt4AtPtr(opnd);
+ opnd += 4;
+ formatNumber:
+ Tcl_ListObjAppendElement(NULL, inst, Tcl_NewIntObj(val));
+ break;
+
+ case OPERAND_OFFSET1:
+ val = TclGetInt1AtPtr(opnd);
+ opnd += 1;
+ goto formatAddress;
+ case OPERAND_OFFSET4:
+ val = TclGetInt4AtPtr(opnd);
+ opnd += 4;
+ formatAddress:
+ Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
+ "pc %d", address + val));
+ break;
+
+ case OPERAND_LIT1:
+ val = TclGetUInt1AtPtr(opnd);
+ opnd += 1;
+ goto formatLiteral;
+ case OPERAND_LIT4:
+ val = TclGetUInt4AtPtr(opnd);
+ opnd += 4;
+ formatLiteral:
+ Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
+ "@%d", val));
+ break;
+
+ case OPERAND_LVT1:
+ val = TclGetUInt1AtPtr(opnd);
+ opnd += 1;
+ goto formatVariable;
+ case OPERAND_LVT4:
+ val = TclGetUInt4AtPtr(opnd);
+ opnd += 4;
+ formatVariable:
+ Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
+ "%%%d", val));
+ break;
+ case OPERAND_IDX4:
+ val = TclGetInt4AtPtr(opnd);
+ opnd += 4;
+ if (val >= -1) {
+ Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
+ ".%d", val));
+ } else if (val == -2) {
+ Tcl_ListObjAppendElement(NULL, inst, Tcl_NewStringObj(
+ ".end", -1));
+ } else {
+ Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
+ ".end-%d", -2-val));
+ }
+ break;
+ case OPERAND_AUX4:
+ val = TclGetInt4AtPtr(opnd);
+ opnd += 4;
+ Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
+ "?%d", val));
+ break;
+ case OPERAND_SCLS1:
+ val = TclGetUInt1AtPtr(opnd);
+ opnd++;
+ Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
+ "=%s", tclStringClassTable[val].name));
+ break;
+ case OPERAND_NONE:
+ Tcl_Panic("opcode %d with more than zero 'no' operands", *pc);
+ }
+ }
+ Tcl_DictObjPut(NULL, instructions, Tcl_NewIntObj(address), inst);
+ pc += instDesc->numBytes;
+ }
+
+ /*
+ * Get the auxiliary data from the bytecode.
+ */
+
+ aux = Tcl_NewObj();
+ for (i=0 ; i<codePtr->numAuxDataItems ; i++) {
+ AuxData *auxData = &codePtr->auxDataArrayPtr[i];
+ Tcl_Obj *auxDesc = Tcl_NewStringObj(auxData->type->name, -1);
+
+ if (auxData->type->disassembleProc) {
+ Tcl_Obj *desc = Tcl_NewObj();
+
+ Tcl_DictObjPut(NULL, desc, Tcl_NewStringObj("name", -1), auxDesc);
+ auxDesc = desc;
+ auxData->type->disassembleProc(auxData->clientData, auxDesc,
+ codePtr, 0);
+ } else if (auxData->type->printProc) {
+ Tcl_Obj *desc = Tcl_NewObj();
+
+ auxData->type->printProc(auxData->clientData, desc, codePtr, 0);
+ Tcl_ListObjAppendElement(NULL, auxDesc, desc);
+ }
+ Tcl_ListObjAppendElement(NULL, aux, auxDesc);
+ }
+
+ /*
+ * Get the exception ranges from the bytecode.
+ */
+
+ exn = Tcl_NewObj();
+ for (i=0 ; i<codePtr->numExceptRanges ; i++) {
+ ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];
+
+ switch (rangePtr->type) {
+ case LOOP_EXCEPTION_RANGE:
+ Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
+ "type %s level %d from %d to %d break %d continue %d",
+ "loop", rangePtr->nestingLevel, rangePtr->codeOffset,
+ rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
+ rangePtr->breakOffset, rangePtr->continueOffset));
+ break;
+ case CATCH_EXCEPTION_RANGE:
+ Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
+ "type %s level %d from %d to %d catch %d",
+ "catch", rangePtr->nestingLevel, rangePtr->codeOffset,
+ rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
+ rangePtr->catchOffset));
+ break;
+ }
+ }
+
+ /*
+ * Get the command information from the bytecode.
+ *
+ * The way these are encoded in the bytecode is non-trivial; the Decode
+ * macro (which updates its argument and returns the next decoded value)
+ * handles this so that the rest of the code does not.
+ */
+
+#define Decode(ptr) \
+ ((TclGetUInt1AtPtr(ptr) == 0xFF) \
+ ? ((ptr)+=5 , TclGetInt4AtPtr((ptr)-4)) \
+ : ((ptr)+=1 , TclGetInt1AtPtr((ptr)-1)))
+
+ commands = Tcl_NewObj();
+ codeOffPtr = codePtr->codeDeltaStart;
+ codeLenPtr = codePtr->codeLengthStart;
+ srcOffPtr = codePtr->srcDeltaStart;
+ srcLenPtr = codePtr->srcLengthStart;
+ codeOffset = sourceOffset = 0;
+ for (i=0 ; i<codePtr->numCommands ; i++) {
+ Tcl_Obj *cmd;
+
+ codeOffset += Decode(codeOffPtr);
+ codeLength = Decode(codeLenPtr);
+ sourceOffset += Decode(srcOffPtr);
+ sourceLength = Decode(srcLenPtr);
+ cmd = Tcl_NewObj();
+ Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codefrom", -1),
+ Tcl_NewIntObj(codeOffset));
+ Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codeto", -1),
+ Tcl_NewIntObj(codeOffset + codeLength - 1));
+
+ /*
+ * Convert byte offsets to character offsets; important if multibyte
+ * characters are present in the source!
+ */
+
+ Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("scriptfrom", -1),
+ Tcl_NewIntObj(Tcl_NumUtfChars(codePtr->source,
+ sourceOffset)));
+ Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("scriptto", -1),
+ Tcl_NewIntObj(Tcl_NumUtfChars(codePtr->source,
+ sourceOffset + sourceLength - 1)));
+ Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("script", -1),
+ Tcl_NewStringObj(codePtr->source+sourceOffset, sourceLength));
+ Tcl_ListObjAppendElement(NULL, commands, cmd);
+ }
+
+#undef Decode
+
+ /*
+ * Get the source file and line number information from the CmdFrame
+ * system if it is available.
+ */
+
+ GetLocationInformation(interp, codePtr->procPtr, &file, &line);
+
+ /*
+ * Build the overall result.
+ */
+
+ description = Tcl_NewObj();
+ Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("literals", -1),
+ literals);
+ Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("variables", -1),
+ variables);
+ Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("exception", -1), exn);
+ Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("instructions", -1),
+ instructions);
+ Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("auxiliary", -1), aux);
+ Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("commands", -1),
+ commands);
+ Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("script", -1),
+ Tcl_NewStringObj(codePtr->source, codePtr->numSrcBytes));
+ Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("namespace", -1),
+ Tcl_NewStringObj(codePtr->nsPtr->fullName, -1));
+ Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("stackdepth", -1),
+ Tcl_NewIntObj(codePtr->maxStackDepth));
+ Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("exceptdepth", -1),
+ Tcl_NewIntObj(codePtr->maxExceptDepth));
+ if (line > -1) {
+ Tcl_DictObjPut(NULL, description,
+ Tcl_NewStringObj("initiallinenumber", -1),
+ Tcl_NewIntObj(line));
+ }
+ if (file) {
+ Tcl_DictObjPut(NULL, description,
+ Tcl_NewStringObj("sourcefile", -1), file);
+ }
+ return description;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DisassembleObjCmd --
+ *
+ * Implementation of the "::tcl::unsupported::disassemble" command. This
+ * command is not documented, but will disassemble procedures, lambda
+ * terms and general scripts. Note that will compile terms if necessary
+ * in order to disassemble them.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_DisassembleObjCmd(
+ ClientData clientData, /* What type of operation. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ static const char *const types[] = {
+ "lambda", "method", "objmethod", "proc", "script", NULL
+ };
+ enum Types {
+ DISAS_LAMBDA, DISAS_CLASS_METHOD, DISAS_OBJECT_METHOD, DISAS_PROC,
+ DISAS_SCRIPT
+ };
+ int idx, result;
+ Tcl_Obj *codeObjPtr = NULL;
+ Proc *procPtr = NULL;
+ Tcl_HashEntry *hPtr;
+ Object *oPtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "type ...");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], types, "type", 0, &idx)!=TCL_OK){
+ return TCL_ERROR;
+ }
+
+ switch ((enum Types) idx) {
+ case DISAS_LAMBDA: {
+ Command cmd;
+ Tcl_Obj *nsObjPtr;
+ Tcl_Namespace *nsPtr;
+
+ /*
+ * Compile (if uncompiled) and disassemble a lambda term.
+ *
+ * WARNING! Pokes inside the lambda objtype.
+ */
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "lambdaTerm");
+ return TCL_ERROR;
+ }
+ if (objv[2]->typePtr == &tclLambdaType) {
+ procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
+ }
+ if (procPtr == NULL || procPtr->iPtr != (Interp *) interp) {
+ result = tclLambdaType.setFromAnyProc(interp, objv[2]);
+ if (result != TCL_OK) {
+ return result;
+ }
+ procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
+ }
+
+ memset(&cmd, 0, sizeof(Command));
+ nsObjPtr = objv[2]->internalRep.twoPtrValue.ptr2;
+ result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ cmd.nsPtr = (Namespace *) nsPtr;
+ procPtr->cmdPtr = &cmd;
+ result = TclPushProcCallFrame(procPtr, interp, objc, objv, 1);
+ if (result != TCL_OK) {
+ return result;
+ }
+ TclPopStackFrame(interp);
+ codeObjPtr = procPtr->bodyPtr;
+ break;
+ }
+ case DISAS_PROC:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "procName");
+ return TCL_ERROR;
+ }
+
+ procPtr = TclFindProc((Interp *) interp, TclGetString(objv[2]));
+ if (procPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't a procedure", TclGetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROC",
+ TclGetString(objv[2]), NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Compile (if uncompiled) and disassemble a procedure.
+ */
+
+ result = TclPushProcCallFrame(procPtr, interp, 2, objv+1, 1);
+ if (result != TCL_OK) {
+ return result;
+ }
+ TclPopStackFrame(interp);
+ codeObjPtr = procPtr->bodyPtr;
+ break;
+ case DISAS_SCRIPT:
+ /*
+ * Compile and disassemble a script.
+ */
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "script");
+ return TCL_ERROR;
+ }
+ if ((objv[2]->typePtr != &tclByteCodeType)
+ && (TclSetByteCodeFromAny(interp, objv[2], NULL, NULL) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ codeObjPtr = objv[2];
+ break;
+
+ case DISAS_CLASS_METHOD:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "className methodName");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look up the body of a class method.
+ */
+
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (oPtr->classPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" is not a class", TclGetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
+ TclGetString(objv[2]), NULL);
+ return TCL_ERROR;
+ }
+ hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods,
+ (char *) objv[3]);
+ goto methodBody;
+ case DISAS_OBJECT_METHOD:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "objectName methodName");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look up the body of an instance method.
+ */
+
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (oPtr->methodsPtr == NULL) {
+ goto unknownMethod;
+ }
+ hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[3]);
+
+ /*
+ * Compile (if necessary) and disassemble a method body.
+ */
+
+ methodBody:
+ if (hPtr == NULL) {
+ unknownMethod:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown method \"%s\"", TclGetString(objv[3])));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+ TclGetString(objv[3]), NULL);
+ return TCL_ERROR;
+ }
+ procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
+ if (procPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "body not available for this kind of method", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+ "METHODTYPE", NULL);
+ return TCL_ERROR;
+ }
+ if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
+ Command cmd;
+
+ /*
+ * Yes, this is ugly, but we need to pass the namespace in to the
+ * compiler in two places.
+ */
+
+ cmd.nsPtr = (Namespace *) oPtr->namespacePtr;
+ procPtr->cmdPtr = &cmd;
+ result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr,
+ (Namespace *) oPtr->namespacePtr, "body of method",
+ TclGetString(objv[3]));
+ procPtr->cmdPtr = NULL;
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+ codeObjPtr = procPtr->bodyPtr;
+ break;
+ default:
+ CLANG_ASSERT(0);
+ }
+
+ /*
+ * Do the actual disassembly.
+ */
+
+ if (BYTECODE(codeObjPtr)->flags & TCL_BYTECODE_PRECOMPILED) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "may not disassemble prebuilt bytecode", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+ "BYTECODE", NULL);
+ return TCL_ERROR;
+ }
+ if (PTR2INT(clientData)) {
+ Tcl_SetObjResult(interp,
+ DisassembleByteCodeAsDicts(interp, codeObjPtr));
+ } else {
+ Tcl_SetObjResult(interp,
+ DisassembleByteCodeObj(interp, codeObjPtr));
+ }
+ return TCL_OK;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * tab-width: 8
+ * End:
+ */
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 2cc55d6..4edebcf 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -180,8 +180,9 @@ TCL_DECLARE_MUTEX(encodingMutex)
* the system encoding will be used to perform the conversion.
*/
-static Tcl_Encoding defaultEncoding;
-static Tcl_Encoding systemEncoding;
+static Tcl_Encoding defaultEncoding = NULL;
+static Tcl_Encoding systemEncoding = NULL;
+Tcl_Encoding tclIdentityEncoding = NULL;
/*
* The following variable is used in the sparse matrix code for a
@@ -567,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;
@@ -651,6 +652,10 @@ TclFinalizeEncodingSubsystem(void)
Tcl_MutexLock(&encodingMutex);
encodingsInitialized = 0;
FreeEncoding(systemEncoding);
+ systemEncoding = NULL;
+ defaultEncoding = NULL;
+ FreeEncoding(tclIdentityEncoding);
+ tclIdentityEncoding = NULL;
hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
while (hPtr != NULL) {
@@ -1201,7 +1206,10 @@ Tcl_ExternalToUtf(
* output buffer. */
{
const Encoding *encodingPtr;
- int result, srcRead, dstWrote, dstChars;
+ int result, srcRead, dstWrote, dstChars = 0;
+ int noTerminate = flags & TCL_ENCODING_NO_TERMINATE;
+ int charLimited = (flags & TCL_ENCODING_CHAR_LIMIT) && dstCharsPtr;
+ int maxChars = INT_MAX;
Tcl_EncodingState state;
if (encoding == NULL) {
@@ -1226,19 +1234,40 @@ Tcl_ExternalToUtf(
}
if (dstCharsPtr == NULL) {
dstCharsPtr = &dstChars;
+ flags &= ~TCL_ENCODING_CHAR_LIMIT;
+ } else if (charLimited) {
+ maxChars = *dstCharsPtr;
}
- /*
- * If there are any null characters in the middle of the buffer, they will
- * converted to the UTF-8 null character (\xC080). To get the actual \0 at
- * the end of the destination buffer, we need to append it manually.
- */
+ if (!noTerminate) {
+ /*
+ * If there are any null characters in the middle of the buffer,
+ * they will converted to the UTF-8 null character (\xC080). To get
+ * the actual \0 at the end of the destination buffer, we need to
+ * append it manually. First make room for it...
+ */
- dstLen--;
- result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
- flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
- dstCharsPtr);
- dst[*dstWrotePtr] = '\0';
+ dstLen--;
+ }
+ do {
+ int savedFlags = flags;
+ Tcl_EncodingState savedState = *statePtr;
+
+ result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
+ flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
+ dstCharsPtr);
+ if (*dstCharsPtr <= maxChars) {
+ break;
+ }
+ dstLen = Tcl_UtfAtIndex(dst, maxChars) - 1 - dst + TCL_UTF_MAX;
+ flags = savedFlags;
+ *statePtr = savedState;
+ } while (1);
+ if (!noTerminate) {
+ /* ...and then append it */
+
+ dst[*dstWrotePtr] = '\0';
+ }
return result;
}
@@ -1421,7 +1450,7 @@ Tcl_UtfToExternal(
*
* Side effects:
* The absolute pathname for the application is computed and stored to be
- * returned later be [info nameofexecutable].
+ * returned later by [info nameofexecutable].
*
*---------------------------------------------------------------------------
*/
@@ -2102,6 +2131,9 @@ BinaryProc(
if (dstLen < 0) {
dstLen = 0;
}
+ if ((flags & TCL_ENCODING_CHAR_LIMIT) && srcLen > *dstCharsPtr) {
+ srcLen = *dstCharsPtr;
+ }
if (srcLen > dstLen) {
srcLen = dstLen;
result = TCL_CONVERT_NOSPACE;
@@ -2262,7 +2294,7 @@ UtfToUtfProc(
{
const char *srcStart, *srcEnd, *srcClose;
const char *dstStart, *dstEnd;
- int result, numChars;
+ int result, numChars, charLimit = INT_MAX;
Tcl_UniChar ch;
result = TCL_OK;
@@ -2273,11 +2305,14 @@ UtfToUtfProc(
if ((flags & TCL_ENCODING_END) == 0) {
srcClose -= TCL_UTF_MAX;
}
+ if (flags & TCL_ENCODING_CHAR_LIMIT) {
+ charLimit = *dstCharsPtr;
+ }
dstStart = dst;
dstEnd = dst + dstLen - TCL_UTF_MAX;
- for (numChars = 0; src < srcEnd; numChars++) {
+ for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
/*
* If there is more string to follow, this will ensure that the
@@ -2299,7 +2334,7 @@ UtfToUtfProc(
*dst++ = *src++;
} else if (pureNullMode == 1 && UCHAR(*src) == 0xc0 &&
- UCHAR(*(src+1)) == 0x80) {
+ (src + 1 < srcEnd) && UCHAR(*(src+1)) == 0x80) {
/*
* Convert 0xc080 to real nulls when we are in output mode.
*/
@@ -2373,9 +2408,12 @@ UnicodeToUtfProc(
{
const char *srcStart, *srcEnd;
const char *dstEnd, *dstStart;
- int result, numChars;
+ int result, numChars, charLimit = INT_MAX;
Tcl_UniChar ch;
+ if (flags & TCL_ENCODING_CHAR_LIMIT) {
+ charLimit = *dstCharsPtr;
+ }
result = TCL_OK;
if ((srcLen % sizeof(Tcl_UniChar)) != 0) {
result = TCL_CONVERT_MULTIBYTE;
@@ -2389,7 +2427,7 @@ UnicodeToUtfProc(
dstStart = dst;
dstEnd = dst + dstLen - TCL_UTF_MAX;
- for (numChars = 0; src < srcEnd; numChars++) {
+ for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
if (dst > dstEnd) {
result = TCL_CONVERT_NOSPACE;
break;
@@ -2487,22 +2525,35 @@ UtfToUnicodeProc(
if (dst > dstEnd) {
result = TCL_CONVERT_NOSPACE;
break;
- }
+ }
src += TclUtfToUniChar(src, &ch);
/*
* Need to handle this in a way that won't cause misalignment by
* casting dst to a Tcl_UniChar. [Bug 1122671]
- * XXX: This hard-codes the assumed size of Tcl_UniChar as 2.
*/
#ifdef WORDS_BIGENDIAN
+#if TCL_UTF_MAX > 4
+ *dst++ = (ch >> 24);
+ *dst++ = ((ch >> 16) & 0xFF);
+ *dst++ = ((ch >> 8) & 0xFF);
+ *dst++ = (ch & 0xFF);
+#else
*dst++ = (ch >> 8);
*dst++ = (ch & 0xFF);
+#endif
+#else
+#if TCL_UTF_MAX > 4
+ *dst++ = (ch & 0xFF);
+ *dst++ = ((ch >> 8) & 0xFF);
+ *dst++ = ((ch >> 16) & 0xFF);
+ *dst++ = (ch >> 24);
#else
*dst++ = (ch & 0xFF);
*dst++ = (ch >> 8);
#endif
+#endif
}
*srcReadPtr = src - srcStart;
*dstWrotePtr = dst - dstStart;
@@ -2557,12 +2608,15 @@ TableToUtfProc(
{
const char *srcStart, *srcEnd;
const char *dstEnd, *dstStart, *prefixBytes;
- int result, byte, numChars;
+ int result, byte, numChars, charLimit = INT_MAX;
Tcl_UniChar ch;
const unsigned short *const *toUnicode;
const unsigned short *pageZero;
TableEncodingData *dataPtr = clientData;
+ if (flags & TCL_ENCODING_CHAR_LIMIT) {
+ charLimit = *dstCharsPtr;
+ }
srcStart = src;
srcEnd = src + srcLen;
@@ -2574,7 +2628,7 @@ TableToUtfProc(
pageZero = toUnicode[0];
result = TCL_OK;
- for (numChars = 0; src < srcEnd; numChars++) {
+ for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
if (dst > dstEnd) {
result = TCL_CONVERT_NOSPACE;
break;
@@ -2788,8 +2842,11 @@ Iso88591ToUtfProc(
{
const char *srcStart, *srcEnd;
const char *dstEnd, *dstStart;
- int result, numChars;
+ int result, numChars, charLimit = INT_MAX;
+ if (flags & TCL_ENCODING_CHAR_LIMIT) {
+ charLimit = *dstCharsPtr;
+ }
srcStart = src;
srcEnd = src + srcLen;
@@ -2797,7 +2854,7 @@ Iso88591ToUtfProc(
dstEnd = dst + dstLen - TCL_UTF_MAX;
result = TCL_OK;
- for (numChars = 0; src < srcEnd; numChars++) {
+ for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
Tcl_UniChar ch;
if (dst > dstEnd) {
@@ -2958,7 +3015,9 @@ TableFreeProc(
*/
ckfree(dataPtr->toUnicode);
+ dataPtr->toUnicode = NULL;
ckfree(dataPtr->fromUnicode);
+ dataPtr->fromUnicode = NULL;
ckfree(dataPtr);
}
@@ -3011,9 +3070,12 @@ EscapeToUtfProc(
const char *prefixBytes, *tablePrefixBytes, *srcStart, *srcEnd;
const unsigned short *const *tableToUnicode;
const Encoding *encodingPtr;
- int state, result, numChars;
+ int state, result, numChars, charLimit = INT_MAX;
const char *dstStart, *dstEnd;
+ if (flags & TCL_ENCODING_CHAR_LIMIT) {
+ charLimit = *dstCharsPtr;
+ }
result = TCL_OK;
tablePrefixBytes = NULL; /* lint. */
tableToUnicode = NULL; /* lint. */
@@ -3031,7 +3093,7 @@ EscapeToUtfProc(
state = 0;
}
- for (numChars = 0; src < srcEnd; ) {
+ for (numChars = 0; src < srcEnd && numChars <= charLimit; ) {
int byte, hi, lo, ch;
if (dst > dstEnd) {
@@ -3431,6 +3493,7 @@ EscapeFreeProc(
subTablePtr = dataPtr->subTables;
for (i = 0; i < dataPtr->numSubTables; i++) {
FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr);
+ subTablePtr->encodingPtr = NULL;
subTablePtr++;
}
}
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index ad11785..986a553 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -2749,15 +2749,9 @@ TclCompileEnsemble(
int ourResult = TCL_ERROR;
unsigned numBytes;
const char *word;
+ DefineLineInformation;
Tcl_IncrRefCount(replaced);
-
- /*
- * This is where we return to if we are parsing multiple nested compiled
- * ensembles. [info object] is such a beast.
- */
-
- checkNextWord:
if (parsePtr->numWords < depth + 1) {
goto failed;
}
@@ -2769,6 +2763,12 @@ TclCompileEnsemble(
goto failed;
}
+ /*
+ * This is where we return to if we are parsing multiple nested compiled
+ * ensembles. [info object] is such a beast.
+ */
+
+ checkNextWord:
word = tokenPtr[1].start;
numBytes = tokenPtr[1].size;
@@ -2979,6 +2979,17 @@ TclCompileEnsemble(
if (cmdPtr->compileProc == TclCompileEnsemble) {
tokenPtr = TokenAfter(tokenPtr);
+ if (parsePtr->numWords < depth + 1
+ || tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ /*
+ * Too hard because the user has done something unpleasant like
+ * omitting the sub-ensemble's command name or used a non-constant
+ * name for a sub-ensemble's command name; we respond by bailing
+ * out completely (this is a rare case). [Bug 6d2f249a01]
+ */
+
+ goto cleanup;
+ }
ensemble = (Tcl_Command) cmdPtr;
goto checkNextWord;
}
@@ -2998,6 +3009,23 @@ TclCompileEnsemble(
}
/*
+ * Throw out any line information generated by the failed compile attempt.
+ */
+
+ while (mapPtr->nuloc - 1 > eclIndex) {
+ mapPtr->nuloc--;
+ ckfree(mapPtr->loc[mapPtr->nuloc].line);
+ mapPtr->loc[mapPtr->nuloc].line = NULL;
+ }
+
+ /*
+ * Reset the index of next command. Toss out any from failed nested
+ * partial compiles.
+ */
+
+ envPtr->numCommands = mapPtr->nuloc;
+
+ /*
* Failed to do a full compile for some reason. Try to do a direct invoke
* instead of going through the ensemble lookup process again.
*/
@@ -3009,8 +3037,24 @@ TclCompileEnsemble(
cmdPtr = oldCmdPtr;
depth--;
}
- (void) Tcl_ListObjReplace(NULL, replaced, depth, 2, 0, NULL);
}
+ /*
+ * The length of the "replaced" list must be depth-1. Trim back
+ * any extra elements that might have been appended by failing
+ * pathways above.
+ */
+ (void) Tcl_ListObjReplace(NULL, replaced, depth-1, INT_MAX, 0, NULL);
+
+ /*
+ * TODO: Reconsider whether we ought to call CompileToInvokedCommand()
+ * when depth==1. In that case we are choosing to emit the
+ * INST_INVOKE_REPLACE bytecode when there is in fact no replacing
+ * to be done. It would be equally functional and presumably more
+ * performant to fall through to cleanup below, return TCL_ERROR,
+ * and let the compiler harness emit the INST_INVOKE_STK
+ * implementation for us.
+ */
+
CompileToInvokedCommand(interp, parsePtr, replaced, cmdPtr, envPtr);
ourResult = TCL_OK;
}
@@ -3038,6 +3082,11 @@ TclAttemptCompileProc(
Tcl_Token *saveTokenPtr = parsePtr->tokenPtr;
int savedStackDepth = envPtr->currStackDepth;
unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart;
+ int savedAuxDataArrayNext = envPtr->auxDataArrayNext;
+ int savedExceptArrayNext = envPtr->exceptArrayNext;
+#ifdef TCL_COMPILE_DEBUG
+ int savedExceptDepth = envPtr->exceptDepth;
+#endif
DefineLineInformation;
if (cmdPtr->compileProc == NULL) {
@@ -3071,7 +3120,7 @@ TclAttemptCompileProc(
result = cmdPtr->compileProc(interp, parsePtr, cmdPtr, envPtr);
/*
- * Undo the shift.
+ * Undo the shift.
*/
mapPtr->loc[eclIndex].line -= (depth - 1);
@@ -3086,7 +3135,45 @@ TclAttemptCompileProc(
* we avoid compiling subcommands that recursively call TclCompileScript().
*/
+#ifdef TCL_COMPILE_DEBUG
+ if (envPtr->exceptDepth != savedExceptDepth) {
+ Tcl_Panic("ExceptionRange Starts and Ends do not balance");
+ }
+#endif
+
if (result != TCL_OK) {
+ ExceptionAux *auxPtr = envPtr->exceptAuxArrayPtr;
+
+ for (i = 0; i < savedExceptArrayNext; i++) {
+ while (auxPtr->numBreakTargets > 0
+ && auxPtr->breakTargets[auxPtr->numBreakTargets - 1]
+ >= savedCodeNext) {
+ auxPtr->numBreakTargets--;
+ }
+ while (auxPtr->numContinueTargets > 0
+ && auxPtr->continueTargets[auxPtr->numContinueTargets - 1]
+ >= savedCodeNext) {
+ auxPtr->numContinueTargets--;
+ }
+ auxPtr++;
+ }
+ envPtr->exceptArrayNext = savedExceptArrayNext;
+
+ if (savedAuxDataArrayNext != envPtr->auxDataArrayNext) {
+ AuxData *auxDataPtr = envPtr->auxDataArrayPtr;
+ AuxData *auxDataEnd = auxDataPtr;
+
+ auxDataPtr += savedAuxDataArrayNext;
+ auxDataEnd += envPtr->auxDataArrayNext;
+
+ while (auxDataPtr < auxDataEnd) {
+ if (auxDataPtr->type->freeProc != NULL) {
+ auxDataPtr->type->freeProc(auxDataPtr->clientData);
+ }
+ auxDataPtr++;
+ }
+ envPtr->auxDataArrayNext = savedAuxDataArrayNext;
+ }
envPtr->currStackDepth = savedStackDepth;
envPtr->codeNext = envPtr->codeStart + savedCodeNext;
#ifdef TCL_COMPILE_DEBUG
@@ -3179,9 +3266,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);
}
/*
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index b5ae6ea..66ddb57 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -43,11 +43,6 @@ static char * EnvTraceProc(ClientData clientData, Tcl_Interp *interp,
static void ReplaceString(const char *oldStr, char *newStr);
MODULE_SCOPE void TclSetEnv(const char *name, const char *value);
MODULE_SCOPE void TclUnsetEnv(const char *name);
-
-#if defined(__CYGWIN__)
- static void TclCygwinPutenv(char *string);
-# define putenv TclCygwinPutenv
-#endif
/*
*----------------------------------------------------------------------
@@ -76,36 +71,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 +134,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 +439,7 @@ TclUnsetEnv(
* that no = should be included, and Windows requires it.
*/
-#if defined(__WIN32__) || defined(__CYGWIN__)
+#if defined(_WIN32)
string = ckalloc(length + 2);
memcpy(string, name, (size_t) length);
string[length] = '=';
@@ -404,7 +448,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);
@@ -507,7 +551,8 @@ TclGetEnv(
* array.
*
* Results:
- * Always returns NULL to indicate success.
+ * Returns NULL to indicate success, or an error-message if the array
+ * element being handled doesn't exist.
*
* Side effects:
* Environment variable changes get propagated. If the whole "env" array
@@ -690,98 +735,6 @@ TclFinalizeEnvironment(void)
}
}
-#if defined(__CYGWIN__)
-
-/*
- * When using cygwin, when an environment variable changes, we need to synch
- * with both the cygwin environment (in case the application C code calls
- * fork) and the Windows environment (in case the application TCL code calls
- * exec, which calls the Windows CreateProcess function).
- */
-DLLIMPORT extern void __stdcall SetEnvironmentVariableA(const char*, const char *);
-
-static void
-TclCygwinPutenv(
- char *str)
-{
- char *name, *value;
-
- /*
- * Get the name and value, so that we can change the environment variable
- * for Windows.
- */
-
- name = alloca(strlen(str) + 1);
- strcpy(name, str);
- for (value=name ; *value!='=' && *value!='\0' ; ++value) {
- /* Empty body */
- }
- if (*value == '\0') {
- /* Can't happen. */
- return;
- }
- *(value++) = '\0';
- if (*value == '\0') {
- value = NULL;
- }
-
- /*
- * Set the cygwin environment variable.
- */
-
-#undef putenv
- if (value == NULL) {
- unsetenv(name);
- } else {
- putenv(str);
- }
-
- /*
- * Before changing the environment variable in Windows, if this is PATH,
- * we need to convert the value back to a Windows style path.
- *
- * FIXME: The calling program may know it is running under windows, and
- * may have set the path to a Windows path, or, worse, appended or
- * prepended a Windows path to PATH.
- */
-
- if (strcmp(name, "PATH") != 0) {
- /*
- * If this is Path, eliminate any PATH variable, to prevent any
- * confusion.
- */
-
- if (strcmp(name, "Path") == 0) {
- SetEnvironmentVariableA("PATH", NULL);
- unsetenv("PATH");
- }
-
- SetEnvironmentVariableA(name, value);
- } else {
- char *buf;
-
- /*
- * Eliminate any Path variable, to prevent any confusion.
- */
-
- SetEnvironmentVariableA("Path", NULL);
- unsetenv("Path");
-
- if (value == NULL) {
- buf = NULL;
- } else {
- int size;
-
- size = cygwin_conv_path_list(0, value, NULL, 0);
- buf = alloca(size + 1);
- cygwin_conv_path_list(0, value, buf, size);
- }
-
- SetEnvironmentVariableA(name, buf);
- }
-}
-#endif /* __CYGWIN__ */
-
/*
* Local Variables:
* mode: c
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 906ecbb..b0b8188 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -89,7 +89,7 @@ static int subsystemsInitialized = 0;
* non-NULL value.
*/
-static Tcl_ExitProc *appExitPtr = NULL;
+static TCL_NORETURN1 Tcl_ExitProc *appExitPtr = NULL;
typedef struct ThreadSpecificData {
ExitHandler *firstExitPtr; /* First in list of all exit handlers for this
@@ -119,6 +119,7 @@ static char * VwaitVarProc(ClientData clientData,
Tcl_Interp *interp, const char *name1,
const char *name2, int flags);
static void InvokeExitHandlers(void);
+static void FinalizeThread(int quick);
/*
*----------------------------------------------------------------------
@@ -262,7 +263,7 @@ HandleBgErrors(
if (errChannel != NULL) {
Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
- Tcl_Obj *keyPtr, *valuePtr;
+ Tcl_Obj *keyPtr, *valuePtr = NULL;
TclNewLiteralStringObj(keyPtr, "-errorinfo");
Tcl_IncrRefCount(keyPtr);
@@ -314,7 +315,7 @@ TclDefaultBgErrorHandlerObjCmd(
{
Tcl_Obj *keyPtr, *valuePtr;
Tcl_Obj *tempObjv[2];
- int code, level;
+ int result, code, level;
Tcl_InterpState saved;
if (objc != 3) {
@@ -328,9 +329,9 @@ TclDefaultBgErrorHandlerObjCmd(
TclNewLiteralStringObj(keyPtr, "-level");
Tcl_IncrRefCount(keyPtr);
- Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
+ result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
Tcl_DecrRefCount(keyPtr);
- if (valuePtr == NULL) {
+ if (result != TCL_OK || valuePtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing return option \"-level\"", -1));
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
@@ -341,9 +342,9 @@ TclDefaultBgErrorHandlerObjCmd(
}
TclNewLiteralStringObj(keyPtr, "-code");
Tcl_IncrRefCount(keyPtr);
- Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
+ result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
Tcl_DecrRefCount(keyPtr);
- if (valuePtr == NULL) {
+ if (result != TCL_OK || valuePtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing return option \"-code\"", -1));
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
@@ -406,17 +407,17 @@ TclDefaultBgErrorHandlerObjCmd(
TclNewLiteralStringObj(keyPtr, "-errorcode");
Tcl_IncrRefCount(keyPtr);
- Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
+ result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
Tcl_DecrRefCount(keyPtr);
- if (valuePtr) {
+ if (result == TCL_OK && valuePtr != NULL) {
Tcl_SetObjErrorCode(interp, valuePtr);
}
TclNewLiteralStringObj(keyPtr, "-errorinfo");
Tcl_IncrRefCount(keyPtr);
- Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
+ result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
Tcl_DecrRefCount(keyPtr);
- if (valuePtr) {
+ if (result == TCL_OK && valuePtr != NULL) {
Tcl_AppendObjToErrorInfo(interp, valuePtr);
}
@@ -856,7 +857,7 @@ Tcl_DeleteThreadExitHandler(
Tcl_ExitProc *
Tcl_SetExitProc(
- Tcl_ExitProc *proc) /* New exit handler for app or NULL */
+ TCL_NORETURN1 Tcl_ExitProc *proc) /* New exit handler for app or NULL */
{
Tcl_ExitProc *prevExitProc;
@@ -891,7 +892,7 @@ Tcl_SetExitProc(
*----------------------------------------------------------------------
*/
static void
-InvokeExitHandlers(void)
+InvokeExitHandlers(void)
{
ExitHandler *exitPtr;
@@ -932,12 +933,12 @@ InvokeExitHandlers(void)
*----------------------------------------------------------------------
*/
-void
+TCL_NORETURN void
Tcl_Exit(
int status) /* Exit status for application; typically 0
* for normal return, 1 for error return. */
{
- Tcl_ExitProc *currentAppExitPtr;
+ TCL_NORETURN1 Tcl_ExitProc *currentAppExitPtr;
Tcl_MutexLock(&exitMutex);
currentAppExitPtr = appExitPtr;
@@ -967,23 +968,23 @@ Tcl_Exit(
/*
* Fast and deterministic exit (default behavior)
*/
-
+
InvokeExitHandlers();
-
+
/*
* Ensure the thread-specific data is initialised as it is used in
* Tcl_FinalizeThread()
*/
-
+
(void) TCL_TSD_INIT(&dataKey);
-
+
/*
* Now finalize the calling thread only (others are not safely
* reachable). Among other things, this triggers a flush of the
* Tcl_Channels that may have data enqueued.
*/
-
- Tcl_FinalizeThread();
+
+ FinalizeThread(/* quick */ 1);
}
TclpExit(status);
Tcl_Panic("OS exit failed!");
@@ -1089,7 +1090,7 @@ Tcl_Finalize(void)
* Invoke exit handlers first.
*/
- InvokeExitHandlers();
+ InvokeExitHandlers();
TclpInitLock();
if (subsystemsInitialized == 0) {
@@ -1171,8 +1172,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
@@ -1185,7 +1184,7 @@ Tcl_Finalize(void)
* This fixes the Tcl Bug #990552.
*/
- TclFinalizeThreadData();
+ TclFinalizeThreadData(/* quick */ 0);
/*
* Now we can free constants for conversions to/from double.
@@ -1271,6 +1270,13 @@ Tcl_Finalize(void)
void
Tcl_FinalizeThread(void)
{
+ FinalizeThread(/* quick */ 0);
+}
+
+void
+FinalizeThread(
+ int quick)
+{
ExitHandler *exitPtr;
ThreadSpecificData *tsdPtr;
@@ -1311,8 +1317,7 @@ Tcl_FinalizeThread(void)
*
* Fix [Bug #571002]
*/
-
- TclFinalizeThreadData();
+ TclFinalizeThreadData(quick);
}
/*
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index d066476..d4077f5 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -19,11 +19,9 @@
#include "tclCompile.h"
#include "tclOOInt.h"
#include "tommath.h"
+#include "tclStringRep.h"
#include <math.h>
-
-#if NRE_ENABLE_ASSERTS
#include <assert.h>
-#endif
/*
* Hack to determine whether we may expect IEEE floating point. The hack is
@@ -81,9 +79,7 @@ int tclTraceExec = 0;
static const char *const operatorStrings[] = {
"||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
- "+", "-", "*", "/", "%", "+", "-", "~", "!",
- "BUILTIN FUNCTION", "FUNCTION",
- "", "", "", "", "", "", "", "", "eq", "ne"
+ "+", "-", "*", "/", "%", "+", "-", "~", "!"
};
/*
@@ -174,29 +170,24 @@ 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)
@@ -205,14 +196,14 @@ typedef struct TEBCdata {
if (auxObjList) { \
objPtr->length += auxObjList->length; \
} \
- objPtr->internalRep.ptrAndLongRep.ptr = auxObjList; \
+ objPtr->internalRep.twoPtrValue.ptr1 = auxObjList; \
auxObjList = objPtr; \
} while (0)
#define POP_TAUX_OBJ() \
do { \
tmpPtr = auxObjList; \
- auxObjList = tmpPtr->internalRep.ptrAndLongRep.ptr; \
+ auxObjList = tmpPtr->internalRep.twoPtrValue.ptr1; \
Tcl_DecrRefCount(tmpPtr); \
} while (0)
@@ -293,12 +284,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)
@@ -318,6 +311,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()
@@ -360,6 +417,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
@@ -381,6 +440,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, \
@@ -397,6 +458,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 */
@@ -451,7 +513,7 @@ 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 /* !TCL_WIDE_INT_IS_LONG */
#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
@@ -471,7 +533,7 @@ 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 /* TCL_WIDE_INT_IS_LONG */
@@ -490,30 +552,6 @@ VarHashCreateVar(
: Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr)))
/*
- * Macro used in this file to save a function call for common uses of
- * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is:
- *
- * MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
- * Tcl_WideInt *wideIntPtr);
- */
-
-#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 /* !TCL_WIDE_INT_IS_LONG */
-#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
- (((objPtr)->typePtr == &tclWideIntType) \
- ? (*(wideIntPtr) = (objPtr)->internalRep.wideValue, TCL_OK) : \
- ((objPtr)->typePtr == &tclIntType) \
- ? (*(wideIntPtr) = (Tcl_WideInt) \
- ((objPtr)->internalRep.longValue), TCL_OK) : \
- Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
-#endif /* TCL_WIDE_INT_IS_LONG */
-
-/*
* Macro used to make the check for type overflow more mnemonic. This works by
* comparing sign bits; the rest of the word is irrelevant. The ANSI C
* "prototype" (where inttype_t is any integer type) is:
@@ -718,7 +756,7 @@ static Tcl_Obj * ExecuteExtendedUnaryMathOp(int opcode,
Tcl_Obj *valuePtr);
static void FreeExprCodeInternalRep(Tcl_Obj *objPtr);
static ExceptionRange * GetExceptRangeForPc(const unsigned char *pc,
- int catchOnly, ByteCode *codePtr);
+ int searchMode, ByteCode *codePtr);
static const char * GetSrcInfoForPc(const unsigned char *pc,
ByteCode *codePtr, int *lengthPtr,
const unsigned char **pcBeg, int *cmdIdxPtr);
@@ -734,7 +772,8 @@ 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;
/*
@@ -885,11 +924,10 @@ 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) {
- TclInitAuxDataTypeTable();
InitByteCodeExecution(interp);
execInitialized = 1;
}
@@ -988,7 +1026,6 @@ TclFinalizeExecution(void)
Tcl_MutexLock(&execMutex);
execInitialized = 0;
Tcl_MutexUnlock(&execMutex);
- TclFinalizeAuxDataTypeTable();
}
/*
@@ -1097,7 +1134,7 @@ GrowEvaluationStack(
}
needed = growth + moveWords + WALLOCALIGN;
-
+
/*
* Check if there is enough room in the next stack (if there is one, it
* should be both empty and the last one!)
@@ -1106,8 +1143,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) {
@@ -1119,7 +1156,7 @@ GrowEvaluationStack(
DeleteExecStack(esPtr);
esPtr = oldPtr;
} else {
- currElems = esPtr->endPtr - &esPtr->stackWords[-1];
+ currElems = esPtr->endPtr - STACK_BASE(esPtr);
}
/*
@@ -1135,7 +1172,7 @@ GrowEvaluationStack(
#else
newElems = needed;
#endif
-
+
newBytes = sizeof(ExecStack) + (newElems-1) * sizeof(Tcl_Obj *);
oldPtr = esPtr;
@@ -1273,10 +1310,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;
@@ -1608,8 +1645,7 @@ FreeExprCodeInternalRep(
ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
objPtr->typePtr = NULL;
- codePtr->refCount--;
- if (codePtr->refCount <= 0) {
+ if (codePtr->refCount-- <= 1) {
TclCleanupByteCode(codePtr);
}
}
@@ -1930,6 +1966,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
@@ -1962,10 +2033,6 @@ TclNRExecuteByteCode(
* sizeof(void *);
int numWords = (size + sizeof(Tcl_Obj *) - 1) / sizeof(Tcl_Obj *);
- if (iPtr->execEnvPtr->rewind) {
- return TCL_ERROR;
- }
-
codePtr->refCount++;
/*
@@ -1984,11 +2051,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
@@ -2017,8 +2081,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;
}
@@ -2074,9 +2138,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.
@@ -2084,16 +2145,19 @@ 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 */
-
+
/*
* Transfer variables - needed only between opcodes, but not while
* 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
@@ -2118,17 +2182,22 @@ TEBCresume(
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 (iPtr->execEnvPtr->rewind) {
- result = TCL_ERROR;
- }
+ if (!pc) {
+ /* bytecode is starting from scratch */
+ checkInterp = 0;
+ pc = codePtr->codeStart;
+ goto cleanup0;
+ } else {
+ /* resume from invocation */
+ CACHE_STACK_INFO();
+
NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr);
if (bcFramePtr->cmdObj) {
Tcl_DecrRefCount(bcFramePtr->cmdObj);
@@ -2137,68 +2206,53 @@ TEBCresume(
}
iPtr->cmdFramePtr = bcFramePtr->nextPtr;
if (iPtr->flags & INTERP_DEBUG_FRAME) {
- TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
+ TclArgumentBCRelease(interp, bcFramePtr);
+ }
+ if (iPtr->execEnvPtr->rewind) {
+ result = TCL_ERROR;
+ goto abnormalReturn;
}
if (codePtr->flags & TCL_BYTECODE_RECOMPILE) {
iPtr->flags |= ERR_ALREADY_LOGGED;
codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;
}
- CACHE_STACK_INFO();
- if (result == TCL_OK) {
- /*
- * 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));
-
- /*
- * 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.
- */
-
- 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);
+ 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
@@ -2299,7 +2353,7 @@ TEBCresume(
*/
inst = *pc;
-
+
peepholeStart:
#ifdef TCL_COMPILE_STATS
iPtr->stats.instructionCount[*pc]++;
@@ -2319,7 +2373,7 @@ TEBCresume(
#endif /* TCL_COMPILE_DEBUG */
TCL_DTRACE_INST_NEXT();
-
+
if (inst == INST_LOAD_SCALAR1) {
goto instLoadScalar1;
} else if (inst == INST_PUSH1) {
@@ -2331,7 +2385,7 @@ TEBCresume(
/*
* Peephole: do not run INST_START_CMD, just skip it
*/
-
+
iPtr->cmdCount += TclGetUInt4AtPtr(pc+5);
if (checkInterp) {
checkInterp = 0;
@@ -2352,7 +2406,7 @@ TEBCresume(
}
goto peepholeStart;
}
-
+
switch (inst) {
case INST_SYNTAX:
case INST_RETURN_IMM: {
@@ -2409,48 +2463,109 @@ TEBCresume(
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.
*/
-
+
bcFramePtr->data.tebc.pc = (char *) pc;
iPtr->cmdFramePtr = bcFramePtr;
if (iPtr->flags & INTERP_DEBUG_FRAME) {
- int cmd;
- if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
- TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
- codePtr, bcFramePtr, cmd, 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;
}
@@ -2463,11 +2578,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;
@@ -2541,7 +2659,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: {
@@ -2556,10 +2674,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;
@@ -2708,6 +2827,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
@@ -2723,9 +2853,10 @@ TEBCresume(
*/
TclNewObj(objPtr);
- objPtr->internalRep.ptrAndLongRep.value = CURR_DEPTH;
+ objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(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:
@@ -2736,12 +2867,13 @@ TEBCresume(
*/
CLANG_ASSERT(auxObjList);
- objc = CURR_DEPTH - auxObjList->internalRep.ptrAndLongRep.value;
+ objc = CURR_DEPTH - PTR2INT(auxObjList->internalRep.twoPtrValue.ptr2);
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: {
@@ -2755,9 +2887,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();
@@ -2784,7 +2916,6 @@ TEBCresume(
* stack-allocated parameter, update the stack pointers.
*/
- esPtr = iPtr->execEnvPtr->execStackPtr;
TD = (TEBCdata *) (((Tcl_Obj **)TD) + moved);
catchTop += moved;
@@ -2801,6 +2932,7 @@ TEBCresume(
PUSH_OBJECT(objv[i]);
}
+ TRACE_APPEND(("OK\n"));
Tcl_DecrRefCount(objPtr);
NEXT_INST_F(5, 0, 0);
}
@@ -2835,7 +2967,7 @@ TEBCresume(
case INST_INVOKE_EXPANDED:
CLANG_ASSERT(auxObjList);
- objc = CURR_DEPTH - auxObjList->internalRep.ptrAndLongRep.value;
+ objc = CURR_DEPTH - PTR2INT(auxObjList->internalRep.twoPtrValue.ptr2);
POP_TAUX_OBJ();
if (objc) {
pcAdjustment = 1;
@@ -2893,11 +3025,7 @@ TEBCresume(
iPtr->cmdFramePtr = bcFramePtr;
if (iPtr->flags & INTERP_DEBUG_FRAME) {
- int cmd;
- if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
- TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
- codePtr, bcFramePtr, cmd, pc - codePtr->codeStart);
- }
+ ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
}
DECACHE_STACK_INFO();
@@ -3042,11 +3170,7 @@ TEBCresume(
bcFramePtr->data.tebc.pc = (char *) pc;
iPtr->cmdFramePtr = bcFramePtr;
if (iPtr->flags & INTERP_DEBUG_FRAME) {
- int cmd;
- if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
- TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
- codePtr, bcFramePtr, cmd, pc - codePtr->codeStart);
- }
+ ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
}
iPtr->ensembleRewrite.sourceObjs = objv;
iPtr->ensembleRewrite.numRemovedObjs = opnd;
@@ -3055,8 +3179,8 @@ TEBCresume(
pc += 6;
TEBC_YIELD();
+ TclMarkTailcall(interp);
TclNRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL);
- TclSkipTailcall(interp);
return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE, NULL, INT_MIN);
/*
@@ -3145,7 +3269,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;
@@ -3171,7 +3295,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;
}
@@ -3198,7 +3322,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)));
@@ -3215,7 +3339,7 @@ TEBCresume(
*/
{
- int storeFlags;
+ int storeFlags, len;
case INST_STORE_ARRAY4:
opnd = TclGetUInt4AtPtr(pc+1);
@@ -3347,7 +3471,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);
@@ -3397,7 +3521,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;
@@ -3445,7 +3569,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
@@ -3455,6 +3579,171 @@ TEBCresume(
#endif
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
NEXT_INST_V(pcAdjustment, cleanup, 1);
+
+ case INST_LAPPEND_LIST:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ valuePtr = OBJ_AT_TOS;
+ varPtr = LOCAL(opnd);
+ cleanup = 1;
+ pcAdjustment = 5;
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
+ if (TclListObjGetElements(interp, valuePtr, &objc, &objv)
+ != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ if (TclIsVarDirectReadable(varPtr)
+ && TclIsVarDirectWritable(varPtr)) {
+ goto lappendListDirect;
+ }
+ arrayPtr = NULL;
+ part1Ptr = part2Ptr = NULL;
+ goto lappendListPtr;
+
+ case INST_LAPPEND_LIST_ARRAY:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ valuePtr = OBJ_AT_TOS;
+ part1Ptr = NULL;
+ part2Ptr = OBJ_UNDER_TOS;
+ arrayPtr = LOCAL(opnd);
+ cleanup = 2;
+ pcAdjustment = 5;
+ while (TclIsVarLink(arrayPtr)) {
+ arrayPtr = arrayPtr->value.linkPtr;
+ }
+ TRACE(("%u \"%.30s\" \"%.30s\" => ",
+ opnd, O2S(part2Ptr), O2S(valuePtr)));
+ if (TclListObjGetElements(interp, valuePtr, &objc, &objv)
+ != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)
+ && !WriteTraced(arrayPtr)) {
+ varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
+ if (varPtr && TclIsVarDirectReadable(varPtr)
+ && TclIsVarDirectWritable(varPtr)) {
+ goto lappendListDirect;
+ }
+ }
+ varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
+ TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr, opnd);
+ if (varPtr == NULL) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ goto lappendListPtr;
+
+ case INST_LAPPEND_LIST_ARRAY_STK:
+ pcAdjustment = 1;
+ cleanup = 3;
+ valuePtr = OBJ_AT_TOS;
+ part2Ptr = OBJ_UNDER_TOS; /* element name */
+ part1Ptr = OBJ_AT_DEPTH(2); /* array name */
+ TRACE(("\"%.30s(%.30s)\" \"%.30s\" => ",
+ O2S(part1Ptr), O2S(part2Ptr), O2S(valuePtr)));
+ goto lappendList;
+
+ case INST_LAPPEND_LIST_STK:
+ pcAdjustment = 1;
+ cleanup = 2;
+ valuePtr = OBJ_AT_TOS;
+ part2Ptr = NULL;
+ part1Ptr = OBJ_UNDER_TOS; /* variable name */
+ TRACE(("\"%.30s\" \"%.30s\" => ", O2S(part1Ptr), O2S(valuePtr)));
+ goto lappendList;
+
+ lappendListDirect:
+ objResultPtr = varPtr->value.objPtr;
+ if (TclListObjLength(interp, objResultPtr, &len) != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ if (Tcl_IsShared(objResultPtr)) {
+ Tcl_Obj *newValue = Tcl_DuplicateObj(objResultPtr);
+
+ TclDecrRefCount(objResultPtr);
+ varPtr->value.objPtr = objResultPtr = newValue;
+ Tcl_IncrRefCount(newValue);
+ }
+ if (Tcl_ListObjReplace(interp, objResultPtr, len, 0, objc, objv)
+ != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_V(pcAdjustment, cleanup, 1);
+
+ lappendList:
+ opnd = -1;
+ if (TclListObjGetElements(interp, valuePtr, &objc, &objv)
+ != TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ DECACHE_STACK_INFO();
+ varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr,
+ TCL_LEAVE_ERR_MSG, "set", 1, 1, &arrayPtr);
+ CACHE_STACK_INFO();
+ if (!varPtr) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+
+ lappendListPtr:
+ if (TclIsVarInHash(varPtr)) {
+ VarHashRefCount(varPtr)++;
+ }
+ if (arrayPtr && TclIsVarInHash(arrayPtr)) {
+ VarHashRefCount(arrayPtr)++;
+ }
+ DECACHE_STACK_INFO();
+ objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr,
+ part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd);
+ CACHE_STACK_INFO();
+ if (TclIsVarInHash(varPtr)) {
+ VarHashRefCount(varPtr)--;
+ }
+ if (arrayPtr && TclIsVarInHash(arrayPtr)) {
+ VarHashRefCount(arrayPtr)--;
+ }
+
+ {
+ int createdNewObj = 0;
+
+ if (!objResultPtr) {
+ objResultPtr = valuePtr;
+ } else if (TclListObjLength(interp, objResultPtr, &len)!=TCL_OK) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ } else {
+ if (Tcl_IsShared(objResultPtr)) {
+ objResultPtr = Tcl_DuplicateObj(objResultPtr);
+ createdNewObj = 1;
+ }
+ if (Tcl_ListObjReplace(interp, objResultPtr, len,0, objc,objv)
+ != TCL_OK) {
+ goto errorInLappendListPtr;
+ }
+ }
+ DECACHE_STACK_INFO();
+ objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr,
+ part2Ptr, objResultPtr, TCL_LEAVE_ERR_MSG, opnd);
+ CACHE_STACK_INFO();
+ if (!objResultPtr) {
+ errorInLappendListPtr:
+ if (createdNewObj) {
+ TclDecrRefCount(objResultPtr);
+ }
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ }
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_V(pcAdjustment, cleanup, 1);
}
/*
@@ -3520,9 +3809,11 @@ TEBCresume(
varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr,
TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr);
if (!varPtr) {
+ DECACHE_STACK_INFO();
Tcl_AddErrorInfo(interp,
"\n (reading value of variable to increment)");
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ CACHE_STACK_INFO();
+ TRACE_ERROR(interp);
Tcl_DecrRefCount(incrPtr);
goto gotError;
}
@@ -3548,7 +3839,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;
}
@@ -3660,8 +3951,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);
@@ -3698,8 +3988,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);
@@ -3710,8 +3999,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;
}
}
@@ -3732,6 +4020,8 @@ TEBCresume(
*/
case INST_EXIST_SCALAR:
+ cleanup = 0;
+ pcAdjustment = 5;
opnd = TclGetUInt4AtPtr(pc+1);
varPtr = LOCAL(opnd);
while (TclIsVarLink(varPtr)) {
@@ -3748,16 +4038,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);
@@ -3768,7 +4053,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",
@@ -3785,13 +4070,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)));
@@ -3799,6 +4082,7 @@ TEBCresume(
case INST_EXIST_STK:
cleanup = 1;
+ pcAdjustment = 1;
part2Ptr = NULL;
part1Ptr = OBJ_AT_TOS; /* variable name */
TRACE(("\"%.30s\" => ", O2S(part1Ptr)));
@@ -3818,9 +4102,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.
@@ -3838,7 +4130,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
@@ -3851,6 +4143,7 @@ TEBCresume(
goto slowUnsetScalar;
}
varPtr->value.objPtr = NULL;
+ TRACE_APPEND(("OK\n"));
NEXT_INST_F(6, 0, 0);
}
@@ -3871,7 +4164,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);
@@ -3883,16 +4176,20 @@ TEBCresume(
if (!TclIsVarUndefined(varPtr)) {
TclDecrRefCount(varPtr->value.objPtr);
+ TclSetVarUndefined(varPtr);
+ TclClearVarNamespaceVar(varPtr);
+ TclCleanupVar(varPtr, arrayPtr);
} else if (flags & TCL_LEAVE_ERR_MSG) {
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);
}
}
@@ -3916,7 +4213,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;
@@ -3925,7 +4222,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();
@@ -3934,11 +4232,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;
/*
@@ -3947,7 +4246,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;
@@ -4000,8 +4299,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;
}
}
@@ -4034,7 +4332,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:
@@ -4046,9 +4344,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);
@@ -4076,9 +4375,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;
}
@@ -4093,13 +4394,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;
}
@@ -4114,16 +4418,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;
}
@@ -4141,7 +4447,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))) {
@@ -4153,6 +4459,7 @@ TEBCresume(
Var *linkPtr = varPtr->value.linkPtr;
if (linkPtr == otherPtr) {
+ TRACE_APPEND(("already linked\n"));
NEXT_INST_F(5, 1, 0);
}
if (TclIsVarInHash(linkPtr)) {
@@ -4169,6 +4476,7 @@ TEBCresume(
}
} else if (TclPtrObjMakeUpvar(interp, otherPtr, NULL, 0,
opnd) != TCL_OK) {
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -4177,6 +4485,7 @@ TEBCresume(
* variables - and [variable] did not push it at all.
*/
+ TRACE_APPEND(("link made\n"));
NEXT_INST_F(5, 1, 0);
}
@@ -4223,31 +4532,29 @@ 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),
+ TRACE_APPEND(("%.20s false, new pc %u\n", O2S(valuePtr),
(unsigned)(pc + jmpOffset[0] - codePtr->codeStart)));
}
}
@@ -4266,7 +4573,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));
@@ -4361,13 +4668,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;
}
@@ -4376,38 +4681,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;
@@ -4419,9 +4762,213 @@ 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();
+
+ TclPushTailcallPoint(interp);
+ 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);
@@ -4455,6 +5002,7 @@ TEBCresume(
}
/*
+ * End of TclOO support instructions.
* -----------------------------------------------------------------
* Start of INST_LIST and related instructions.
*/
@@ -4476,19 +5024,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.
@@ -4506,8 +5054,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;
}
@@ -4515,8 +5062,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
@@ -4528,6 +5074,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
@@ -4535,8 +5082,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;
}
@@ -4559,8 +5105,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 */
@@ -4575,10 +5120,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;
}
@@ -4586,7 +5132,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:
@@ -4596,6 +5142,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
@@ -4614,7 +5161,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;
}
@@ -4622,7 +5169,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 */
@@ -4642,6 +5189,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.
@@ -4649,8 +5198,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;
}
@@ -4658,7 +5206,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
@@ -4671,6 +5219,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
@@ -4678,8 +5228,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;
}
@@ -4736,9 +5285,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;
@@ -4753,8 +5300,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:
@@ -4763,9 +5309,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;
@@ -4796,7 +5342,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.
@@ -4804,21 +5350,7 @@ 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);
- }
-#endif
- objResultPtr = TCONST(match);
- NEXT_INST_F(0, 2, 1);
+ JUMP_PEEPHOLE_F(match, 1, 2);
case INST_LIST_CONCAT:
value2Ptr = OBJ_AT_TOS;
@@ -4828,7 +5360,7 @@ TEBCresume(
objResultPtr = Tcl_DuplicateObj(valuePtr);
if (Tcl_ListObjAppendList(interp, objResultPtr,
value2Ptr) != TCL_OK) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
TclDecrRefCount(objResultPtr);
goto gotError;
}
@@ -4836,7 +5368,7 @@ TEBCresume(
NEXT_INST_F(1, 2, 1);
} else {
if (Tcl_ListObjAppendList(interp, valuePtr, value2Ptr) != TCL_OK){
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
@@ -4875,8 +5407,8 @@ TEBCresume(
s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len);
s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
memCmpFn = memcmp;
- } else if (((valuePtr->typePtr == &tclStringType)
- && (value2Ptr->typePtr == &tclStringType))) {
+ } else if ((valuePtr->typePtr == &tclStringType)
+ && (value2Ptr->typePtr == &tclStringType)) {
/*
* Do a unicode-specific comparison if both of the args are of
* String type. If the char length == byte length, we can do a
@@ -4887,7 +5419,9 @@ TEBCresume(
s1len = Tcl_GetCharLength(valuePtr);
s2len = Tcl_GetCharLength(value2Ptr);
if ((s1len == valuePtr->length)
- && (s2len == value2Ptr->length)) {
+ && (valuePtr->bytes != NULL)
+ && (s2len == value2Ptr->length)
+ && (value2Ptr->bytes != NULL)) {
s1 = valuePtr->bytes;
s2 = value2Ptr->bytes;
memCmpFn = memcmp;
@@ -4971,25 +5505,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.
@@ -4997,6 +5580,7 @@ TEBCresume(
length = Tcl_GetCharLength(valuePtr);
if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -5004,7 +5588,7 @@ TEBCresume(
TclNewObj(objResultPtr);
} else if (TclIsPureByteArray(valuePtr)) {
objResultPtr = Tcl_NewByteArrayObj(
- Tcl_GetByteArrayFromObj(valuePtr, &length)+index, 1);
+ Tcl_GetByteArrayFromObj(valuePtr, NULL)+index, 1);
} else if (valuePtr->bytes && length == valuePtr->length) {
objResultPtr = Tcl_NewStringObj((const char *)
valuePtr->bytes+index, 1);
@@ -5022,18 +5606,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;
}
@@ -5093,33 +5677,208 @@ 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;
+
+ /*
+ * Flush the info in the string internal rep that refers to the
+ * about-to-be-invalidated UTF-8 rep. This indicates that a new
+ * buffer needs to be allocated, and assumes that the value is
+ * already of tclStringTypePtr type, which should be true provided
+ * we call it after Tcl_GetUnicodeFromObj.
+ */
+#define MarkStringInternalRepForFlush(objPtr) \
+ (GET_STRING(objPtr)->allocated = 0)
+
+ 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));
+ MarkStringInternalRepForFlush(objResultPtr);
+ }
+ Tcl_InvalidateStringRep(objResultPtr);
+ TclDecrRefCount(value3Ptr);
+ 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));
+ MarkStringInternalRepForFlush(valuePtr);
+ }
+ Tcl_InvalidateStringRep(valuePtr);
+ TclDecrRefCount(value3Ptr);
+ 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);
@@ -5148,6 +5907,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);
@@ -5170,7 +5930,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);
@@ -5194,6 +5953,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:
@@ -5236,26 +6014,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.
@@ -5266,44 +6095,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);
}
/*
@@ -5317,6 +6126,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:
@@ -5401,21 +6243,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:
@@ -5502,13 +6332,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)));
@@ -5550,13 +6380,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)));
@@ -5573,12 +6403,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;
@@ -5636,8 +6466,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)));
@@ -5809,8 +6638,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)));
@@ -5828,7 +6656,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);
@@ -5837,18 +6665,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);
@@ -5859,23 +6689,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);
@@ -5885,23 +6720,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);
}
@@ -5914,6 +6754,7 @@ TEBCresume(
*/
valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.20s\" => ", O2S(valuePtr)));
if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
if (*pc == INST_UPLUS) {
@@ -5921,7 +6762,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);
@@ -5930,7 +6771,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)) {
@@ -5939,7 +6780,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);
@@ -5949,8 +6790,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();
@@ -5968,7 +6808,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)) {
@@ -5983,11 +6823,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);
}
@@ -5996,6 +6836,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();
@@ -6004,6 +6855,7 @@ TEBCresume(
*/
result = TCL_BREAK;
cleanup = 0;
+ TRACE(("=> BREAK!\n"));
goto processExceptionReturn;
case INST_CONTINUE:
@@ -6014,6 +6866,7 @@ TEBCresume(
*/
result = TCL_CONTINUE;
cleanup = 0;
+ TRACE(("=> CONTINUE!\n"));
goto processExceptionReturn;
{
@@ -6025,7 +6878,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.
@@ -6058,13 +6911,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;
@@ -6091,8 +6945,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) {
@@ -6147,9 +7001,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;
}
@@ -6161,8 +7015,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
@@ -6176,6 +7030,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.twoPtrValue.ptr1 = 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.twoPtrValue.ptr1;
+ 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.twoPtrValue.ptr1;
+ 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.twoPtrValue.ptr1;
+ 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:
@@ -6237,7 +7285,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);
}
/*
@@ -6254,10 +7303,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"));
@@ -6266,6 +7315,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));
@@ -6278,10 +7328,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;
@@ -6290,34 +7341,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:
@@ -6391,8 +7448,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;
}
@@ -6414,8 +7471,7 @@ TEBCresume(
CACHE_STACK_INFO();
TclDecrRefCount(dictPtr);
if (objResultPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n",
- O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
}
@@ -6424,7 +7480,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:
@@ -6457,6 +7513,7 @@ TEBCresume(
if (allocateDict) {
TclDecrRefCount(dictPtr);
}
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -6505,6 +7562,7 @@ TEBCresume(
if (allocateDict) {
TclDecrRefCount(dictPtr);
}
+ TRACE_ERROR(interp);
goto gotError;
}
Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, valuePtr);
@@ -6514,6 +7572,7 @@ TEBCresume(
if (allocateDict) {
TclDecrRefCount(dictPtr);
}
+ TRACE_ERROR(interp);
goto gotError;
}
@@ -6550,8 +7609,7 @@ TEBCresume(
CACHE_STACK_INFO();
TclDecrRefCount(dictPtr);
if (objResultPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n",
- O2S(Tcl_GetObjResult(interp))));
+ TRACE_ERROR(interp);
goto gotError;
}
}
@@ -6570,7 +7628,16 @@ TEBCresume(
searchPtr = ckalloc(sizeof(Tcl_DictSearch));
if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr,
&valuePtr, &done) != TCL_OK) {
+
+ /*
+ * dictPtr is no longer on the stack, and we're not
+ * moving it into the intrep of an iterator. We need
+ * to drop the refcount [Tcl Bug 9b352768e6].
+ */
+
+ Tcl_DecrRefCount(dictPtr);
ckfree(searchPtr);
+ TRACE_ERROR(interp);
goto gotError;
}
TclNewObj(statePtr);
@@ -6606,8 +7673,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
@@ -6615,37 +7683,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\n",
- 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 => \n", opnd));
if (TclIsVarDirectReadable(varPtr)) {
dictPtr = varPtr->value.objPtr;
} else {
@@ -6654,11 +7702,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) {
@@ -6667,6 +7717,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]);
@@ -6682,21 +7733,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 {
@@ -6705,11 +7758,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);
@@ -6755,27 +7810,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((" => "));
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
case INST_DICT_RECOMBINE_STK:
@@ -6785,14 +7840,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;
}
@@ -6802,7 +7857,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"));
@@ -6816,7 +7871,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)) {
@@ -6827,7 +7882,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"));
@@ -6885,7 +7940,7 @@ TEBCresume(
}
#endif
if ((result == TCL_CONTINUE) || (result == TCL_BREAK)) {
- rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0, codePtr);
+ rangePtr = GetExceptRangeForPc(pc, result, codePtr);
if (rangePtr == NULL) {
TRACE_APPEND(("no encl. loop or catch, returning %s\n",
StringForResultCode(result)));
@@ -6923,10 +7978,10 @@ TEBCresume(
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)));
}
}
@@ -6939,8 +7994,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;
@@ -6951,9 +8006,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();
@@ -6997,7 +8052,7 @@ TEBCresume(
while (auxObjList) {
if ((catchTop != initCatchTop)
&& (*catchTop > (ptrdiff_t)
- auxObjList->internalRep.ptrAndLongRep.value)) {
+ auxObjList->internalRep.twoPtrValue.ptr2)) {
break;
}
POP_TAUX_OBJ();
@@ -7046,7 +8101,7 @@ TEBCresume(
#endif
goto abnormalReturn;
}
- rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 1, codePtr);
+ rangePtr = GetExceptRangeForPc(pc, TCL_ERROR, codePtr);
if (rangePtr == NULL) {
/*
* This is only possible when compiling a [catch] that sends its
@@ -7127,7 +8182,7 @@ TEBCresume(
}
iPtr->cmdFramePtr = bcFramePtr->nextPtr;
- if (--codePtr->refCount <= 0) {
+ if (codePtr->refCount-- <= 1) {
TclCleanupByteCode(codePtr);
}
TclStackFree(interp, TD); /* free my stack */
@@ -7166,6 +8221,7 @@ TEBCresume(
bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL, NULL);
opnd = TclGetUInt4AtPtr(pc+1);
pc += (opnd-1);
+ assert(bytes);
PUSH_OBJECT(Tcl_NewStringObj(bytes, length));
goto instEvalStk;
}
@@ -7179,6 +8235,59 @@ TEBCresume(
#undef auxObjList
#undef catchTop
#undef TCONST
+#undef esPtr
+
+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;
+}
/*
*----------------------------------------------------------------------
@@ -8653,7 +9762,7 @@ ValidatePcAndStackTop(
(unsigned) opCode, relativePc);
Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode");
}
- if (checkStack &&
+ if (checkStack &&
((stackTop < 0) || (stackTop > stackUpperBound))) {
int numChars;
const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL);
@@ -8706,10 +9815,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_LNOT) {
+ operator = operatorStrings[opcode - INST_LOR];
}
if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {
@@ -8777,7 +9888,11 @@ TclGetSourceFromFrame(
cfPtr->cmd = GetSrcInfoForPc((unsigned char *)
cfPtr->data.tebc.pc, codePtr, &cfPtr->len, NULL, NULL);
}
- cfPtr->cmdObj = Tcl_NewStringObj(cfPtr->cmd, cfPtr->len);
+ if (cfPtr->cmd) {
+ cfPtr->cmdObj = Tcl_NewStringObj(cfPtr->cmd, cfPtr->len);
+ } else {
+ cfPtr->cmdObj = Tcl_NewListObj(objc, objv);
+ }
Tcl_IncrRefCount(cfPtr->cmdObj);
}
return cfPtr->cmdObj;
@@ -8798,8 +9913,7 @@ TclGetSrcInfoForPc(
&cfPtr->len, NULL, NULL);
}
- assert(cfPtr->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.
@@ -8860,7 +9974,7 @@ GetSrcInfoForPc(
* 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
+ * of the command containing the pc should
* be stored. */
{
register int pcOffset = (pc - codePtr->codeStart);
@@ -8873,10 +9987,8 @@ GetSrcInfoForPc(
int bestSrcLength = -1; /* Initialized to avoid compiler warning. */
int bestCmdIdx = -1;
- if ((pcOffset < 0) || (pcOffset >= codePtr->numCodeBytes)) {
- if (pcBeg != NULL) *pcBeg = NULL;
- return NULL;
- }
+ /* The pc must point within the bytecode */
+ assert ((pcOffset >= 0) && (pcOffset < codePtr->numCodeBytes));
/*
* Decode the code and source offset and length for each command. The
@@ -8985,13 +10097,14 @@ GetSrcInfoForPc(
* ExceptionRange.
*
* Results:
- * In the normal case, catchOnly is 0 (false) and this procedure returns
- * a pointer to the most closely enclosing ExceptionRange structure
- * regardless of whether it is a loop or catch exception range. This is
- * appropriate when processing a TCL_BREAK or TCL_CONTINUE, which will be
- * "handled" either by a loop exception range or a closer catch range. If
- * catchOnly is nonzero, this procedure ignores loop exception ranges and
- * returns a pointer to the closest catch range. If no matching
+ * If the searchMode is TCL_ERROR, this procedure ignores loop exception
+ * ranges and returns a pointer to the closest catch range. If the
+ * searchMode is TCL_BREAK, this procedure returns a pointer to the most
+ * closely enclosing ExceptionRange regardless of whether it is a loop or
+ * catch exception range. If the searchMode is TCL_CONTINUE, this
+ * procedure returns a pointer to the most closely enclosing
+ * ExceptionRange (of any type) skipping only loop exception ranges if
+ * they don't have a sensible continueOffset defined. If no matching
* ExceptionRange is found that encloses pc, a NULL is returned.
*
* Side effects:
@@ -9002,14 +10115,16 @@ GetSrcInfoForPc(
static ExceptionRange *
GetExceptRangeForPc(
- const unsigned char *pc, /* The program counter value for which to
+ const unsigned char *pc, /* The program counter value for which to
* search for a closest enclosing exception
* range. This points to a bytecode
* instruction in codePtr's code. */
- int catchOnly, /* If 0, consider either loop or catch
- * ExceptionRanges in search. If nonzero
+ int searchMode, /* If TCL_BREAK, consider either loop or catch
+ * ExceptionRanges in search. If TCL_ERROR
* consider only catch ranges (and ignore any
- * closer loop ranges). */
+ * closer loop ranges). If TCL_CONTINUE, look
+ * for loop ranges that define a continue
+ * point or a catch range. */
ByteCode *codePtr) /* Points to the ByteCode in which to search
* for the enclosing ExceptionRange. */
{
@@ -9035,8 +10150,13 @@ GetExceptRangeForPc(
start = rangePtr->codeOffset;
if ((start <= pcOffset) &&
(pcOffset < (start + rangePtr->numCodeBytes))) {
- if ((!catchOnly)
- || (rangePtr->type == CATCH_EXCEPTION_RANGE)) {
+ if (rangePtr->type == CATCH_EXCEPTION_RANGE) {
+ return rangePtr;
+ }
+ if (searchMode == TCL_BREAK) {
+ return rangePtr;
+ }
+ if (searchMode == TCL_CONTINUE && rangePtr->continueOffset != -1){
return rangePtr;
}
}
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 13377d3..bb814ea 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -120,7 +120,7 @@ FileCopyRename(
}
i++;
if ((objc - i) < 2) {
- Tcl_WrongNumArgs(interp, 1, objv,
+ Tcl_WrongNumArgs(interp, 1, objv,
"?-option value ...? source ?source ...? target");
return TCL_ERROR;
}
@@ -517,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,7 +735,7 @@ CopyRenameOneFile(
errfile = target;
}
- /*
+ /*
* 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
@@ -1196,7 +1196,7 @@ TclFileLinkCmd(
static const char *const linkTypes[] = {
"-symbolic", "-hard", NULL
};
- if (Tcl_GetIndexFromObj(interp, objv[1], linkTypes, "switch", 0,
+ if (Tcl_GetIndexFromObj(interp, objv[1], linkTypes, "option", 0,
&linkAction) != TCL_OK) {
return TCL_ERROR;
}
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 5d4702b..39bac99 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -235,9 +235,9 @@ ExtractWinRoot(
if ((path[0] == 'c' || path[0] == 'C')
&& (path[1] == 'o' || path[1] == 'O')) {
if ((path[2] == 'm' || path[2] == 'M')
- && path[3] >= '1' && path[3] <= '4') {
+ && path[3] >= '1' && path[3] <= '9') {
/*
- * May have match for 'com[1-4]:?', which is a serial port.
+ * May have match for 'com[1-9]:?', which is a serial port.
*/
if (path[4] == '\0') {
@@ -257,9 +257,9 @@ ExtractWinRoot(
} else if ((path[0] == 'l' || path[0] == 'L')
&& (path[1] == 'p' || path[1] == 'P')
&& (path[2] == 't' || path[2] == 'T')) {
- if (path[3] >= '1' && path[3] <= '3') {
+ if (path[3] >= '1' && path[3] <= '9') {
/*
- * May have match for 'lpt[1-3]:?'
+ * May have match for 'lpt[1-9]:?'
*/
if (path[4] == '\0') {
@@ -821,10 +821,10 @@ Tcl_FSJoinToPath(
return TclJoinPath(2, pair);
} else {
int elemc = objc + 1;
- Tcl_Obj *ret, **elemv = ckalloc(elemc*sizeof(Tcl_Obj **));
+ Tcl_Obj *ret, **elemv = ckalloc(elemc*sizeof(Tcl_Obj *));
elemv[0] = pathPtr;
- memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj **));
+ memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj *));
ret = TclJoinPath(elemc, elemv);
ckfree(elemv);
return ret;
diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h
index 6be3e03..1eec7ff 100644
--- a/generic/tclFileSystem.h
+++ b/generic/tclFileSystem.h
@@ -33,7 +33,7 @@ MODULE_SCOPE void TclFSSetPathDetails(Tcl_Obj *pathPtr,
const Tcl_Filesystem *fsPtr, ClientData clientData);
MODULE_SCOPE Tcl_Obj * TclFSNormalizeAbsolutePath(Tcl_Interp *interp,
Tcl_Obj *pathPtr);
-MODULE_SCOPE int TclFSEpoch(void);
+MODULE_SCOPE size_t TclFSEpoch(void);
/*
* Private shared variables for use by tclIOUtil.c and tclPathObj.c
@@ -55,7 +55,7 @@ MODULE_SCOPE Tcl_PathType TclFSNonnativePathType(const char *pathPtr,
MODULE_SCOPE Tcl_PathType TclGetPathType(Tcl_Obj *pathPtr,
const Tcl_Filesystem **filesystemPtrPtr,
int *driveNameLengthPtr, Tcl_Obj **driveNameRef);
-MODULE_SCOPE int TclFSEpochOk(int filesystemEpoch);
+MODULE_SCOPE int TclFSEpochOk(size_t filesystemEpoch);
MODULE_SCOPE int TclFSCwdIsNative(void);
MODULE_SCOPE Tcl_Obj * TclWinVolumeRelativeNormalize(Tcl_Interp *interp,
const char *path, Tcl_Obj **useThisCwdPtr);
diff --git a/generic/tclHash.c b/generic/tclHash.c
index 90be511..1991aea 100644
--- a/generic/tclHash.c
+++ b/generic/tclHash.c
@@ -326,7 +326,7 @@ CreateHashEntry(
continue;
}
#endif
- if (compareKeysProc((void *) key, hPtr)) {
+ if (((void *) key == hPtr) || compareKeysProc((void *) key, hPtr)) {
if (newPtr) {
*newPtr = 0;
}
diff --git a/generic/tclHistory.c b/generic/tclHistory.c
index b10d423..b08e352 100644
--- a/generic/tclHistory.c
+++ b/generic/tclHistory.c
@@ -161,7 +161,7 @@ Tcl_RecordAndEvalObj(
Tcl_Obj *list[3];
/*
- * Do recording by eval'ing a tcl history command: history add $cmd.
+ * Do recording by eval'ing a tcl history command: history add $cmd.
*/
list[0] = histObjsPtr->historyObj;
@@ -175,7 +175,7 @@ Tcl_RecordAndEvalObj(
/*
* One possible failure mode above: exceeding a resource limit.
*/
-
+
if (Tcl_LimitExceeded(interp)) {
return TCL_ERROR;
}
diff --git a/generic/tclIO.c b/generic/tclIO.c
index f1d85bf..f93d00d 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -6,6 +6,7 @@
*
* Copyright (c) 1998-2000 Ajuba Solutions
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Contributions from Don Porter, NIST, 2014. (not subject to US copyright)
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -34,15 +35,15 @@ typedef struct ChannelHandler {
/*
* This structure keeps track of the current ChannelHandler being invoked in
- * the current invocation of ChannelHandlerEventProc. There is a potential
+ * the current invocation of Tcl_NotifyChannel. 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
+ * Tcl_NotifyChannel 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
+ * The nestedHandlerPtr field is used to chain together all recursive
+ * invocations, so that Tcl_DeleteChannelHandler can find all the recursively
+ * nested invocations of Tcl_NotifyChannel 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.
@@ -53,21 +54,10 @@ typedef struct NextChannelHandler {
* this invocation. */
struct NextChannelHandler *nestedHandlerPtr;
/* Next nested invocation of
- * ChannelHandlerEventProc. */
+ * Tcl_NotifyChannel. */
} 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.
*/
@@ -129,7 +119,7 @@ typedef struct CopyState {
typedef struct ThreadSpecificData {
NextChannelHandler *nestedHandlerPtr;
/* This variable holds the list of nested
- * ChannelHandlerEventProc invocations. */
+ * Tcl_NotifyChannel invocations. */
ChannelState *firstCSPtr; /* List of all channels currently open,
* indexed by ChannelState, as only one
* ChannelState exists per set of stacked
@@ -162,11 +152,14 @@ typedef struct CloseCallback {
*/
static ChannelBuffer * AllocChannelBuffer(int length);
+static void PreserveChannelBuffer(ChannelBuffer *bufPtr);
+static void ReleaseChannelBuffer(ChannelBuffer *bufPtr);
+static int IsShared(ChannelBuffer *bufPtr);
+static void ChannelFree(Channel *chanPtr);
static void ChannelTimerProc(ClientData clientData);
+static int ChanRead(Channel *chanPtr, char *dst, int dstSize);
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);
@@ -178,10 +171,15 @@ static int CloseChannelPart(Tcl_Interp *interp, Channel *chanPtr,
int errorCode, int flags);
static int CloseWrite(Tcl_Interp *interp, Channel *chanPtr);
static void CommonGetsCleanup(Channel *chanPtr);
-static int CopyAndTranslateBuffer(ChannelState *statePtr,
- char *result, int space);
-static int CopyBuffer(Channel *chanPtr, char *result, int space);
static int CopyData(CopyState *csPtr, int mask);
+static int MoveBytes(CopyState *csPtr);
+
+static void MBCallback(CopyState *csPtr, Tcl_Obj *errObj);
+static void MBError(CopyState *csPtr, int mask, int errorCode);
+static int MBRead(CopyState *csPtr);
+static int MBWrite(CopyState *csPtr);
+static void MBEvent(ClientData clientData, int mask);
+
static void CopyEventProc(ClientData clientData, int mask);
static void CreateScriptRecord(Tcl_Interp *interp,
Channel *chanPtr, int mask, Tcl_Obj *scriptPtr);
@@ -193,16 +191,16 @@ static int DetachChannel(Tcl_Interp *interp, Tcl_Channel chan);
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 DoRead(Channel *chanPtr, char *dst, int bytesToRead,
+ int allowShortReads);
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);
@@ -211,29 +209,30 @@ static int HaveVersion(const Tcl_ChannelType *typePtr,
static void PeekAhead(Channel *chanPtr, char **dstEndPtr,
GetsState *gsPtr);
static int ReadBytes(ChannelState *statePtr, Tcl_Obj *objPtr,
- int charsLeft, int *offsetPtr);
+ int charsLeft);
static int ReadChars(ChannelState *statePtr, Tcl_Obj *objPtr,
- int charsLeft, int *offsetPtr, int *factorPtr);
+ int charsLeft, int *factorPtr);
static void RecycleBuffer(ChannelState *statePtr,
ChannelBuffer *bufPtr, int mustDiscard);
static int StackSetBlockMode(Channel *chanPtr, int mode);
static int SetBlockMode(Tcl_Interp *interp, Channel *chanPtr,
int mode);
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,
+static void TranslateInputEOL(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
@@ -286,7 +285,7 @@ static int WillRead(Channel *chanPtr);
#define IsBufferEmpty(bufPtr) ((bufPtr)->nextAdded == (bufPtr)->nextRemoved)
-#define IsBufferFull(bufPtr) ((bufPtr)->nextAdded >= (bufPtr)->bufLength)
+#define IsBufferFull(bufPtr) ((bufPtr) && (bufPtr)->nextAdded >= (bufPtr)->bufLength)
#define IsBufferOverflowing(bufPtr) ((bufPtr)->nextAdded>(bufPtr)->bufLength)
@@ -323,14 +322,13 @@ 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 */
};
@@ -339,7 +337,7 @@ static const Tcl_ObjType tclChannelType = {
#define SET_CHANNELSTATE(objPtr, 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))
@@ -382,19 +380,87 @@ ChanCloseHalf(
return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, flags);
}
-static inline int
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ChanRead --
+ *
+ * Read up to dstSize bytes using the inputProc of chanPtr, store
+ * them at dst, and return the number of bytes stored.
+ *
+ * Results:
+ * The return value of the driver inputProc,
+ * - number of bytes stored at dst, ot
+ * - -1 on error, with a Posix error code available to the
+ * caller by calling Tcl_GetErrno().
+ *
+ * Side effects:
+ * The CHANNEL_BLOCKED and CHANNEL_EOF flags of the channel state are
+ * set as appropriate.
+ * On EOF, the inputEncodingFlags are set to perform ending operations
+ * on decoding.
+ * TODO - Is this really the right place for that?
+ *
+ *---------------------------------------------------------------------------
+ */
+static int
ChanRead(
Channel *chanPtr,
char *dst,
- int dstSize,
- int *errnoPtr)
+ int dstSize)
{
+ int bytesRead, result;
+
+ /*
+ * If the caller asked for zero bytes, we'd force the inputProc
+ * to return zero bytes, and then misinterpret that as EOF.
+ */
+ assert(dstSize > 0);
+
+ /*
+ * Each read op must set the blocked and eof states anew, not let
+ * the effect of prior reads leak through.
+ */
+ if (GotFlag(chanPtr->state, CHANNEL_EOF)) {
+ chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START;
+ }
+ ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF);
+ chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END;
if (WillRead(chanPtr) < 0) {
return -1;
}
- return chanPtr->typePtr->inputProc(chanPtr->instanceData, dst, dstSize,
- errnoPtr);
+ bytesRead = chanPtr->typePtr->inputProc(chanPtr->instanceData,
+ dst, dstSize, &result);
+
+ /* Stop any flag leakage through stacked channel levels */
+ if (GotFlag(chanPtr->state, CHANNEL_EOF)) {
+ chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START;
+ }
+ ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF);
+ chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END;
+ if (bytesRead > 0) {
+ /*
+ * If we get a short read, signal up that we may be BLOCKED.
+ * We should avoid calling the driver because on some
+ * platforms we will block in the low level reading code even
+ * though the channel is set into nonblocking mode.
+ */
+
+ if (bytesRead < dstSize) {
+ SetFlag(chanPtr->state, CHANNEL_BLOCKED);
+ }
+ } else if (bytesRead == 0) {
+ SetFlag(chanPtr->state, CHANNEL_EOF);
+ chanPtr->state->inputEncodingFlags |= TCL_ENCODING_END;
+ } else if (bytesRead < 0) {
+ if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
+ SetFlag(chanPtr->state, CHANNEL_BLOCKED);
+ result = EAGAIN;
+ }
+ Tcl_SetErrno(result);
+ }
+ return bytesRead;
}
static inline Tcl_WideInt
@@ -512,11 +578,11 @@ TclFinalizeIOSubsystem(void)
int active = 1; /* Flag == 1 while there's still work to do */
int doflushnb;
- /* Fetch the pre-TIP#398 compatibility flag */
+ /* Fetch the pre-TIP#398 compatibility flag */
{
const char *s;
Tcl_DString ds;
-
+
s = TclGetEnv("TCL_FLUSH_NONBLOCKING_ON_EXIT", &ds);
doflushnb = ((s != NULL) && strcmp(s, "0"));
if (s != NULL) {
@@ -558,6 +624,7 @@ TclFinalizeIOSubsystem(void)
if (active) {
+ TclChannelPreserve((Tcl_Channel)chanPtr);
/*
* TIP #398: by default, we no longer set the channel back into
* blocking mode. To restore the old blocking behavior, the
@@ -568,9 +635,9 @@ TclFinalizeIOSubsystem(void)
/* Set the channel back into blocking mode to ensure that we wait
* for all data to flush out.
*/
-
+
(void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
- "-blocking", "on");
+ "-blocking", "on");
}
if ((chanPtr == (Channel *) tsdPtr->stdinChannel) ||
@@ -616,6 +683,7 @@ TclFinalizeIOSubsystem(void)
chanPtr->instanceData = NULL;
SetFlag(statePtr, CHANNEL_DEAD);
}
+ TclChannelRelease((Tcl_Channel)chanPtr);
}
}
@@ -954,8 +1022,7 @@ DeleteChannelTable(
Tcl_DeleteHashEntry(hPtr);
SetFlag(statePtr, CHANNEL_TAINTED);
- statePtr->refCount--;
- if (statePtr->refCount <= 0) {
+ if (statePtr->refCount-- <= 1) {
if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
}
@@ -1177,15 +1244,6 @@ Tcl_UnregisterChannel(
*/
if (statePtr->refCount <= 0) {
- /*
- * Ensure that if there is another buffer, it gets flushed whether or
- * not we are doing a background flush.
- */
-
- if ((statePtr->curOutPtr != NULL) &&
- IsBufferReady(statePtr->curOutPtr)) {
- SetFlag(statePtr, BUFFER_READY);
- }
Tcl_Preserve(statePtr);
if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
/*
@@ -1497,6 +1555,22 @@ Tcl_CreateChannel(
*/
assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc *));
+ assert(typePtr->typeName != NULL);
+ if (NULL == typePtr->closeProc) {
+ Tcl_Panic("channel type %s must define closeProc", typePtr->typeName);
+ }
+ if ((TCL_READABLE & mask) && (NULL == typePtr->inputProc)) {
+ Tcl_Panic("channel type %s must define inputProc when used for reader channel", typePtr->typeName);
+ }
+ if ((TCL_WRITABLE & mask) && (NULL == typePtr->outputProc)) {
+ Tcl_Panic("channel type %s must define outputProc when used for writer channel", typePtr->typeName);
+ }
+ if (NULL == typePtr->watchProc) {
+ Tcl_Panic("channel type %s must define watchProc", typePtr->typeName);
+ }
+ if ((NULL!=typePtr->wideSeekProc) && (NULL == typePtr->seekProc)) {
+ Tcl_Panic("channel type %s must define seekProc if defining wideSeekProc", typePtr->typeName);
+ }
/*
* JH: We could subsequently memset these to 0 to avoid the numerous
@@ -1581,11 +1655,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.
@@ -1597,6 +1667,7 @@ Tcl_CreateChannel(
chanPtr->upChanPtr = NULL;
chanPtr->inQueueHead = NULL;
chanPtr->inQueueTail = NULL;
+ chanPtr->refCount = 0;
/*
* TIP #219, Tcl Channel Reflection API
@@ -1750,6 +1821,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;
@@ -1781,17 +1856,17 @@ Tcl_StackChannel(
*/
if (((mask & TCL_READABLE) != 0) && (statePtr->inQueueHead != NULL)) {
+
/*
- * Remark: It is possible that the channel buffers contain data from
- * some earlier push-backs.
+ * When statePtr->inQueueHead is not NULL, we know
+ * prevChanPtr->inQueueHead must be NULL.
*/
- statePtr->inQueueTail->nextPtr = prevChanPtr->inQueueHead;
- prevChanPtr->inQueueHead = statePtr->inQueueHead;
+ assert(prevChanPtr->inQueueHead == NULL);
+ assert(prevChanPtr->inQueueTail == NULL);
- if (prevChanPtr->inQueueTail == NULL) {
- prevChanPtr->inQueueTail = statePtr->inQueueTail;
- }
+ prevChanPtr->inQueueHead = statePtr->inQueueHead;
+ prevChanPtr->inQueueTail = statePtr->inQueueTail;
statePtr->inQueueHead = NULL;
statePtr->inQueueTail = NULL;
@@ -1813,6 +1888,7 @@ Tcl_StackChannel(
chanPtr->upChanPtr = NULL;
chanPtr->inQueueHead = NULL;
chanPtr->inQueueTail = NULL;
+ chanPtr->refCount = 0;
/*
* Place new block at the head of a possibly existing list of previously
@@ -1837,6 +1913,41 @@ Tcl_StackChannel(
return (Tcl_Channel) chanPtr;
}
+
+void
+TclChannelPreserve(
+ Tcl_Channel chan)
+{
+ ((Channel *)chan)->refCount++;
+}
+
+void
+TclChannelRelease(
+ Tcl_Channel chan)
+{
+ Channel *chanPtr = (Channel *) chan;
+
+ if (chanPtr->refCount == 0) {
+ Tcl_Panic("Channel released more than preserved");
+ }
+ if (--chanPtr->refCount) {
+ return;
+ }
+ if (chanPtr->typePtr == NULL) {
+ ckfree(chanPtr);
+ }
+}
+
+static void
+ChannelFree(
+ Channel *chanPtr)
+{
+ if (chanPtr->refCount == 0) {
+ ckfree(chanPtr);
+ return;
+ }
+ chanPtr->typePtr = NULL;
+}
/*
*----------------------------------------------------------------------
@@ -1879,6 +1990,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;
/*
@@ -1976,14 +2094,9 @@ Tcl_UnstackChannel(
*/
result = ChanClose(chanPtr, interp);
- chanPtr->typePtr = NULL;
-
- /*
- * AK: Tcl_NotifyChannel may hold a reference to this block of memory
- */
+ ChannelFree(chanPtr);
- Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
- UpdateInterest(downChanPtr);
+ UpdateInterest(statePtr->topChanPtr);
if (result != 0) {
Tcl_SetErrno(result);
@@ -2295,8 +2408,36 @@ AllocChannelBuffer(
bufPtr->nextRemoved = BUFFER_PADDING;
bufPtr->bufLength = length + BUFFER_PADDING;
bufPtr->nextPtr = NULL;
+ bufPtr->refCount = 1;
return bufPtr;
}
+
+static void
+PreserveChannelBuffer(
+ ChannelBuffer *bufPtr)
+{
+ if (bufPtr->refCount == 0) {
+ Tcl_Panic("Reuse of ChannelBuffer! %p", bufPtr);
+ }
+ bufPtr->refCount++;
+}
+
+static void
+ReleaseChannelBuffer(
+ ChannelBuffer *bufPtr)
+{
+ if (--bufPtr->refCount) {
+ return;
+ }
+ ckfree(bufPtr);
+}
+
+static int
+IsShared(
+ ChannelBuffer *bufPtr)
+{
+ return bufPtr->refCount > 1;
+}
/*
*----------------------------------------------------------------------
@@ -2327,20 +2468,23 @@ RecycleBuffer(
/*
* Do we have to free the buffer to the OS?
*/
+ if (IsShared(bufPtr)) {
+ mustDiscard = 1;
+ }
if (mustDiscard) {
- ckfree(bufPtr);
+ ReleaseChannelBuffer(bufPtr);
return;
}
/*
- * Only save buffers which are at least as big as the requested buffersize
- * for the channel. This is to honor dynamic changes of the buffersize
+ * Only save buffers which have the requested buffersize for the
+ * channel. This is to honor dynamic changes of the buffersize
* made by the user.
*/
- if ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize) {
- ckfree(bufPtr);
+ if ((bufPtr->bufLength - BUFFER_PADDING) != statePtr->bufSize) {
+ ReleaseChannelBuffer(bufPtr);
return;
}
@@ -2375,7 +2519,7 @@ RecycleBuffer(
* If we reached this code we return the buffer to the OS.
*/
- ckfree(bufPtr);
+ ReleaseChannelBuffer(bufPtr);
return;
keepBuffer:
@@ -2413,6 +2557,11 @@ DiscardOutputQueued(
}
statePtr->outQueueHead = NULL;
statePtr->outQueueTail = NULL;
+ bufPtr = statePtr->curOutPtr;
+ if (bufPtr && BytesLeft(bufPtr)) {
+ statePtr->curOutPtr = NULL;
+ RecycleBuffer(statePtr, bufPtr, 0);
+ }
}
/*
@@ -2480,8 +2629,6 @@ FlushChannel(
ChannelState *statePtr = chanPtr->state;
/* State of the channel stack. */
ChannelBuffer *bufPtr; /* Iterates over buffered output queue. */
- int toWrite; /* Amount of output data in current buffer
- * available to be written. */
int written; /* Amount of output data actually written in
* current round. */
int errorCode = 0; /* Stores POSIX error codes from channel
@@ -2501,63 +2648,61 @@ FlushChannel(
}
/*
- * Loop over the queued buffers and attempt to flush as much as possible
- * of the queued output to the channel.
- */
-
- Tcl_Preserve(chanPtr);
- while (1) {
- /*
- * If the queue is empty and there is a ready current buffer, OR if
- * the current buffer is full, then move the current buffer to the
- * queue.
- */
-
- if (((statePtr->curOutPtr != NULL) &&
- IsBufferFull(statePtr->curOutPtr))
- || (GotFlag(statePtr, BUFFER_READY) &&
- (statePtr->outQueueHead == NULL))) {
- ResetFlag(statePtr, BUFFER_READY);
- statePtr->curOutPtr->nextPtr = NULL;
- if (statePtr->outQueueHead == NULL) {
- statePtr->outQueueHead = statePtr->curOutPtr;
- } else {
- statePtr->outQueueTail->nextPtr = statePtr->curOutPtr;
- }
- statePtr->outQueueTail = statePtr->curOutPtr;
- statePtr->curOutPtr = NULL;
+ * Should we shift the current output buffer over to the output queue?
+ * First check that there are bytes in it. If so then...
+ * If the output queue is empty, then yes, trusting the caller called
+ * us only when written bytes ought to be flushed.
+ * If the current output buffer is full, then yes, so we can meet
+ * the post-condition that on a successful return to caller we've
+ * left space in the current output buffer for more writing (the flush
+ * call was to make new room).
+ * If the channel is blocking, then yes, so we guarantee that
+ * blocking flushes actually flush all pending data.
+ * Otherwise, no. Keep the current output buffer where it is so more
+ * can be written to it, possibly filling it, to promote more efficient
+ * buffer usage.
+ */
+
+ bufPtr = statePtr->curOutPtr;
+ if (bufPtr && BytesLeft(bufPtr) && /* Keep empties off queue */
+ (statePtr->outQueueHead == NULL || IsBufferFull(bufPtr)
+ || !GotFlag(statePtr, CHANNEL_NONBLOCKING))) {
+ if (statePtr->outQueueHead == NULL) {
+ statePtr->outQueueHead = bufPtr;
+ } else {
+ statePtr->outQueueTail->nextPtr = bufPtr;
}
- bufPtr = statePtr->outQueueHead;
+ statePtr->outQueueTail = bufPtr;
+ statePtr->curOutPtr = NULL;
+ }
- /*
- * If we are not being called from an async flush and an async flush
- * is active, we just return without producing any output.
- */
+ assert(!IsBufferFull(statePtr->curOutPtr));
- if (!calledFromAsyncFlush && GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
- errorCode = 0;
- goto done;
- }
+ /*
+ * If we are not being called from an async flush and an async flush
+ * is active, we just return without producing any output.
+ */
- /*
- * If the output queue is still empty, break out of the while loop.
- */
+ if (!calledFromAsyncFlush && GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
+ return 0;
+ }
- if (bufPtr == NULL) {
- break; /* Out of the "while (1)". */
- }
+ /*
+ * Loop over the queued buffers and attempt to flush as much as possible
+ * of the queued output to the channel.
+ */
+
+ TclChannelPreserve((Tcl_Channel)chanPtr);
+ while (statePtr->outQueueHead) {
+ bufPtr = statePtr->outQueueHead;
/*
* Produce the output on the channel.
*/
- toWrite = BytesLeft(bufPtr);
- if (toWrite == 0) {
- written = 0;
- } else {
- written = ChanWrite(chanPtr, RemovePoint(bufPtr), toWrite,
- &errorCode);
- }
+ PreserveChannelBuffer(bufPtr);
+ written = ChanWrite(chanPtr, RemovePoint(bufPtr), BytesLeft(bufPtr),
+ &errorCode);
/*
* If the write failed completely attempt to start the asynchronous
@@ -2572,6 +2717,7 @@ FlushChannel(
if (errorCode == EINTR) {
errorCode = 0;
+ ReleaseChannelBuffer(bufPtr);
continue;
}
@@ -2593,6 +2739,7 @@ FlushChannel(
UpdateInterest(chanPtr);
}
errorCode = 0;
+ ReleaseChannelBuffer(bufPtr);
break;
}
@@ -2654,14 +2801,15 @@ FlushChannel(
*/
DiscardOutputQueued(statePtr);
- continue;
+ ReleaseChannelBuffer(bufPtr);
+ break;
} else {
+ /* TODO: Consider detecting and reacting to short writes
+ * on blocking channels. Ought not happen. See iocmd-24.2. */
wroteSome = 1;
}
- if (!IsBufferEmpty(bufPtr)) {
- bufPtr->nextRemoved += written;
- }
+ bufPtr->nextRemoved += written;
/*
* If this buffer is now empty, recycle it.
@@ -2674,7 +2822,8 @@ FlushChannel(
}
RecycleBuffer(statePtr, bufPtr, 0);
}
- } /* Closes "while (1)". */
+ ReleaseChannelBuffer(bufPtr);
+ } /* Closes "while". */
/*
* If we wrote some data while flushing in the background, we are done.
@@ -2689,6 +2838,25 @@ FlushChannel(
} else if (statePtr->outQueueHead == NULL) {
ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
ChanWatch(chanPtr, statePtr->interestMask);
+ } else {
+
+ /*
+ * When we are calledFromAsyncFlush, that means a writable
+ * state on the channel triggered the call, so we should be
+ * able to write something. Either we did write something
+ * and wroteSome should be set, or there was nothing left to
+ * write in this call, and we've completed the BG flush.
+ * These are the two cases above. If we get here, that means
+ * there is some kind failure in the writable event machinery.
+ *
+ * The tls extension indeed suffers from flaws in its channel
+ * event mgmt. See http://core.tcl.tk/tcl/info/c31ca233ca.
+ * Until that patch is broadly distributed, disable the
+ * assertion checking here, so that programs using Tcl and
+ * tls can be debugged.
+
+ assert(!calledFromAsyncFlush);
+ */
}
}
@@ -2721,7 +2889,7 @@ FlushChannel(
}
done:
- Tcl_Release(chanPtr);
+ TclChannelRelease((Tcl_Channel)chanPtr);
return errorCode;
}
@@ -2775,7 +2943,7 @@ CloseChannel(
*/
if (statePtr->curOutPtr != NULL) {
- ckfree(statePtr->curOutPtr);
+ ReleaseChannelBuffer(statePtr->curOutPtr);
statePtr->curOutPtr = NULL;
}
@@ -2838,10 +3006,6 @@ CloseChannel(
}
Tcl_FreeEncoding(statePtr->encoding);
- if (statePtr->outputStage != NULL) {
- ckfree(statePtr->outputStage);
- statePtr->outputStage = NULL;
- }
}
/*
@@ -2891,9 +3055,9 @@ CloseChannel(
statePtr->topChanPtr = downChanPtr;
downChanPtr->upChanPtr = NULL;
- chanPtr->typePtr = NULL;
- Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
+ ChannelFree(chanPtr);
+
return Tcl_Close(interp, (Tcl_Channel) downChanPtr);
}
@@ -2901,13 +3065,11 @@ CloseChannel(
* There is only the TOP Channel, so we free the remaining pointers we
* have and then ourselves. Since this is the last of the channels in the
* stack, make sure to free the ChannelState structure associated with it.
- * We use Tcl_EventuallyFree to allow for any last references.
*/
- chanPtr->typePtr = NULL;
+ ChannelFree(chanPtr);
Tcl_EventuallyFree(statePtr, TCL_DYNAMIC);
- Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
return errorCode;
}
@@ -3191,10 +3353,18 @@ Tcl_Close(
stickyError = 0;
- if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
- && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
- statePtr->outputEncodingFlags |= TCL_ENCODING_END;
- if (WriteChars(chanPtr, "", 0) < 0) {
+ if (GotFlag(statePtr, TCL_WRITABLE) && (statePtr->encoding != NULL)
+ && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)) {
+
+ int code = CheckChannelErrors(statePtr, TCL_WRITABLE);
+
+ if (code == 0) {
+ statePtr->outputEncodingFlags |= TCL_ENCODING_END;
+ code = WriteChars(chanPtr, "", 0);
+ statePtr->outputEncodingFlags &= ~TCL_ENCODING_END;
+ statePtr->outputEncodingFlags |= TCL_ENCODING_START;
+ }
+ if (code < 0) {
stickyError = Tcl_GetErrno();
}
@@ -3229,14 +3399,6 @@ Tcl_Close(
ResetFlag(statePtr, CHANNEL_INCLOSE);
/*
- * Ensure that the last output buffer will be flushed.
- */
-
- if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
- SetFlag(statePtr, BUFFER_READY);
- }
-
- /*
* If this channel supports it, close the read side, since we don't need
* it anymore and this will help avoid deadlocks on some channel types.
*/
@@ -3281,7 +3443,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;
@@ -3394,10 +3566,6 @@ Tcl_CloseEx(
return CloseChannelPart(interp, chanPtr, 0, flags);
} else if (flags & TCL_CLOSE_WRITE) {
- if ((statePtr->curOutPtr != NULL) &&
- IsBufferReady(statePtr->curOutPtr)) {
- SetFlag(statePtr, BUFFER_READY);
- }
Tcl_Preserve(statePtr);
if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
/*
@@ -3459,14 +3627,6 @@ CloseWrite(
int result = 0;
/*
- * Ensure that the last output buffer will be flushed.
- */
-
- if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
- SetFlag(statePtr, BUFFER_READY);
- }
-
- /*
* The call to FlushChannel will flush any queued output and invoke the
* close function of the channel driver, or it will set up the channel to
* be flushed and closed asynchronously.
@@ -3778,7 +3938,10 @@ Tcl_Write(
if (srcLen < 0) {
srcLen = strlen(src);
}
- return DoWrite(chanPtr, src, srcLen);
+ if (WriteBytes(chanPtr, src, srcLen) < 0) {
+ return -1;
+ }
+ return srcLen;
}
/*
@@ -3869,82 +4032,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;
}
/*
@@ -4020,12 +4141,25 @@ static int
WillRead(
Channel *chanPtr)
{
+ if (chanPtr->typePtr == NULL) {
+ /* Prevent read attempts on a closed channel */
+ DiscardInputQueued(chanPtr->state, 0);
+ Tcl_SetErrno(EINVAL);
+ return -1;
+ }
if ((chanPtr->typePtr->seekProc != NULL)
&& (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
- if ((chanPtr->state->curOutPtr != NULL)
- && IsBufferReady(chanPtr->state->curOutPtr)) {
- SetFlag(chanPtr->state, BUFFER_READY);
- }
+
+ /*
+ * CAVEAT - The assumption here is that FlushChannel() will
+ * push out the bytes of any writes that are in progress.
+ * Since this is a seekable channel, we assume it is not one
+ * that can block and force bg flushing. Channels we know that
+ * can do that -- sockets, pipes -- are not seekable. If the
+ * assumption is wrong, more drastic measures may be required here
+ * like temporarily setting the channel into blocking mode.
+ */
+
if (FlushChannel(NULL, chanPtr, 0) != 0) {
return -1;
}
@@ -4036,110 +4170,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.
- *
- *----------------------------------------------------------------------
- */
-
-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 --
+ * Write --
*
- * 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.
@@ -4156,381 +4189,175 @@ 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);
+ if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)
+ || (statePtr->outputTranslation != TCL_TRANSLATE_LF)) {
+ nextNewLine = memchr(src, '\n', srcLen);
+ }
- /*
- * Loop over all UTF-8 characters in src, storing them in staging buffer
- * with proper EOL translation.
- */
+ while (srcLen + saved + endEncoding > 0) {
+ ChannelBuffer *bufPtr;
+ char *dst, safe[BUFFER_PADDING];
+ int result, srcRead, dstLen, dstWrote, srcLimit = srcLen;
- consumedSomething = 1;
- while (consumedSomething && (srcLen + savedLF + endEncoding > 0)) {
- consumedSomething = 0;
- stage = statePtr->outputStage;
- stageMax = statePtr->bufSize;
- stageLen = stageMax;
+ if (nextNewLine) {
+ srcLimit = nextNewLine - src;
+ }
- toWrite = stageLen;
- if (toWrite > srcLen) {
- toWrite = srcLen;
+ /* Get space to write into */
+ bufPtr = statePtr->curOutPtr;
+ if (bufPtr == NULL) {
+ bufPtr = AllocChannelBuffer(statePtr->bufSize);
+ statePtr->curOutPtr = bufPtr;
}
+ if (saved) {
+ /*
+ * Here's some translated bytes left over from the last buffer
+ * that we need to stick at the beginning of this buffer.
+ */
- 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).
- */
+ memcpy(InsertPoint(bufPtr), safe, (size_t) saved);
+ bufPtr->nextAdded += saved;
+ saved = 0;
+ }
+ PreserveChannelBuffer(bufPtr);
+ dst = InsertPoint(bufPtr);
+ dstLen = SpaceLeft(bufPtr);
- *stage++ = '\n';
- stageLen--;
- sawLF++;
- }
- if (TranslateOutputEOL(statePtr, stage, src, &stageLen,
- &toWrite)) {
- sawLF++;
- }
+ result = Tcl_UtfToExternal(NULL, encoding, src, srcLimit,
+ statePtr->outputEncodingFlags,
+ &statePtr->outputEncodingState, dst,
+ dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL);
- stage -= savedLF;
- stageLen += savedLF;
- savedLF = 0;
+ /* See chan-io-1.[89]. Tcl Bug 506297. */
+ statePtr->outputEncodingFlags &= ~TCL_ENCODING_START;
- if (stageLen > stageMax) {
- savedLF = 1;
- stageLen = stageMax;
+ 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;
}
- } else {
- memcpy(stage, src, toWrite);
- stageLen = toWrite;
+ break;
}
- src += toWrite;
- srcLen -= toWrite;
- /*
- * Loop over all UTF-8 characters in staging buffer, converting them
- * to external encoding, storing them in output buffer.
- */
+ bufPtr->nextAdded += dstWrote;
+ src += srcRead;
+ srcLen -= srcRead;
+ total += dstWrote;
+ dst += dstWrote;
+ dstLen -= dstWrote;
- 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 (src == nextNewLine && dstLen > 0) {
+ static char crln[3] = "\r\n";
+ char *nl = NULL;
+ int nlLen = 0;
- 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;
+ 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;
}
- result = Tcl_UtfToExternal(NULL, encoding, stage, stageLen,
- statePtr->outputEncodingFlags,
- &statePtr->outputEncodingState, dst,
- dstLen + BUFFER_PADDING, &stageRead, &dstWrote, NULL);
-
- /*
- * 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.
- */
-
- statePtr->outputEncodingFlags &= ~TCL_ENCODING_START;
-
- /*
- * The following code must be executed only when result is not 0.
- */
+ result |= Tcl_UtfToExternal(NULL, encoding, nl, nlLen,
+ statePtr->outputEncodingFlags,
+ &statePtr->outputEncodingState, dst,
+ dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL);
- 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.
- */
+ assert (srcRead == nlLen);
- src -= stageLen;
- srcLen += stageLen;
- stageLen = 0;
- savedLF = 0;
- 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.
- */
-
- saved = -SpaceLeft(bufPtr);
- memcpy(safe, dst + dstLen, (size_t) saved);
- bufPtr->nextAdded = bufPtr->bufLength;
- }
- if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
- return -1;
- }
-
+ 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++;
- }
+ if ((srcLen + saved == 0) && (result == TCL_OK)) {
+ endEncoding = 0;
}
- *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++;
- }
- *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) {
+ ReleaseChannelBuffer(bufPtr);
+ return -1;
}
- } else if (GotFlag(statePtr, CHANNEL_UNBUFFERED)) {
- SetFlag(statePtr, BUFFER_READY);
- }
- }
- if (GotFlag(statePtr, BUFFER_READY)) {
+ flushed += statePtr->bufSize;
+
+ /*
+ * We just flushed. So if we have needNlFlush set to record
+ * that we need to flush because theres a (translated) newline
+ * in the buffer, that's likely not true any more. But there
+ * is a tricky exception. If we have saved bytes that did not
+ * really get flushed and those bytes came from a translation
+ * of a newline as the last thing taken from the src array,
+ * then needNlFlush needs to remain set to flag that the
+ * next buffer still needs a newline flush.
+ */
+ if (needNlFlush && (saved == 0 || src[-1] != '\n')) {
+ needNlFlush = 0;
+ }
+ }
+ ReleaseChannelBuffer(bufPtr);
+ }
+ if ((flushed < total) && (GotFlag(statePtr, CHANNEL_UNBUFFERED) ||
+ (needNlFlush && GotFlag(statePtr, CHANNEL_LINEBUFFERED)))) {
if (FlushChannel(NULL, chanPtr, 0) != 0) {
return -1;
}
}
- return 0;
+
+ return total;
}
/*
@@ -4612,8 +4439,22 @@ Tcl_GetsObj(
Tcl_EncodingState oldState;
if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
- copiedTotal = -1;
- goto done;
+ return -1;
+ }
+
+ /*
+ * If we're sitting ready to read the eofchar, there's no need to
+ * do it.
+ */
+
+ if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
+ SetFlag(statePtr, CHANNEL_EOF);
+ assert( statePtr->inputEncodingFlags & TCL_ENCODING_END );
+ assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) );
+
+ /* TODO: Do we need this? */
+ UpdateInterest(chanPtr);
+ return -1;
}
/*
@@ -4633,6 +4474,7 @@ Tcl_GetsObj(
*/
chanPtr = statePtr->topChanPtr;
+ TclChannelPreserve((Tcl_Channel)chanPtr);
bufPtr = statePtr->inQueueHead;
encoding = statePtr->encoding;
@@ -4656,16 +4498,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();
}
/*
@@ -4690,6 +4523,7 @@ Tcl_GetsObj(
eof = NULL;
inEofChar = statePtr->inEofChar;
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
while (1) {
if (dst >= dstEnd) {
if (FilterInputBytes(chanPtr, &gs) != 0) {
@@ -4781,14 +4615,14 @@ Tcl_GetsObj(
* Skip the raw bytes that make up the '\n'.
*/
- char tmp[1 + TCL_UTF_MAX];
+ char tmp[TCL_UTF_MAX];
int rawRead;
bufPtr = gs.bufPtr;
Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr),
- gs.rawRead, statePtr->inputEncodingFlags,
- &gs.state, tmp, 1 + TCL_UTF_MAX, &rawRead, NULL,
- NULL);
+ gs.rawRead, statePtr->inputEncodingFlags
+ | TCL_ENCODING_NO_TERMINATE, &gs.state, tmp,
+ TCL_UTF_MAX, &rawRead, NULL, NULL);
bufPtr->nextRemoved += rawRead;
gs.rawRead -= rawRead;
gs.bytesWrote--;
@@ -4841,6 +4675,7 @@ Tcl_GetsObj(
dstEnd = eof;
SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
statePtr->inputEncodingFlags |= TCL_ENCODING_END;
+ ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR);
}
if (GotFlag(statePtr, CHANNEL_EOF)) {
skip = 0;
@@ -4854,6 +4689,7 @@ Tcl_GetsObj(
Tcl_SetObjLength(objPtr, oldLength);
CommonGetsCleanup(chanPtr);
copiedTotal = -1;
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
goto done;
}
goto gotEOL;
@@ -4875,7 +4711,11 @@ Tcl_GetsObj(
* self-modifying reflected transforms.
*/
- chanPtr = statePtr->topChanPtr;
+ if (chanPtr != statePtr->topChanPtr) {
+ TclChannelRelease((Tcl_Channel)chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ TclChannelPreserve((Tcl_Channel)chanPtr);
+ }
bufPtr = gs.bufPtr;
if (bufPtr == NULL) {
@@ -4883,8 +4723,9 @@ Tcl_GetsObj(
}
statePtr->inputEncodingState = gs.state;
Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr), gs.rawRead,
- statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst,
- eol - dst + skip + TCL_UTF_MAX, &gs.rawRead, NULL,
+ statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE,
+ &statePtr->inputEncodingState, dst,
+ eol - dst + skip + TCL_UTF_MAX - 1, &gs.rawRead, NULL,
&gs.charsWrote);
bufPtr->nextRemoved += gs.rawRead;
@@ -4909,16 +4750,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) {
+ TclChannelRelease((Tcl_Channel)chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ TclChannelPreserve((Tcl_Channel)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);
@@ -4947,14 +4790,24 @@ Tcl_GetsObj(
*/
done:
+ assert(!GotFlag(statePtr, CHANNEL_EOF)
+ || GotFlag(statePtr, CHANNEL_STICKY_EOF)
+ || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
+
+ assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
+ == (CHANNEL_EOF|CHANNEL_BLOCKED)) );
+
/*
* Regenerate the top channel, in case it was changed due to
* self-modifying reflected transforms.
*/
-
- chanPtr = statePtr->topChanPtr;
-
+ if (chanPtr != statePtr->topChanPtr) {
+ TclChannelRelease((Tcl_Channel)chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ TclChannelPreserve((Tcl_Channel)chanPtr);
+ }
UpdateInterest(chanPtr);
+ TclChannelRelease((Tcl_Channel)chanPtr);
return copiedTotal;
}
@@ -4967,6 +4820,11 @@ Tcl_GetsObj(
* end-of-line or end-of-file has been seen. Bytes read from the input
* channel return as a ByteArray obj.
*
+ * WARNING! The notion of "binary" used here is different from
+ * notions of "binary" used in other places. In particular, this
+ * "binary" routine may be called when an -eofchar is set on the
+ * channel.
+ *
* Results:
* Number of characters accumulated in the object or -1 if error,
* blocked, or EOF. If -1, use Tcl_GetErrno() to retrieve the POSIX error
@@ -5000,6 +4858,7 @@ TclGetsObjBinary(
*/
chanPtr = statePtr->topChanPtr;
+ TclChannelPreserve((Tcl_Channel)chanPtr);
bufPtr = statePtr->inQueueHead;
@@ -5027,6 +4886,7 @@ TclGetsObjBinary(
eolChar = (statePtr->inputTranslation == TCL_TRANSLATE_LF) ? '\n' : '\r';
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
while (1) {
/*
* Subtract the number of bytes that were removed from channel
@@ -5046,17 +4906,24 @@ TclGetsObjBinary(
* hasn't seen EOL. Need to read more bytes from the channel
* device. Side effect is to allocate another channel buffer.
*/
-
- if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
- if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
- goto restore;
- }
- ResetFlag(statePtr, CHANNEL_BLOCKED);
- }
if (GetInput(chanPtr) != 0) {
goto restore;
}
bufPtr = statePtr->inQueueTail;
+ if (bufPtr == NULL) {
+ goto restore;
+ }
+ } else {
+ /*
+ * Incoming CHANNEL_STICKY_EOF is filtered out on entry.
+ * A new CHANNEL_STICKY_EOF set in this routine leads to
+ * return before coming back here. When we are not dealing
+ * with CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an
+ * empty buffer. Here the buffer is non-empty so we know
+ * we're a non-EOF */
+
+ assert ( !GotFlag(statePtr, CHANNEL_STICKY_EOF) );
+ assert ( !GotFlag(statePtr, CHANNEL_EOF) );
}
dst = (unsigned char *) RemovePoint(bufPtr);
@@ -5098,6 +4965,7 @@ TclGetsObjBinary(
SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
statePtr->inputEncodingFlags |= TCL_ENCODING_END;
+ ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR);
}
if (GotFlag(statePtr, CHANNEL_EOF)) {
skip = 0;
@@ -5111,10 +4979,15 @@ TclGetsObjBinary(
byteArray = Tcl_SetByteArrayLength(objPtr, oldLength);
CommonGetsCleanup(chanPtr);
copiedTotal = -1;
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
goto done;
}
goto gotEOL;
}
+ if (GotFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_NONBLOCKING)
+ == (CHANNEL_BLOCKED|CHANNEL_NONBLOCKING)) {
+ goto restore;
+ }
/*
* Copy bytes from the channel buffer to the ByteArray.
@@ -5169,12 +5042,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);
@@ -5202,7 +5075,13 @@ TclGetsObjBinary(
*/
done:
+ assert(!GotFlag(statePtr, CHANNEL_EOF)
+ || GotFlag(statePtr, CHANNEL_STICKY_EOF)
+ || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
+ assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
+ == (CHANNEL_EOF|CHANNEL_BLOCKED)) );
UpdateInterest(chanPtr);
+ TclChannelRelease((Tcl_Channel)chanPtr);
return copiedTotal;
}
@@ -5231,6 +5110,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;
+}
/*
*---------------------------------------------------------------------------
@@ -5264,7 +5158,7 @@ FilterInputBytes(
ChannelState *statePtr = chanPtr->state;
/* State info for channel */
ChannelBuffer *bufPtr;
- char *raw, *rawStart, *dst;
+ char *raw, *dst;
int offset, toRead, dstNeeded, spaceLeft, result, rawLen;
Tcl_Obj *objPtr;
#define ENCODING_LINESIZE 20 /* Lower bound on how many bytes to convert at
@@ -5298,13 +5192,11 @@ FilterInputBytes(
*/
read:
- if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
- if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
- gsPtr->charsWrote = 0;
- gsPtr->rawRead = 0;
- return -1;
- }
- ResetFlag(statePtr, CHANNEL_BLOCKED);
+ if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)
+ == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) {
+ gsPtr->charsWrote = 0;
+ gsPtr->rawRead = 0;
+ return -1;
}
if (GetInput(chanPtr) != 0) {
gsPtr->charsWrote = 0;
@@ -5313,6 +5205,22 @@ FilterInputBytes(
}
bufPtr = statePtr->inQueueTail;
gsPtr->bufPtr = bufPtr;
+ if (bufPtr == NULL) {
+ gsPtr->charsWrote = 0;
+ gsPtr->rawRead = 0;
+ return -1;
+ }
+ } else {
+ /*
+ * Incoming CHANNEL_STICKY_EOF is filtered out on entry.
+ * A new CHANNEL_STICKY_EOF set in this routine leads to
+ * return before coming back here. When we are not dealing
+ * with CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an
+ * empty buffer. Here the buffer is non-empty so we know
+ * we're a non-EOF */
+
+ assert ( !GotFlag(statePtr, CHANNEL_STICKY_EOF) );
+ assert ( !GotFlag(statePtr, CHANNEL_EOF) );
}
/*
@@ -5321,8 +5229,7 @@ FilterInputBytes(
* string rep if we need more space.
*/
- rawStart = RemovePoint(bufPtr);
- raw = rawStart;
+ raw = RemovePoint(bufPtr);
rawLen = BytesLeft(bufPtr);
dst = *gsPtr->dstPtr;
@@ -5350,9 +5257,9 @@ FilterInputBytes(
}
gsPtr->state = statePtr->inputEncodingState;
result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
- statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
- dst, spaceLeft+1, &gsPtr->rawRead, &gsPtr->bytesWrote,
- &gsPtr->charsWrote);
+ statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE,
+ &statePtr->inputEncodingState, dst, spaceLeft, &gsPtr->rawRead,
+ &gsPtr->bytesWrote, &gsPtr->charsWrote);
/*
* Make sure that if we go through 'gets', that we reset the
@@ -5389,7 +5296,7 @@ FilterInputBytes(
} else {
/*
* There are no more cached raw bytes left. See if we can get
- * some more.
+ * some more, but avoid blocking on a non-blocking channel.
*/
goto read;
@@ -5630,134 +5537,87 @@ Tcl_Read(
int
Tcl_ReadRaw(
Tcl_Channel chan, /* The channel from which to read. */
- char *bufPtr, /* Where to store input read. */
+ char *readBuf, /* Where to store input read. */
int bytesToRead) /* Maximum number of bytes to read. */
{
Channel *chanPtr = (Channel *) chan;
ChannelState *statePtr = chanPtr->state;
/* State info for channel */
- int nread, result, copied, copiedNow;
-
- /*
- * The check below does too much because it will reject a call to this
- * function with a channel which is part of an 'fcopy'. But we have to
- * allow this here or else the chaining in the transformation drivers will
- * fail with 'file busy' error instead of retrieving and transforming the
- * data to copy.
- *
- * We let the check procedure now believe that there is no fcopy in
- * progress. A better solution than this might be an additional flag
- * argument to switch off specific checks.
- */
+ int copied = 0;
+ assert(bytesToRead > 0);
if (CheckChannelErrors(statePtr, TCL_READABLE | CHANNEL_RAW_MODE) != 0) {
return -1;
}
- /*
- * Check for information in the push-back buffers. If there is some, use
- * it. Go to the driver only if there is none (anymore) and the caller
- * requests more bytes.
- */
+ /* First read bytes from the push-back buffers. */
- for (copied = 0; copied < bytesToRead; copied += copiedNow) {
- copiedNow = CopyBuffer(chanPtr, bufPtr + copied,
- bytesToRead - copied);
- if (copiedNow == 0) {
- if (GotFlag(statePtr, CHANNEL_EOF)) {
- goto done;
- }
- if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
- if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
- goto done;
- }
- ResetFlag(statePtr, CHANNEL_BLOCKED);
- }
+ while (chanPtr->inQueueHead && bytesToRead > 0) {
+ ChannelBuffer *bufPtr = chanPtr->inQueueHead;
+ int bytesInBuffer = BytesLeft(bufPtr);
+ int toCopy = (bytesInBuffer < bytesToRead) ? bytesInBuffer
+ : bytesToRead;
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- /*
- * [Bug 943274]. Better emulation of non-blocking channels for
- * channels without BlockModeProc, by keeping track of true
- * fileevents generated by the OS == Data waiting and reading if
- * and only if we are sure to have data.
- */
+ /* Copy the current chunk into the read buffer. */
- if (GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
- (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
- !GotFlag(statePtr, CHANNEL_HAS_MORE_DATA)) {
- /*
- * We bypass the driver; it would block as no data is
- * available.
- */
+ memcpy(readBuf, RemovePoint(bufPtr), (size_t) toCopy);
+ bufPtr->nextRemoved += toCopy;
+ copied += toCopy;
+ readBuf += toCopy;
+ bytesToRead -= toCopy;
- nread = -1;
- result = EWOULDBLOCK;
- } else
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
- {
- /*
- * Now go to the driver to get as much as is possible to fill
- * the remaining request. Do all the error handling by
- * ourselves. The code was stolen from 'GetInput' and slightly
- * adapted (different return value here).
- *
- * The case of 'bytesToRead == 0' at this point cannot happen.
- */
+ /* If the current buffer is empty recycle it. */
- nread = ChanRead(chanPtr, bufPtr + copied,
- bytesToRead - copied, &result);
+ if (IsBufferEmpty(bufPtr)) {
+ chanPtr->inQueueHead = bufPtr->nextPtr;
+ if (chanPtr->inQueueHead == NULL) {
+ chanPtr->inQueueTail = NULL;
}
+ RecycleBuffer(chanPtr->state, bufPtr, 0);
+ }
+ }
- if (nread > 0) {
- /*
- * If we get a short read, signal up that we may be BLOCKED.
- * We should avoid calling the driver because on some
- * platforms we will block in the low level reading code even
- * though the channel is set into nonblocking mode.
- */
-
- if (nread < (bytesToRead - copied)) {
- SetFlag(statePtr, CHANNEL_BLOCKED);
- }
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- if (nread <= (bytesToRead - copied)) {
- /*
- * [Bug 943274] We have read the available data, clear
- * flag.
- */
+ /*
+ * Go to the driver only if we got nothing from pushback.
+ * Have to do it this way to avoid EOF mis-timings when we
+ * consider the ability that EOF may not be a permanent
+ * condition in the driver, and in that case we have to
+ * synchronize.
+ */
- ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
- }
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
- } else if (nread == 0) {
- SetFlag(statePtr, CHANNEL_EOF);
- statePtr->inputEncodingFlags |= TCL_ENCODING_END;
-
- } else if (nread < 0) {
- if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
- if (copied > 0) {
- /*
- * Information that was copied earlier has precedence
- * over EAGAIN/WOULDBLOCK handling.
- */
+ if (copied) {
+ return copied;
+ }
- return copied;
- }
+ /* This test not needed. */
+ if (bytesToRead > 0) {
- SetFlag(statePtr, CHANNEL_BLOCKED);
- result = EAGAIN;
- }
+ int nread = ChanRead(chanPtr, readBuf, bytesToRead);
- Tcl_SetErrno(result);
- return -1;
+ if (nread > 0) {
+ /* Successful read (short is OK) - add to bytes copied */
+ copied += nread;
+ } else if (nread < 0) {
+ /*
+ * An error signaled. If CHANNEL_BLOCKED, then the error
+ * is not real, but an indication of blocked state. In
+ * that case, retain the flag and let caller receive the
+ * short read of copied bytes from the pushback.
+ * HOWEVER, if copied==0 bytes from pushback then repeat
+ * signalling the blocked state as an error to caller so
+ * there is no false report of an EOF.
+ * When !CHANNEL_BLOCKED, the error is real and passes on
+ * to caller.
+ */
+ if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) {
+ copied = -1;
}
-
- return copied + nread;
+ } else {
+ /*
+ * nread == 0. Driver is at EOF. Let that state filter up.
+ */
}
}
-
- done:
return copied;
}
@@ -5854,20 +5714,18 @@ DoReadChars(
ChannelState *statePtr = chanPtr->state;
/* State info for channel */
ChannelBuffer *bufPtr;
- int offset, factor, copied, copiedNow, result;
- Tcl_Encoding encoding;
+ int copied, copiedNow, result;
+ Tcl_Encoding encoding = statePtr->encoding;
+ int binaryMode;
#define UTF_EXPANSION_FACTOR 1024
+ int factor = UTF_EXPANSION_FACTOR;
- /*
- * This operation should occur at the top of a channel stack.
- */
-
- chanPtr = statePtr->topChanPtr;
- encoding = statePtr->encoding;
- factor = UTF_EXPANSION_FACTOR;
+ binaryMode = (encoding == NULL)
+ && (statePtr->inputTranslation == TCL_TRANSLATE_LF)
+ && (statePtr->inEofChar == '\0');
if (appendFlag == 0) {
- if (encoding == NULL) {
+ if (binaryMode) {
Tcl_SetByteArrayLength(objPtr, 0);
} else {
Tcl_SetObjLength(objPtr, 0);
@@ -5876,27 +5734,63 @@ DoReadChars(
* We're going to access objPtr->bytes directly, so we must ensure
* that this is actually a string object (otherwise it might have
* been pure Unicode).
+ *
+ * Probably not needed anymore.
*/
TclGetString(objPtr);
}
- offset = 0;
- } else {
- if (encoding == NULL) {
- Tcl_GetByteArrayFromObj(objPtr, &offset);
- } else {
- TclGetStringFromObj(objPtr, &offset);
+ }
+
+ /*
+ * Early out when next read will see eofchar.
+ *
+ * NOTE: See DoRead for argument that it's a bug (one we're keeping)
+ * to have this escape before the one for zero-char read request.
+ */
+
+ if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
+ SetFlag(statePtr, CHANNEL_EOF);
+ assert( statePtr->inputEncodingFlags & TCL_ENCODING_END );
+ assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) );
+
+ /* TODO: We don't need this call? */
+ UpdateInterest(chanPtr);
+ return 0;
+ }
+
+ /* Special handling for zero-char read request. */
+ if (toRead == 0) {
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
+ statePtr->inputEncodingFlags |= TCL_ENCODING_START;
}
+ ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
+ statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
+ /* TODO: We don't need this call? */
+ UpdateInterest(chanPtr);
+ return 0;
}
+ /*
+ * This operation should occur at the top of a channel stack.
+ */
+
+ chanPtr = statePtr->topChanPtr;
+ TclChannelPreserve((Tcl_Channel)chanPtr);
+
+ /* Must clear the BLOCKED|EOF flags here since we check before reading */
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
+ statePtr->inputEncodingFlags |= TCL_ENCODING_START;
+ }
+ ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
+ statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
for (copied = 0; (unsigned) toRead > 0; ) {
copiedNow = -1;
if (statePtr->inQueueHead != NULL) {
- if (encoding == NULL) {
- copiedNow = ReadBytes(statePtr, objPtr, toRead, &offset);
+ if (binaryMode) {
+ copiedNow = ReadBytes(statePtr, objPtr, toRead);
} else {
- copiedNow = ReadChars(statePtr, objPtr, toRead, &offset,
- &factor);
+ copiedNow = ReadChars(statePtr, objPtr, toRead, &factor);
}
/*
@@ -5919,19 +5813,21 @@ DoReadChars(
if (GotFlag(statePtr, CHANNEL_EOF)) {
break;
}
- if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
- if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
- break;
- }
- ResetFlag(statePtr, CHANNEL_BLOCKED);
+ if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)
+ == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) {
+ break;
}
result = GetInput(chanPtr);
+ if (chanPtr != statePtr->topChanPtr) {
+ TclChannelRelease((Tcl_Channel)chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ TclChannelPreserve((Tcl_Channel)chanPtr);
+ }
if (result != 0) {
- if (result == EAGAIN) {
- break;
+ if (!GotFlag(statePtr, CHANNEL_BLOCKED)) {
+ copied = -1;
}
- copied = -1;
- goto done;
+ break;
}
} else {
copied += copiedNow;
@@ -5939,27 +5835,36 @@ DoReadChars(
}
}
- ResetFlag(statePtr, CHANNEL_BLOCKED);
- if (encoding == NULL) {
- Tcl_SetByteArrayLength(objPtr, offset);
- } else {
- Tcl_SetObjLength(objPtr, offset);
- }
-
/*
- * Update the notifier state so we don't block while there is still data
- * in the buffers.
+ * Failure to fill a channel buffer may have left channel reporting
+ * a "blocked" state, but so long as we fulfilled the request here,
+ * the caller does not consider us blocked.
*/
+ if (toRead == 0) {
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
+ }
- done:
/*
* Regenerate the top channel, in case it was changed due to
* self-modifying reflected transforms.
*/
+ if (chanPtr != statePtr->topChanPtr) {
+ TclChannelRelease((Tcl_Channel)chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ TclChannelPreserve((Tcl_Channel)chanPtr);
+ }
- chanPtr = statePtr->topChanPtr;
-
+ /*
+ * Update the notifier state so we don't block while there is still data
+ * in the buffers.
+ */
+ assert(!GotFlag(statePtr, CHANNEL_EOF)
+ || GotFlag(statePtr, CHANNEL_STICKY_EOF)
+ || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
+ assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
+ == (CHANNEL_EOF|CHANNEL_BLOCKED)) );
UpdateInterest(chanPtr);
+ TclChannelRelease((Tcl_Channel)chanPtr);
return copied;
}
@@ -5977,13 +5882,11 @@ DoReadChars(
* allocated to hold data read from the channel as needed.
*
* Results:
- * The return value is the number of bytes appended to the object and
- * *offsetPtr is filled with the total number of bytes in the object
- * (greater than the return value if there were already bytes in the
- * object).
+ * The return value is the number of bytes appended to the object, or
+ * -1 to indicate that zero bytes were read due to an EOF.
*
* Side effects:
- * None.
+ * The storage of bytes in objPtr can cause (re-)allocation of memory.
*
*---------------------------------------------------------------------------
*/
@@ -5996,72 +5899,22 @@ ReadBytes(
* been allocated to hold data, not how many
* bytes of data have been stored in the
* object. */
- int bytesToRead, /* Maximum number of bytes to store, or < 0 to
+ int bytesToRead) /* Maximum number of bytes to store, or < 0 to
* get all available bytes. Bytes are obtained
* from the first buffer in the queue - even
* if this number is larger than the number of
* bytes available in the first buffer, only
* the bytes from the first buffer are
* returned. */
- int *offsetPtr) /* On input, contains how many bytes of objPtr
- * have been used to hold data. On output,
- * filled with how many bytes are now being
- * used. */
{
- int toRead, srcLen, offset, length, srcRead, dstWrote;
- ChannelBuffer *bufPtr;
- char *src, *dst;
-
- offset = *offsetPtr;
-
- bufPtr = statePtr->inQueueHead;
- src = RemovePoint(bufPtr);
- srcLen = BytesLeft(bufPtr);
-
- toRead = bytesToRead;
- if ((unsigned) toRead > (unsigned) srcLen) {
- toRead = srcLen;
- }
-
- dst = (char *) Tcl_GetByteArrayFromObj(objPtr, &length);
- if (toRead > length - offset - 1) {
- /*
- * Double the existing size of the object or make enough room to hold
- * all the characters we may get from the source buffer, whichever is
- * larger.
- */
-
- length = offset * 2;
- if (offset < toRead) {
- length = offset + toRead + 1;
- }
- dst = (char *) Tcl_SetByteArrayLength(objPtr, length);
- }
- dst += offset;
-
- if (GotFlag(statePtr, INPUT_NEED_NL)) {
- ResetFlag(statePtr, INPUT_NEED_NL);
- if ((srcLen == 0) || (*src != '\n')) {
- *dst = '\r';
- *offsetPtr += 1;
- return 1;
- }
- *dst++ = '\n';
- src++;
- srcLen--;
- toRead--;
- }
+ ChannelBuffer *bufPtr = statePtr->inQueueHead;
+ int srcLen = BytesLeft(bufPtr);
+ int toRead = bytesToRead>srcLen || bytesToRead<0 ? srcLen : bytesToRead;
- srcRead = srcLen;
- dstWrote = toRead;
- if (TranslateInputEOL(statePtr, dst, src, &dstWrote, &srcRead) != 0) {
- if (dstWrote == 0) {
- return -1;
- }
- }
- bufPtr->nextRemoved += srcRead;
- *offsetPtr += dstWrote;
- return dstWrote;
+ TclAppendBytesToByteArray(objPtr, (unsigned char *) RemovePoint(bufPtr),
+ toRead);
+ bufPtr->nextRemoved += toRead;
+ return toRead;
}
/*
@@ -6105,35 +5958,35 @@ ReadChars(
* is larger than the number of characters
* available in the first buffer, only the
* characters from the first buffer are
- * returned. */
- int *offsetPtr, /* On input, contains how many bytes of objPtr
- * have been used to hold data. On output,
- * filled with how many bytes are now being
- * used. */
+ * returned. The execption is when there is
+ * not any complete character in the first
+ * buffer. In that case, a recursive call
+ * effectively obtains chars from the
+ * second buffer. */
int *factorPtr) /* On input, contains a guess of how many
* bytes need to be allocated to hold the
* result of converting N source bytes to
* UTF-8. On output, contains another guess
* based on the data seen so far. */
{
- int toRead, factor, offset, spaceLeft, srcLen, dstNeeded;
- int srcRead, dstWrote, numChars, dstRead;
- ChannelBuffer *bufPtr;
- char *src, *dst;
- Tcl_EncodingState oldState;
- int encEndFlagSuppressed = 0;
-
- factor = *factorPtr;
- offset = *offsetPtr;
+ Tcl_Encoding encoding = statePtr->encoding? statePtr->encoding
+ : GetBinaryEncoding();
+ Tcl_EncodingState savedState = statePtr->inputEncodingState;
+ ChannelBuffer *bufPtr = statePtr->inQueueHead;
+ int savedIEFlags = statePtr->inputEncodingFlags;
+ int savedFlags = statePtr->flags;
+ char *dst, *src = RemovePoint(bufPtr);
+ int numBytes, srcLen = BytesLeft(bufPtr);
- bufPtr = statePtr->inQueueHead;
- src = RemovePoint(bufPtr);
- srcLen = BytesLeft(bufPtr);
+ /*
+ * One src byte can yield at most one character. So when the
+ * number of src bytes we plan to read is less than the limit on
+ * character count to be read, clearly we will remain within that
+ * limit, and we can use the value of "srcLen" as a tighter limit
+ * for sizing receiving buffers.
+ */
- toRead = charsToRead;
- if ((unsigned) toRead > (unsigned) srcLen) {
- toRead = srcLen;
- }
+ int toRead = ((charsToRead<0)||(charsToRead > srcLen)) ? srcLen : charsToRead;
/*
* 'factor' is how much we guess that the bytes in the source buffer will
@@ -6141,226 +5994,335 @@ ReadChars(
* how many characters were produced by the previous pass.
*/
- dstNeeded = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
- spaceLeft = objPtr->length - offset;
-
- if (dstNeeded > spaceLeft) {
- /*
- * Double the existing size of the object or make enough room to hold
- * all the characters we want from the source buffer, whichever is
- * larger.
- */
-
- int length = offset + ((offset < dstNeeded) ? dstNeeded : offset);
+ int factor = *factorPtr;
+ int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
- if (Tcl_AttemptSetObjLength(objPtr, length) == 0) {
- length = offset + dstNeeded;
- if (Tcl_AttemptSetObjLength(objPtr, length) == 0) {
- dstNeeded = TCL_UTF_MAX - 1 + toRead;
- length = offset + dstNeeded;
- Tcl_SetObjLength(objPtr, length);
- }
- }
- spaceLeft = length - offset;
- }
+ (void) TclGetStringFromObj(objPtr, &numBytes);
+ Tcl_AppendToObj(objPtr, NULL, dstLimit);
if (toRead == srcLen) {
- /*
- * Want to convert the whole buffer in one pass. If we have enough
- * space, convert it using all available space in object rather than
- * using the factor.
- */
-
- dstNeeded = spaceLeft;
+ unsigned int size;
+ dst = TclGetStringStorage(objPtr, &size) + numBytes;
+ dstLimit = size - numBytes;
+ } else {
+ dst = TclGetString(objPtr) + numBytes;
}
- dst = objPtr->bytes + offset;
/*
- * [Bug 1462248]: The cause of the crash reported in this bug is this:
- *
- * - ReadChars, called with a single buffer, with a incomplete
- * multi-byte character at the end (only the first byte of it).
- * - Encoding translation fails, asks for more data
- * - Data is read, and eof is reached, TCL_ENCODING_END (TEE) is set.
- * - ReadChar is called again, converts the first buffer, but due to TEE
- * it does not check for incomplete multi-byte data, and the character
- * just after the end of the first buffer is a valid completion of the
- * multi-byte header in the actual buffer. The conversion reads more
- * characters from the buffer then present. This causes nextRemoved to
- * overshoot nextAdded and the next reads compute a negative srcLen,
- * cause further translations to fail, causing copying of data into the
- * next buffer using bad arguments, causing the mecpy for to eventually
- * fail.
- *
- * In the end it is a memory access bug spiraling out of control if the
- * conditions are _just so_. And ultimate cause is that TEE is given to a
- * conversion where it should not. TEE signals that this is the last
- * buffer. Except in our case it is not.
+ * This routine is burdened with satisfying several constraints.
+ * It cannot append more than 'charsToRead` chars onto objPtr.
+ * This is measured after encoding and translation transformations
+ * are completed. There is no precise number of src bytes that can
+ * be associated with the limit. Yet, when we are done, we must know
+ * precisely the number of src bytes that were consumed to produce
+ * the appended chars, so that all subsequent bytes are left in
+ * the buffers for future read operations.
*
- * My solution is to suppress TEE if the first buffer is not the last. We
- * will eventually need it given that EOF has been reached, but not right
- * now. This is what the new flag "endEncSuppressFlag" is for.
- *
- * The bug in 'Tcl_Utf2UtfProc' where it read from memory behind the
- * actual buffer has been fixed as well, and fixes the problem with the
- * crash too, but this would still allow the generic layer to
- * accidentially break a multi-byte sequence if the conditions are just
- * right, because again the ExternalToUtf would be successful where it
- * should not.
+ * The consequence is that we have no choice but to implement a
+ * "trial and error" approach, where in general we may need to
+ * perform transformations and copies multiple times to achieve
+ * a consistent set of results. This takes the shape of a loop.
*/
- if ((statePtr->inputEncodingFlags & TCL_ENCODING_END) &&
- (bufPtr->nextPtr != NULL)) {
+ while (1) {
+ int dstDecoded, dstRead, dstWrote, srcRead, numChars, code;
+ int flags = statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE;
+
+ if (charsToRead > 0) {
+ flags |= TCL_ENCODING_CHAR_LIMIT;
+ numChars = charsToRead;
+ }
+
/*
- * TEE is set for a buffer which is not the last. Squash it for now,
- * and restore it later, before yielding control to our caller.
+ * Perform the encoding transformation. Read no more than
+ * srcLen bytes, write no more than dstLimit bytes.
+ *
+ * Some trickiness with encoding flags here. We do not want
+ * the end of a buffer to be treated as the end of all input
+ * when the presence of bytes in a next buffer are already
+ * known to exist. This is checked with an assert() because
+ * so far no test case causing the assertion to be false has
+ * been created. The normal operations of channel reading
+ * appear to cause EOF and TCL_ENCODING_END setting to appear
+ * only in situations where there are no further bytes in
+ * any buffers.
*/
- statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
- encEndFlagSuppressed = 1;
- }
+ assert(bufPtr->nextPtr == NULL || BytesLeft(bufPtr->nextPtr) == 0
+ || (statePtr->inputEncodingFlags & TCL_ENCODING_END) == 0);
+
+ code = Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
+ flags, &statePtr->inputEncodingState,
+ dst, dstLimit, &srcRead, &dstDecoded, &numChars);
- oldState = statePtr->inputEncodingState;
- if (GotFlag(statePtr, INPUT_NEED_NL)) {
/*
- * We want a '\n' because the last character we saw was '\r'.
+ * Perform the translation transformation in place. Read no more
+ * than the dstDecoded bytes the encoding transformation actually
+ * produced. Capture the number of bytes written in dstWrote.
+ * Capture the number of bytes actually consumed in dstRead.
*/
- ResetFlag(statePtr, INPUT_NEED_NL);
- Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
- statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
- dst, TCL_UTF_MAX + 1, &srcRead, &dstWrote, &numChars);
- if ((dstWrote > 0) && (*dst == '\n')) {
+ dstWrote = dstLimit;
+ dstRead = dstDecoded;
+ TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
+
+ if (dstRead < dstDecoded) {
+
/*
- * The next char was a '\n'. Consume it and produce a '\n'.
+ * The encoding transformation produced bytes that the
+ * translation transformation did not consume. Why did
+ * this happen?
*/
- bufPtr->nextRemoved += srcRead;
- } else {
+ if (statePtr->inEofChar && dst[dstRead] == statePtr->inEofChar) {
+ /*
+ * 1) There's an eof char set on the channel, and
+ * we saw it and stopped translating at that point.
+ *
+ * NOTE the bizarre spec of TranslateInputEOL in this case.
+ * Clearly the eof char had to be read in order to account
+ * for the stopping, but the value of dstRead does not
+ * include it.
+ *
+ * Also rather bizarre, our caller can only notice an
+ * EOF condition if we return the value -1 as the number
+ * of chars read. This forces us to perform a 2-call
+ * dance where the first call can read all the chars
+ * up to the eof char, and the second call is solely
+ * for consuming the encoded eof char then pointed at
+ * by src so that we can return that magic -1 value.
+ * This seems really wasteful, especially since
+ * the first decoding pass of each call is likely to
+ * decode many bytes beyond that eof char that's all we
+ * care about.
+ */
+
+ if (dstRead == 0) {
+ /*
+ * Curious choice in the eof char handling. We leave
+ * the eof char in the buffer. So, no need to compute
+ * a proper srcRead value. At this point, there
+ * are no chars before the eof char in the buffer.
+ */
+ Tcl_SetObjLength(objPtr, numBytes);
+ return -1;
+ }
+
+ {
+ /*
+ * There are chars leading the buffer before the eof
+ * char. Adjust the dstLimit so we go back and read
+ * only those and do not encounter the eof char this
+ * time.
+ */
+
+ dstLimit = dstRead - 1 + TCL_UTF_MAX;
+ statePtr->flags = savedFlags;
+ statePtr->inputEncodingFlags = savedIEFlags;
+ statePtr->inputEncodingState = savedState;
+ continue;
+ }
+ }
+
/*
- * The next char was not a '\n'. Produce a '\r'.
+ * 2) The other way to read fewer bytes than are decoded
+ * is when the final byte is \r and we're in a CRLF
+ * translation mode so we cannot decide whether to
+ * record \r or \n yet.
*/
- *dst = '\r';
- }
- statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
- *offsetPtr += 1;
+ assert(dst[dstRead] == '\r');
+ assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF);
- if (encEndFlagSuppressed) {
- statePtr->inputEncodingFlags |= TCL_ENCODING_END;
- }
- return 1;
- }
+ if (dstWrote > 0) {
+ /*
+ * There are chars we can read before we hit the bare cr.
+ * Go back with a smaller dstLimit so we get them in the
+ * next pass, compute a matching srcRead, and don't end
+ * up back here in this call.
+ */
- Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
- statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst,
- dstNeeded + 1, &srcRead, &dstWrote, &numChars);
+ dstLimit = dstRead - 1 + TCL_UTF_MAX;
+ statePtr->flags = savedFlags;
+ statePtr->inputEncodingFlags = savedIEFlags;
+ statePtr->inputEncodingState = savedState;
+ continue;
+ }
- if (encEndFlagSuppressed) {
- statePtr->inputEncodingFlags |= TCL_ENCODING_END;
- }
+ assert(dstWrote == 0);
+ assert(dstRead == 0);
- if (srcRead == 0) {
- /*
- * Not enough bytes in src buffer to make a complete char. Copy the
- * bytes to the next buffer to make a new contiguous string, then tell
- * the caller to fill the buffer with more bytes.
- */
+ /*
+ * We decoded only the bare cr, and we cannot read a
+ * translated char from that alone. We have to know what's
+ * next. So why do we only have the one decoded char?
+ */
- ChannelBuffer *nextPtr;
+ if (code != TCL_OK) {
+ char buffer[TCL_UTF_MAX + 1];
+ int read, decoded, count;
- nextPtr = bufPtr->nextPtr;
- if (nextPtr == NULL) {
- if (srcLen > 0) {
/*
- * There isn't enough data in the buffers to complete the next
- * character, so we need to wait for more data before the next
- * file event can be delivered. [Bug 478856]
- *
- * The exception to this is if the input buffer was completely
- * empty before we tried to convert its contents. Nothing in,
- * nothing out, and no incomplete character data. The
- * conversion before the current one was complete.
+ * Didn't get everything the buffer could offer
*/
- SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
+ statePtr->flags = savedFlags;
+ statePtr->inputEncodingFlags = savedIEFlags;
+ statePtr->inputEncodingState = savedState;
+
+ assert(bufPtr->nextPtr == NULL
+ || BytesLeft(bufPtr->nextPtr) == 0 || 0 ==
+ (statePtr->inputEncodingFlags & TCL_ENCODING_END));
+
+ Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
+ (statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE),
+ &statePtr->inputEncodingState, buffer, TCL_UTF_MAX + 1,
+ &read, &decoded, &count);
+
+ if (count == 2) {
+ if (buffer[1] == '\n') {
+ /* \r\n translate to \n */
+ dst[0] = '\n';
+ bufPtr->nextRemoved += read;
+ } else {
+ dst[0] = '\r';
+ bufPtr->nextRemoved += srcRead;
+ }
+
+ statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
+
+ Tcl_SetObjLength(objPtr, numBytes + 1);
+ return 1;
+ }
+
+ } else if (statePtr->flags & CHANNEL_EOF) {
+
+ /*
+ * The bare \r is the only char and we will never read
+ * a subsequent char to make the determination.
+ */
+
+ dst[0] = '\r';
+ bufPtr->nextRemoved = bufPtr->nextAdded;
+ Tcl_SetObjLength(objPtr, numBytes + 1);
+ return 1;
}
- return -1;
+
+ /*
+ * Revise the dstRead value so that the numChars calc
+ * below correctly computes zero characters read.
+ */
+
+ dstRead = numChars;
+
+ /* FALL THROUGH - get more data (dstWrote == 0) */
}
/*
- * Space is made at the beginning of the buffer to copy the previous
- * unused bytes there. Check first if the buffer we are using actually
- * has enough space at its beginning for the data we are copying.
- * Because if not we will write over the buffer management
- * information, especially the 'nextPtr'.
- *
- * Note that the BUFFER_PADDING (See AllocChannelBuffer) is used to
- * prevent exactly this situation. I.e. it should never happen.
- * Therefore it is ok to panic should it happen despite the
- * precautions.
+ * The translation transformation can only reduce the number
+ * of chars when it converts \r\n into \n. The reduction in
+ * the number of chars is the difference in bytes read and written.
*/
- if (nextPtr->nextRemoved - srcLen < 0) {
- Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough");
- }
+ numChars -= (dstRead - dstWrote);
- nextPtr->nextRemoved -= srcLen;
- memcpy(RemovePoint(nextPtr), src, (size_t) srcLen);
- RecycleBuffer(statePtr, bufPtr, 0);
- statePtr->inQueueHead = nextPtr;
- return ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr);
- }
+ if (charsToRead > 0 && numChars > charsToRead) {
- dstRead = dstWrote;
- if (TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead) != 0) {
- /*
- * Hit EOF char. How many bytes of src correspond to where the EOF was
- * located in dst? Run the conversion again with an output buffer just
- * big enough to hold the data so we can get the correct value for
- * srcRead.
- */
+ /*
+ * TODO: This cannot happen anymore.
+ *
+ * We read more chars than allowed. Reset limits to
+ * prevent that and try again. Don't forget the extra
+ * padding of TCL_UTF_MAX bytes demanded by the
+ * Tcl_ExternalToUtf() call!
+ */
- if (dstWrote == 0) {
- return -1;
+ dstLimit = Tcl_UtfAtIndex(dst, charsToRead) - 1 + TCL_UTF_MAX - dst;
+ statePtr->flags = savedFlags;
+ statePtr->inputEncodingFlags = savedIEFlags;
+ statePtr->inputEncodingState = savedState;
+ continue;
}
- statePtr->inputEncodingState = oldState;
- Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
- statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
- dst, dstRead + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
- TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
- }
- /*
- * The number of characters that we got may be less than the number that
- * we started with because "\r\n" sequences may have been turned into just
- * '\n' in dst.
- */
+ if (dstWrote == 0) {
+ ChannelBuffer *nextPtr;
- numChars -= dstRead - dstWrote;
+ /* We were not able to read any chars. */
- if ((unsigned) numChars > (unsigned) toRead) {
- /*
- * Got too many chars.
- */
+ assert (numChars == 0);
- const char *eof = Tcl_UtfAtIndex(dst, toRead);
+ /*
+ * There is one situation where this is the correct final
+ * result. If the src buffer contains only a single \n
+ * byte, and we are in TCL_TRANSLATE_AUTO mode, and
+ * when the translation pass was made the INPUT_SAW_CR
+ * flag was set on the channel. In that case, the
+ * correct behavior is to consume that \n and produce the
+ * empty string.
+ */
- statePtr->inputEncodingState = oldState;
- Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
- statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
- dst, eof - dst + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
- dstRead = dstWrote;
- TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
- numChars -= (dstRead - dstWrote);
- }
- statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
+ if (dstRead == 1 && dst[0] == '\n') {
+ assert(statePtr->inputTranslation == TCL_TRANSLATE_AUTO);
+
+ goto consume;
+ }
+
+ /* Otherwise, reading zero characters indicates there's
+ * something incomplete at the end of the src buffer.
+ * Maybe there were not enough src bytes to decode into
+ * a char. Maybe a lone \r could not be translated (crlf
+ * mode). Need to combine any unused src bytes we have
+ * in the first buffer with subsequent bytes to try again.
+ */
+
+ nextPtr = bufPtr->nextPtr;
+
+ if (nextPtr == NULL) {
+ if (srcLen > 0) {
+ SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
+ }
+ Tcl_SetObjLength(objPtr, numBytes);
+ return -1;
+ }
+
+ /*
+ * Space is made at the beginning of the buffer to copy the
+ * previous unused bytes there. Check first if the buffer we
+ * are using actually has enough space at its beginning for
+ * the data we are copying. Because if not we will write over
+ * the buffer management information, especially the 'nextPtr'.
+ *
+ * Note that the BUFFER_PADDING (See AllocChannelBuffer) is
+ * used to prevent exactly this situation. I.e. it should never
+ * happen. Therefore it is ok to panic should it happen despite
+ * the precautions.
+ */
+
+ if (nextPtr->nextRemoved - srcLen < 0) {
+ Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough");
+ }
+
+ nextPtr->nextRemoved -= srcLen;
+ memcpy(RemovePoint(nextPtr), src, (size_t) srcLen);
+ RecycleBuffer(statePtr, bufPtr, 0);
+ statePtr->inQueueHead = nextPtr;
+ Tcl_SetObjLength(objPtr, numBytes);
+ return ReadChars(statePtr, objPtr, charsToRead, factorPtr);
+ }
- bufPtr->nextRemoved += srcRead;
- if (dstWrote > srcRead + 1) {
- *factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead;
+ statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
+
+ consume:
+ bufPtr->nextRemoved += srcRead;
+ /*
+ * If this read contained multibyte characters, revise factorPtr
+ * so the next read will allocate bigger buffers.
+ */
+ if (numChars && numChars < srcRead) {
+ *factorPtr = srcRead * UTF_EXPANSION_FACTOR / numChars;
+ }
+ Tcl_SetObjLength(objPtr, numBytes + dstWrote);
+ return numChars;
}
- *offsetPtr += dstWrote;
- return numChars;
}
/*
@@ -6381,7 +6343,7 @@ ReadChars(
*---------------------------------------------------------------------------
*/
-static int
+static void
TranslateInputEOL(
ChannelState *statePtr, /* Channel being read, for EOL translation and
* EOF character. */
@@ -6390,132 +6352,138 @@ TranslateInputEOL(
* characters. */
const char *srcStart, /* Source characters. */
int *dstLenPtr, /* On entry, the maximum length of output
- * buffer in bytes; must be <= *srcLenPtr. On
- * exit, the number of bytes actually used in
- * output buffer. */
+ * 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. */
{
- int dstLen, srcLen, inEofChar;
- const char *eof;
+ const char *eof = NULL;
+ int dstLen = *dstLenPtr;
+ int srcLen = *srcLenPtr;
+ int inEofChar = statePtr->inEofChar;
- dstLen = *dstLenPtr;
+ /*
+ * Depending on the translation mode in use, there's no need
+ * to scan more srcLen bytes at srcStart than can possibly transform
+ * to dstLen bytes. This keeps the scan for eof char below from
+ * being pointlessly long.
+ */
+
+ switch (statePtr->inputTranslation) {
+ case TCL_TRANSLATE_LF:
+ case TCL_TRANSLATE_CR:
+ if (srcLen > dstLen) {
+ /* In these modes, each src byte become a dst byte. */
+ srcLen = dstLen;
+ }
+ break;
+ default:
+ /* In other modes, at most 2 src bytes become a dst byte. */
+ if (srcLen/2 > dstLen) {
+ srcLen = 2 * dstLen;
+ }
+ break;
+ }
- eof = NULL;
- inEofChar = statePtr->inEofChar;
if (inEofChar != '\0') {
/*
- * Find EOF in translated buffer then compress out the EOL. The source
- * buffer may be much longer than the destination buffer - we only
- * want to return EOF if the EOF has been copied to the destination
- * buffer.
+ * Make sure we do not read past any logical end of channel input
+ * created by the presence of the input eof char.
*/
- const char *src, *srcMax = srcStart + *srcLenPtr;
-
- for (src = srcStart; src < srcMax; src++) {
- if (*src == inEofChar) {
- eof = src;
- srcLen = src - srcStart;
- if (srcLen < dstLen) {
- dstLen = srcLen;
- }
- *srcLenPtr = srcLen;
- break;
- }
+ if ((eof = memchr(srcStart, inEofChar, srcLen))) {
+ srcLen = eof - srcStart;
}
}
+
switch (statePtr->inputTranslation) {
case TCL_TRANSLATE_LF:
+ case TCL_TRANSLATE_CR:
if (dstStart != srcStart) {
- memcpy(dstStart, srcStart, (size_t) dstLen);
+ memcpy(dstStart, srcStart, (size_t) srcLen);
}
- srcLen = dstLen;
- break;
- case TCL_TRANSLATE_CR: {
- char *dst, *dstEnd;
+ if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
+ char *dst = dstStart;
+ char *dstEnd = dstStart + srcLen;
- if (dstStart != srcStart) {
- memcpy(dstStart, srcStart, (size_t) dstLen);
- }
- dstEnd = dstStart + dstLen;
- for (dst = dstStart; dst < dstEnd; dst++) {
- if (*dst == '\r') {
- *dst = '\n';
+ while ((dst = memchr(dst, '\r', dstEnd - dst))) {
+ *dst++ = '\n';
}
}
- srcLen = dstLen;
+ dstLen = srcLen;
break;
- }
case TCL_TRANSLATE_CRLF: {
- char *dst;
- const char *src, *srcEnd, *srcMax;
-
- dst = dstStart;
- src = srcStart;
- srcEnd = srcStart + dstLen;
- srcMax = srcStart + *srcLenPtr;
-
- for ( ; src < srcEnd; ) {
- if (*src == '\r') {
- src++;
- if (src >= srcMax) {
- SetFlag(statePtr, INPUT_NEED_NL);
- } else if (*src == '\n') {
- *dst++ = *src++;
- } else {
+ const char *crFound, *src = srcStart;
+ char *dst = dstStart;
+ int lesser = (dstLen < srcLen) ? dstLen : srcLen;
+
+ while ((crFound = memchr(src, '\r', lesser))) {
+ int numBytes = crFound - src;
+ memmove(dst, src, numBytes);
+
+ dst += numBytes; dstLen -= numBytes;
+ src += numBytes; srcLen -= numBytes;
+ if (srcLen == 1) {
+ /* valid src bytes end in \r */
+ if (eof) {
*dst++ = '\r';
+ src++; srcLen--;
+ } else {
+ lesser = 0;
+ break;
}
+ } else if (src[1] == '\n') {
+ *dst++ = '\n';
+ src += 2; srcLen -= 2;
} else {
- *dst++ = *src++;
+ *dst++ = '\r';
+ src++; srcLen--;
}
+ dstLen--;
+ lesser = (dstLen < srcLen) ? dstLen : srcLen;
}
- srcLen = src - srcStart;
- dstLen = dst - dstStart;
+ memmove(dst, src, lesser);
+ srcLen = src + lesser - srcStart;
+ dstLen = dst + lesser - dstStart;
break;
}
case TCL_TRANSLATE_AUTO: {
- char *dst;
- const char *src, *srcEnd, *srcMax;
-
- dst = dstStart;
- src = srcStart;
- srcEnd = srcStart + dstLen;
- srcMax = srcStart + *srcLenPtr;
+ const char *crFound, *src = srcStart;
+ char *dst = dstStart;
+ int lesser;
- if (GotFlag(statePtr, INPUT_SAW_CR) && (src < srcMax)) {
- if (*src == '\n') {
- src++;
- }
+ if ((statePtr->flags & INPUT_SAW_CR) && srcLen) {
+ if (*src == '\n') { src++; srcLen--; }
ResetFlag(statePtr, INPUT_SAW_CR);
}
- for ( ; src < srcEnd; ) {
- if (*src == '\r') {
- src++;
- if (src >= srcMax) {
- SetFlag(statePtr, INPUT_SAW_CR);
- } else if (*src == '\n') {
- if (srcEnd < srcMax) {
- srcEnd++;
- }
- src++;
- }
- *dst++ = '\n';
- } else {
- *dst++ = *src++;
+ lesser = (dstLen < srcLen) ? dstLen : srcLen;
+ while ((crFound = memchr(src, '\r', lesser))) {
+ int numBytes = crFound - src;
+ memmove(dst, src, numBytes);
+
+ dst[numBytes] = '\n';
+ dst += numBytes + 1; dstLen -= numBytes + 1;
+ src += numBytes + 1; srcLen -= numBytes + 1;
+ if (srcLen == 0) {
+ SetFlag(statePtr, INPUT_SAW_CR);
+ } else if (*src == '\n') {
+ src++; srcLen--;
}
+ lesser = (dstLen < srcLen) ? dstLen : srcLen;
}
- srcLen = src - srcStart;
- dstLen = dst - dstStart;
+ memmove(dst, src, lesser);
+ srcLen = src + lesser - srcStart;
+ dstLen = dst + lesser - dstStart;
break;
}
default:
- return 0;
+ Tcl_Panic("unknown input translation %d", statePtr->inputTranslation);
}
*dstLenPtr = dstLen;
+ *srcLenPtr = srcLen;
- if ((eof != NULL) && (srcStart + srcLen >= eof)) {
+ if (srcStart + srcLen == eof) {
/*
* EOF character was seen in EOL translated range. Leave current file
* position pointing at the EOF character, but don't store the EOF
@@ -6524,12 +6492,8 @@ TranslateInputEOL(
SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
statePtr->inputEncodingFlags |= TCL_ENCODING_END;
- ResetFlag(statePtr, INPUT_SAW_CR | INPUT_NEED_NL);
- return 1;
+ ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR);
}
-
- *srcLenPtr = srcLen;
- return 0;
}
/*
@@ -6583,16 +6547,15 @@ Tcl_Ungets(
statePtr->flags = flags;
/*
- * If we have encountered a sticky EOF, just punt without storing (sticky
- * EOF is set if we have seen the input eofChar, to prevent reading beyond
- * the eofChar). Otherwise, clear the EOF flags, and clear the BLOCKED
- * bit. We want to discover these conditions anew in each operation.
+ * Clear the EOF flags, and clear the BLOCKED bit.
*/
- if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
- goto done;
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
+ statePtr->inputEncodingFlags |= TCL_ENCODING_START;
}
- ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_EOF);
+ ResetFlag(statePtr,
+ CHANNEL_BLOCKED | CHANNEL_STICKY_EOF | CHANNEL_EOF | INPUT_SAW_CR);
+ statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
bufPtr = AllocChannelBuffer(len);
memcpy(InsertPoint(bufPtr), str, (size_t) len);
@@ -6657,14 +6620,6 @@ Tcl_Flush(
return -1;
}
- /*
- * Force current output buffer to be output also.
- */
-
- if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
- SetFlag(statePtr, BUFFER_READY);
- }
-
result = FlushChannel(NULL, chanPtr, 0);
if (result != 0) {
return TCL_ERROR;
@@ -6715,7 +6670,7 @@ DiscardInputQueued(
*/
if (discardSavedBuffers && statePtr->saveInBufPtr != NULL) {
- ckfree(statePtr->saveInBufPtr);
+ ReleaseChannelBuffer(statePtr->saveInBufPtr);
statePtr->saveInBufPtr = NULL;
}
}
@@ -6727,6 +6682,9 @@ DiscardInputQueued(
*
* Reads input data from a device into a channel buffer.
*
+ * IMPORTANT! This routine is only called on a chanPtr argument
+ * that is the top channel of a stack!
+ *
* Results:
* The return value is the Posix error code if an error occurred while
* reading from the file, or 0 otherwise.
@@ -6749,6 +6707,14 @@ GetInput(
/* State info for channel */
/*
+ * Verify that all callers know better than to call us when
+ * it's recorded that the next char waiting to be read is the
+ * eofchar.
+ */
+
+ assert( !GotFlag(statePtr, CHANNEL_STICKY_EOF) );
+
+ /*
* Prevent reading from a dead channel -- a channel that has been closed
* but not yet deallocated, which can happen if the exit handler for
* channel cleanup has run but the channel is still registered in some
@@ -6760,20 +6726,34 @@ GetInput(
}
/*
+ * WARNING: There was once a comment here claiming that it was
+ * a bad idea to make another call to the inputproc of a channel
+ * driver when EOF has already been detected on the channel. Through
+ * much of Tcl's history, this warning was then completely negated
+ * by having all (most?) read paths clear the EOF setting before
+ * reaching here. So we had a guard that was never triggered.
+ *
+ * Don't be tempted to restore the guard. Even if EOF is set on
+ * the channel, continue through and call the inputproc again. This
+ * is the way to enable the ability to [read] again beyond the EOF,
+ * which seems a strange thing to do, but for which use cases exist
+ * [Tcl Bug 5adc350683] and which may even be essential for channels
+ * representing things like ttys or other devices where the stream
+ * might take the logical form of a series of 'files' separated by
+ * an EOF condition.
+ */
+
+ /*
* First check for more buffers in the pushback area of the topmost
* channel in the stack and use them. They can be the result of a
* transformation which went away without reading all the information
* placed in the area when it was stacked.
- *
- * Two possibilities for the state: No buffers in it, or a single empty
- * buffer. In the latter case we can recycle it now.
*/
if (chanPtr->inQueueHead != NULL) {
- if (statePtr->inQueueHead != NULL) {
- RecycleBuffer(statePtr, statePtr->inQueueHead, 0);
- statePtr->inQueueHead = NULL;
- }
+
+ /* TODO: Tests to cover this. */
+ assert(statePtr->inQueueHead == NULL);
statePtr->inQueueHead = chanPtr->inQueueHead;
statePtr->inQueueTail = chanPtr->inQueueTail;
@@ -6794,21 +6774,21 @@ GetInput(
*/
bufPtr = statePtr->inQueueTail;
- if ((bufPtr != NULL) && !IsBufferFull(bufPtr)) {
- toRead = SpaceLeft(bufPtr);
- } else {
+
+ if ((bufPtr == NULL) || IsBufferFull(bufPtr)) {
bufPtr = statePtr->saveInBufPtr;
statePtr->saveInBufPtr = NULL;
/*
* Check the actual buffersize against the requested buffersize.
- * Buffers which are smaller than requested are squashed. This is done
+ * Saved buffers of the wrong size are squashed. This is done
* to honor dynamic changes of the buffersize made by the user.
+ * TODO: Tests to cover this.
*/
if ((bufPtr != NULL)
- && (bufPtr->bufLength - BUFFER_PADDING < statePtr->bufSize)) {
- ckfree(bufPtr);
+ && (bufPtr->bufLength - BUFFER_PADDING != statePtr->bufSize)) {
+ ReleaseChannelBuffer(bufPtr);
bufPtr = NULL;
}
@@ -6817,21 +6797,8 @@ GetInput(
}
bufPtr->nextPtr = NULL;
- /*
- * SF #427196: Use the actual size of the buffer to determine the
- * number of bytes to read from the channel and not the size for new
- * buffers. They can be different if the buffersize was changed
- * between reads.
- *
- * Note: This affects performance negatively if the buffersize was
- * extended but this small buffer is reused for all subsequent reads.
- * The system never uses buffers with the requested bigger size in
- * that case. An adjunct patch could try and delete all unused buffers
- * it encounters and which are smaller than the formally requested
- * buffersize.
- */
-
toRead = SpaceLeft(bufPtr);
+ assert(toRead == statePtr->bufSize);
if (statePtr->inQueueTail == NULL) {
statePtr->inQueueHead = bufPtr;
@@ -6839,75 +6806,22 @@ GetInput(
statePtr->inQueueTail->nextPtr = bufPtr;
}
statePtr->inQueueTail = bufPtr;
+ } else {
+ toRead = SpaceLeft(bufPtr);
}
- /*
- * If EOF is set, we should avoid calling the driver because on some
- * platforms it is impossible to read from a device after EOF.
- */
-
- if (GotFlag(statePtr, CHANNEL_EOF)) {
- return 0;
- }
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- /*
- * [Bug 943274]: Better emulation of non-blocking channels for channels
- * without BlockModeProc, by keeping track of true fileevents generated by
- * the OS == Data waiting and reading if and only if we are sure to have
- * data.
- */
+ PreserveChannelBuffer(bufPtr);
+ nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead);
- if (GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
- (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
- !GotFlag(statePtr, CHANNEL_HAS_MORE_DATA)) {
- /*
- * Bypass the driver, it would block, as no data is available
- */
-
- nread = -1;
- result = EWOULDBLOCK;
- } else
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
- {
- nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead, &result);
- }
-
- if (nread > 0) {
+ if (nread < 0) {
+ result = Tcl_GetErrno();
+ } else {
+ result = 0;
bufPtr->nextAdded += nread;
-
- /*
- * If we get a short read, signal up that we may be BLOCKED. We should
- * avoid calling the driver because on some platforms we will block in
- * the low level reading code even though the channel is set into
- * nonblocking mode.
- */
-
- if (nread < toRead) {
- SetFlag(statePtr, CHANNEL_BLOCKED);
- }
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- if (nread <= toRead) {
- /*
- * [Bug 943274]: We have read the available data, clear flag.
- */
-
- ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
- }
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
- } else if (nread == 0) {
- SetFlag(statePtr, CHANNEL_EOF);
- statePtr->inputEncodingFlags |= TCL_ENCODING_END;
- } else if (nread < 0) {
- if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
- SetFlag(statePtr, CHANNEL_BLOCKED);
- result = EAGAIN;
- }
- Tcl_SetErrno(result);
- return result;
}
- return 0;
+
+ ReleaseChannelBuffer(bufPtr);
+ return result;
}
/*
@@ -7011,8 +6925,12 @@ Tcl_Seek(
* point. Also clear CR related flags.
*/
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
+ statePtr->inputEncodingFlags |= TCL_ENCODING_START;
+ }
ResetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED |
INPUT_SAW_CR);
+ statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
/*
* If the channel is in asynchronous output mode, switch it back to
@@ -7035,15 +6953,6 @@ Tcl_Seek(
}
/*
- * If there is data buffered in statePtr->curOutPtr then mark the channel
- * as ready to flush before invoking FlushChannel.
- */
-
- if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
- SetFlag(statePtr, BUFFER_READY);
- }
-
- /*
* If the flush fails we cannot recover the original position. In that
* case the seek is not attempted because we do not know where the access
* position is - instead we return the error. FlushChannel has already
@@ -7367,17 +7276,7 @@ CheckChannelErrors(
}
if (direction == TCL_READABLE) {
- /*
- * If we have not encountered a sticky EOF, clear the EOF bit (sticky
- * EOF is set if we have seen the input eofChar, to prevent reading
- * beyond the eofChar). Also, always clear the BLOCKED bit. We want to
- * discover these conditions anew in each operation.
- */
-
- if (!GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
- ResetFlag(statePtr, CHANNEL_EOF);
- }
- ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
+ ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
}
return 0;
@@ -7406,9 +7305,7 @@ Tcl_Eof(
ChannelState *statePtr = ((Channel *) chan)->state;
/* State of real channel structure. */
- return (GotFlag(statePtr, CHANNEL_STICKY_EOF) ||
- (GotFlag(statePtr, CHANNEL_EOF) &&
- (Tcl_InputBuffered(chan) == 0))) ? 1 : 0;
+ return GotFlag(statePtr, CHANNEL_EOF) ? 1 : 0;
}
/*
@@ -7593,14 +7490,26 @@ Tcl_SetChannelBufferSize(
}
statePtr = ((Channel *) chan)->state;
+
+ if (statePtr->bufSize == sz) {
+ return;
+ }
statePtr->bufSize = sz;
- if (statePtr->outputStage != NULL) {
- ckfree(statePtr->outputStage);
- statePtr->outputStage = NULL;
+ /*
+ * If bufsize changes, need to get rid of old utility buffer.
+ */
+
+ if (statePtr->saveInBufPtr != NULL) {
+ RecycleBuffer(statePtr, statePtr->saveInBufPtr, 1);
+ statePtr->saveInBufPtr = NULL;
}
- if ((statePtr->encoding != NULL) && GotFlag(statePtr, TCL_WRITABLE)) {
- statePtr->outputStage = ckalloc(statePtr->bufSize + 2);
+ if ((statePtr->inQueueHead != NULL)
+ && (statePtr->inQueueHead->nextPtr == NULL)
+ && IsBufferEmpty(statePtr->inQueueHead)) {
+ RecycleBuffer(statePtr, statePtr->inQueueHead, 1);
+ statePtr->inQueueHead = NULL;
+ statePtr->inQueueTail = NULL;
}
}
@@ -8036,6 +7945,7 @@ Tcl_SetChannelOption(
return TCL_ERROR;
}
Tcl_SetChannelBufferSize(chan, newBufferSize);
+ return TCL_OK;
} else if (HaveOpt(2, "-encoding")) {
Tcl_Encoding encoding;
@@ -8053,7 +7963,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);
@@ -8066,6 +7977,7 @@ Tcl_SetChannelOption(
statePtr->outputEncodingFlags = TCL_ENCODING_START;
ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
UpdateInterest(chanPtr);
+ return TCL_OK;
} else if (HaveOpt(2, "-eofchar")) {
if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
return TCL_ERROR;
@@ -8112,7 +8024,11 @@ Tcl_SetChannelOption(
* ahead'. Ditto for blocked.
*/
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
+ statePtr->inputEncodingFlags |= TCL_ENCODING_START;
+ }
ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_STICKY_EOF|CHANNEL_BLOCKED);
+ statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
return TCL_OK;
} else if (HaveOpt(1, "-translation")) {
const char *readMode, *writeMode;
@@ -8226,33 +8142,6 @@ Tcl_SetChannelOption(
return Tcl_BadChannelOption(interp, optionName, NULL);
}
- /*
- * If bufsize changes, need to get rid of old utility buffer.
- */
-
- if (statePtr->saveInBufPtr != NULL) {
- RecycleBuffer(statePtr, statePtr->saveInBufPtr, 1);
- statePtr->saveInBufPtr = NULL;
- }
- if ((statePtr->inQueueHead != NULL)
- && (statePtr->inQueueHead->nextPtr == NULL)
- && IsBufferEmpty(statePtr->inQueueHead)) {
- RecycleBuffer(statePtr, statePtr->inQueueHead, 1);
- statePtr->inQueueHead = NULL;
- 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;
}
@@ -8344,21 +8233,6 @@ Tcl_NotifyChannel(
Channel *upChanPtr;
const Tcl_ChannelType *upTypePtr;
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- /*
- * [SF Tcl Bug 943274] For a non-blocking channel without blockmodeproc we
- * keep track of actual input coming from the OS so that we can do a
- * credible imitation of non-blocking behaviour.
- */
-
- if ((mask & TCL_READABLE) &&
- GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
- (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
- !GotFlag(statePtr, CHANNEL_TIMER_FEV)) {
- SetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
- }
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
/*
* In contrast to the other API functions this procedure walks towards the
* top of a stack and not down from it.
@@ -8408,7 +8282,7 @@ Tcl_NotifyChannel(
* Preserve the channel struct in case the script closes it.
*/
- Tcl_Preserve(channel);
+ TclChannelPreserve((Tcl_Channel)channel);
Tcl_Preserve(statePtr);
/*
@@ -8418,13 +8292,14 @@ Tcl_NotifyChannel(
*/
if (GotFlag(statePtr, BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
- FlushChannel(NULL, chanPtr, 1);
- mask &= ~TCL_WRITABLE;
+ if (0 == FlushChannel(NULL, chanPtr, 1)) {
+ mask &= ~TCL_WRITABLE;
+ }
}
/*
* Add this invocation to the list of recursive invocations of
- * ChannelHandlerEventProc.
+ * Tcl_NotifyChannel.
*/
nh.nextHandlerPtr = NULL;
@@ -8439,7 +8314,7 @@ Tcl_NotifyChannel(
if ((chPtr->mask & mask) != 0) {
nh.nextHandlerPtr = chPtr->nextPtr;
- chPtr->proc(chPtr->clientData, mask);
+ chPtr->proc(chPtr->clientData, chPtr->mask & mask);
chPtr = nh.nextHandlerPtr;
} else {
chPtr = chPtr->nextPtr;
@@ -8453,11 +8328,16 @@ Tcl_NotifyChannel(
*/
if (chanPtr->typePtr != NULL) {
+ /*
+ * TODO: This call may not be needed. If a handler induced a
+ * change in interest, that handler should have made its own
+ * UpdateInterest() call, one would think.
+ */
UpdateInterest(chanPtr);
}
Tcl_Release(statePtr);
- Tcl_Release(channel);
+ TclChannelRelease(channel);
tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
}
@@ -8487,6 +8367,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.
@@ -8594,29 +8479,8 @@ ChannelTimerProc(
statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
ChannelTimerProc,chanPtr);
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- /*
- * Set the TIMER flag to notify the higher levels that the driver
- * might have no data for us. We do this only if we are in
- * non-blocking mode and the driver has no BlockModeProc because only
- * then we really don't know if the driver will block or not. A
- * similar test is done in "PeekAhead".
- */
-
- if (GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
- (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) {
- SetFlag(statePtr, CHANNEL_TIMER_FEV);
- }
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
Tcl_Preserve(statePtr);
Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- ResetFlag(statePtr, CHANNEL_TIMER_FEV);
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
Tcl_Release(statePtr);
} else {
statePtr->timer = NULL;
@@ -8759,7 +8623,7 @@ Tcl_DeleteChannelHandler(
}
/*
- * If ChannelHandlerEventProc is about to process this handler, tell it to
+ * If Tcl_NotifyChannel is about to process this handler, tell it to
* process the next one instead - we are going to delete *this* one.
*/
@@ -8955,7 +8819,7 @@ TclChannelEventScriptInvoker(
*/
Tcl_Preserve(interp);
- Tcl_Preserve(chanPtr);
+ TclChannelPreserve((Tcl_Channel)chanPtr);
result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL);
/*
@@ -8972,7 +8836,7 @@ TclChannelEventScriptInvoker(
}
Tcl_BackgroundException(interp, result);
}
- Tcl_Release(chanPtr);
+ TclChannelRelease((Tcl_Channel)chanPtr);
Tcl_Release(interp);
}
@@ -9147,6 +9011,7 @@ TclCopyChannel(
int readFlags, writeFlags;
CopyState *csPtr;
int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0;
+ int moveBytes;
inStatePtr = inPtr->state;
outStatePtr = outPtr->state;
@@ -9198,13 +9063,24 @@ TclCopyChannel(
| CHANNEL_UNBUFFERED;
/*
+ * Test for conditions where we know we can just move bytes from input
+ * channel to output channel with no transformation or even examination
+ * of the bytes themselves.
+ */
+
+ moveBytes = inStatePtr->inEofChar == '\0' /* No eofChar to stop input */
+ && inStatePtr->inputTranslation == TCL_TRANSLATE_LF
+ && outStatePtr->outputTranslation == TCL_TRANSLATE_LF
+ && inStatePtr->encoding == outStatePtr->encoding;
+
+ /*
* Allocate a new CopyState to maintain info about the current copy in
* progress. This structure will be deallocated when the copy is
* completed.
*/
- csPtr = ckalloc(sizeof(CopyState) + inStatePtr->bufSize);
- csPtr->bufSize = inStatePtr->bufSize;
+ csPtr = ckalloc(sizeof(CopyState) + !moveBytes * inStatePtr->bufSize);
+ csPtr->bufSize = !moveBytes * inStatePtr->bufSize;
csPtr->readPtr = inPtr;
csPtr->writePtr = outPtr;
csPtr->readFlags = readFlags;
@@ -9220,6 +9096,10 @@ TclCopyChannel(
inStatePtr->csPtrR = csPtr;
outStatePtr->csPtrW = csPtr;
+ if (moveBytes) {
+ return MoveBytes(csPtr);
+ }
+
/*
* Special handling of -size 0 async transfers, so that the -command is
* still called asynchronously.
@@ -9254,6 +9134,236 @@ TclCopyChannel(
*----------------------------------------------------------------------
*/
+static void
+MBCallback(
+ CopyState *csPtr,
+ Tcl_Obj *errObj)
+{
+ Tcl_Obj *cmdPtr = Tcl_DuplicateObj(csPtr->cmdPtr);
+ Tcl_WideInt total = csPtr->total;
+ Tcl_Interp *interp = csPtr->interp;
+ int code;
+
+ Tcl_IncrRefCount(cmdPtr);
+ StopCopy(csPtr);
+
+ /* TODO: What if cmdPtr is not a list?! */
+
+ Tcl_ListObjAppendElement(NULL, cmdPtr, Tcl_NewWideIntObj(total));
+ if (errObj) {
+ Tcl_ListObjAppendElement(NULL, cmdPtr, errObj);
+ }
+
+ Tcl_Preserve(interp);
+ code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
+ if (code != TCL_OK) {
+ Tcl_BackgroundException(interp, code);
+ }
+ Tcl_Release(interp);
+ TclDecrRefCount(cmdPtr);
+}
+
+static void
+MBError(
+ CopyState *csPtr,
+ int mask,
+ int errorCode)
+{
+ Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
+ Tcl_Channel outChan = (Tcl_Channel) csPtr->writePtr;
+ Tcl_Obj *errObj;
+
+ Tcl_SetErrno(errorCode);
+
+ errObj = Tcl_ObjPrintf( "error %sing \"%s\": %s",
+ (mask & TCL_READABLE) ? "read" : "writ",
+ Tcl_GetChannelName((mask & TCL_READABLE) ? inChan : outChan),
+ Tcl_PosixError(csPtr->interp));
+
+ if (csPtr->cmdPtr) {
+ MBCallback(csPtr, errObj);
+ } else {
+ Tcl_SetObjResult(csPtr->interp, errObj);
+ StopCopy(csPtr);
+ }
+}
+
+static void
+MBEvent(
+ ClientData clientData,
+ int mask)
+{
+ CopyState *csPtr = (CopyState *) clientData;
+ Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
+ Tcl_Channel outChan = (Tcl_Channel) csPtr->writePtr;
+ ChannelState *inStatePtr = csPtr->readPtr->state;
+
+ if (mask & TCL_WRITABLE) {
+ Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr);
+ Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr);
+ switch (MBWrite(csPtr)) {
+ case TCL_OK:
+ MBCallback(csPtr, NULL);
+ break;
+ case TCL_CONTINUE:
+ Tcl_CreateChannelHandler(inChan, TCL_READABLE, MBEvent, csPtr);
+ break;
+ }
+ } else if (mask & TCL_READABLE) {
+ if (TCL_OK == MBRead(csPtr)) {
+ /* When at least one full buffer is present, stop reading. */
+ if (IsBufferFull(inStatePtr->inQueueHead)
+ || !Tcl_InputBlocked(inChan)) {
+ Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr);
+ }
+
+ /* Successful read -- set up to write the bytes we read */
+ Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, MBEvent, csPtr);
+ }
+ }
+}
+
+static int
+MBRead(
+ CopyState *csPtr)
+{
+ ChannelState *inStatePtr = csPtr->readPtr->state;
+ ChannelBuffer *bufPtr = inStatePtr->inQueueHead;
+ int code;
+
+ if (bufPtr && BytesLeft(bufPtr) > 0) {
+ return TCL_OK;
+ }
+
+ code = GetInput(inStatePtr->topChanPtr);
+ if (code == 0 || GotFlag(inStatePtr, CHANNEL_BLOCKED)) {
+ return TCL_OK;
+ } else {
+ MBError(csPtr, TCL_READABLE, code);
+ return TCL_ERROR;
+ }
+}
+
+static int
+MBWrite(
+ CopyState *csPtr)
+{
+ ChannelState *inStatePtr = csPtr->readPtr->state;
+ ChannelState *outStatePtr = csPtr->writePtr->state;
+ ChannelBuffer *bufPtr = inStatePtr->inQueueHead;
+ ChannelBuffer *tail = NULL;
+ int code;
+ Tcl_WideInt inBytes = 0;
+
+ /* Count up number of bytes waiting in the input queue */
+ while (bufPtr) {
+ inBytes += BytesLeft(bufPtr);
+ tail = bufPtr;
+ if (csPtr->toRead != -1 && csPtr->toRead < inBytes) {
+ /* Queue has enough bytes to complete the copy */
+ break;
+ }
+ bufPtr = bufPtr->nextPtr;
+ }
+
+ if (bufPtr) {
+ /* Split the overflowing buffer in two */
+ int extra = (int) (inBytes - csPtr->toRead);
+ /* Note that going with int for extra assumes that inBytes is not too
+ * much over toRead to require a wide itself. If that gets violated
+ * then the calculations involving extra must be made wide too.
+ *
+ * Noted with Win32/MSVC debug build treating the warning (possible of
+ * data in int64 to int conversion) as error.
+ */
+
+ bufPtr = AllocChannelBuffer(extra);
+
+ tail->nextAdded -= extra;
+ memcpy(InsertPoint(bufPtr), InsertPoint(tail), extra);
+ bufPtr->nextAdded += extra;
+ bufPtr->nextPtr = tail->nextPtr;
+ tail->nextPtr = NULL;
+ inBytes = csPtr->toRead;
+ }
+
+ /* Update the byte counts */
+ if (csPtr->toRead != -1) {
+ csPtr->toRead -= inBytes;
+ }
+ csPtr->total += inBytes;
+
+ /* Move buffers from input to output channels */
+ if (outStatePtr->outQueueTail) {
+ outStatePtr->outQueueTail->nextPtr = inStatePtr->inQueueHead;
+ } else {
+ outStatePtr->outQueueHead = inStatePtr->inQueueHead;
+ }
+ outStatePtr->outQueueTail = tail;
+ inStatePtr->inQueueHead = bufPtr;
+ if (inStatePtr->inQueueTail == tail) {
+ inStatePtr->inQueueTail = bufPtr;
+ }
+ if (bufPtr == NULL) {
+ inStatePtr->inQueueTail = NULL;
+ }
+
+ code = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0);
+ if (code) {
+ MBError(csPtr, TCL_WRITABLE, code);
+ return TCL_ERROR;
+ }
+ if (csPtr->toRead == 0 || GotFlag(inStatePtr, CHANNEL_EOF)) {
+ return TCL_OK;
+ }
+ return TCL_CONTINUE;
+}
+
+static int
+MoveBytes(
+ CopyState *csPtr) /* State of copy operation. */
+{
+ ChannelState *outStatePtr = csPtr->writePtr->state;
+ ChannelBuffer *bufPtr = outStatePtr->curOutPtr;
+ int errorCode;
+
+ if (bufPtr && BytesLeft(bufPtr)) {
+ /* If we start with unflushed bytes in the destination
+ * channel, flush them out of the way first. */
+
+ errorCode = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0);
+ if (errorCode != 0) {
+ MBError(csPtr, TCL_WRITABLE, errorCode);
+ return TCL_ERROR;
+ }
+ }
+
+ if (csPtr->cmdPtr) {
+ Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
+ Tcl_CreateChannelHandler(inChan, TCL_READABLE, MBEvent, csPtr);
+ return TCL_OK;
+ }
+
+ while (1) {
+ int code;
+
+ if (TCL_ERROR == MBRead(csPtr)) {
+ return TCL_ERROR;
+ }
+ code = MBWrite(csPtr);
+ if (code == TCL_OK) {
+ Tcl_SetObjResult(csPtr->interp, Tcl_NewWideIntObj(csPtr->total));
+ StopCopy(csPtr);
+ return TCL_OK;
+ }
+ if (code == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ /* code == TCL_CONTINUE --> continue the loop */
+ }
+ return TCL_OK; /* Silence compiler warnings */
+}
+
static int
CopyData(
CopyState *csPtr, /* State of copy operation. */
@@ -9379,6 +9489,10 @@ CopyData(
csPtr);
}
if (size == 0) {
+ if (!GotFlag(inStatePtr, CHANNEL_NONBLOCKING)) {
+ /* We allowed a short read. Keep trying. */
+ continue;
+ }
if (bufObj != NULL) {
TclDecrRefCount(bufObj);
bufObj = NULL;
@@ -9399,9 +9513,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);
}
/*
@@ -9556,12 +9670,23 @@ CopyData(
*
* DoRead --
*
- * Reads a given number of bytes from a channel. No encoding conversions
+ * Stores up to "bytesToRead" bytes in memory pointed to by "dst".
+ * These bytes come from reading the channel "chanPtr" and
+ * performing the configured translations. No encoding conversions
* are applied to the bytes being read.
*
* Results:
- * The number of characters read, or -1 on error. Use Tcl_GetErrno() to
- * retrieve the error code for the error that occurred.
+ * The number of bytes actually stored (<= bytesToRead),
+ * or -1 if there is an error in reading the channel. Use
+ * Tcl_GetErrno() to retrieve the error code for the error
+ * that occurred.
+ *
+ * The number of bytes stored can be less than the number
+ * requested when
+ * - EOF is reached on the channel; or
+ * - the channel is non-blocking, and we've read all we can
+ * without blocking.
+ * - a channel reading error occurs (and we return -1)
*
* Side effects:
* May cause input to be buffered.
@@ -9572,538 +9697,197 @@ CopyData(
static int
DoRead(
Channel *chanPtr, /* The channel from which to read. */
- char *bufPtr, /* Where to store input read. */
- int toRead, /* Maximum number of bytes to read. */
+ char *dst, /* Where to store input read. */
+ int bytesToRead, /* Maximum number of bytes to read. */
int allowShortReads) /* Allow half-blocking (pipes,sockets) */
{
ChannelState *statePtr = chanPtr->state;
- /* State info for channel */
- int copied; /* How many characters were copied into the
- * result string? */
- int copiedNow; /* How many characters were copied from the
- * current input buffer? */
- int result; /* Of calling GetInput. */
+ char *p = dst;
- /*
- * If we have not encountered a sticky EOF, clear the EOF bit. Either way
- * clear the BLOCKED bit. We want to discover these anew during each
- * operation.
- */
-
- if (!GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
- ResetFlag(statePtr, CHANNEL_EOF);
- }
- ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
-
- for (copied = 0; copied < toRead; copied += copiedNow) {
- copiedNow = CopyAndTranslateBuffer(statePtr, bufPtr + copied,
- toRead - copied);
- if (copiedNow == 0) {
- if (GotFlag(statePtr, CHANNEL_EOF)) {
- goto done;
- }
- if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
- if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
- goto done;
- }
- ResetFlag(statePtr, CHANNEL_BLOCKED);
- }
- result = GetInput(chanPtr);
- if (result != 0) {
- if (result != EAGAIN) {
- copied = -1;
- }
- goto done;
- }
- } else if (allowShortReads) {
- copied += copiedNow;
- break;
- }
- }
-
- ResetFlag(statePtr, CHANNEL_BLOCKED);
+ assert (bytesToRead >= 0);
/*
- * Update the notifier state so we don't block while there is still data
- * in the buffers.
+ * Early out when we know a read will get the eofchar.
+ *
+ * NOTE: This seems to be a bug. The special handling for
+ * a zero-char read request ought to come first. As coded
+ * the EOF due to eofchar has distinguishing behavior from
+ * the EOF due to reported EOF on the underlying device, and
+ * that seems undesirable. However recent history indicates
+ * that new inconsistent behavior in a patchlevel has problems
+ * too. Keep on keeping on for now.
*/
- done:
- UpdateInterest(chanPtr);
- return copied;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CopyAndTranslateBuffer --
- *
- * Copy at most one buffer of input to the result space, doing eol
- * translations according to mode in effect currently.
- *
- * Results:
- * Number of bytes stored in the result buffer (as opposed to the number
- * of bytes read from the channel). May return zero if no input is
- * available to be translated.
- *
- * Side effects:
- * Consumes buffered input. May deallocate one buffer.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-CopyAndTranslateBuffer(
- ChannelState *statePtr, /* Channel state from which to read input. */
- char *result, /* Where to store the copied input. */
- int space) /* How many bytes are available in result to
- * store the copied input? */
-{
- ChannelBuffer *bufPtr; /* The buffer from which to copy bytes. */
- int bytesInBuffer; /* How many bytes are available to be copied
- * in the current input buffer? */
- int copied; /* How many characters were already copied
- * into the destination space? */
- int i; /* Iterates over the copied input looking for
- * the input eofChar. */
-
- /*
- * If there is no input at all, return zero. The invariant is that either
- * there is no buffer in the queue, or if the first buffer is empty, it is
- * also the last buffer (and thus there is no input in the queue). Note
- * also that if the buffer is empty, we leave it in the queue.
- */
+ if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
+ SetFlag(statePtr, CHANNEL_EOF);
+ assert( statePtr->inputEncodingFlags & TCL_ENCODING_END );
+ assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) );
- if (statePtr->inQueueHead == NULL) {
+ /* TODO: Don't need this call */
+ UpdateInterest(chanPtr);
return 0;
}
- bufPtr = statePtr->inQueueHead;
- bytesInBuffer = BytesLeft(bufPtr);
- copied = 0;
- switch (statePtr->inputTranslation) {
- case TCL_TRANSLATE_LF:
- if (bytesInBuffer == 0) {
- return 0;
+ /* Special handling for zero-char read request. */
+ if (bytesToRead == 0) {
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
+ statePtr->inputEncodingFlags |= TCL_ENCODING_START;
}
+ ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
+ statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
+ /* TODO: Don't need this call */
+ UpdateInterest(chanPtr);
+ return 0;
+ }
+ TclChannelPreserve((Tcl_Channel)chanPtr);
+ while (bytesToRead) {
/*
- * Copy the current chunk into the result buffer.
+ * Each pass through the loop is intended to process up to
+ * one channel buffer.
*/
- if (bytesInBuffer < space) {
- space = bytesInBuffer;
- }
- memcpy(result, RemovePoint(bufPtr), (size_t) space);
- bufPtr->nextRemoved += space;
- copied = space;
- break;
- case TCL_TRANSLATE_CR: {
- char *end;
-
- if (bytesInBuffer == 0) {
- return 0;
- }
+ int bytesRead, bytesWritten;
+ ChannelBuffer *bufPtr = statePtr->inQueueHead;
/*
- * Copy the current chunk into the result buffer, then replace all \r
- * with \n.
+ * Don't read more data if we have what we need.
*/
- if (bytesInBuffer < space) {
- space = bytesInBuffer;
- }
- memcpy(result, RemovePoint(bufPtr), (size_t) space);
- bufPtr->nextRemoved += space;
- copied = space;
+ while (!bufPtr || /* We got no buffer! OR */
+ (!IsBufferFull(bufPtr) && /* Our buffer has room AND */
+ (BytesLeft(bufPtr) < bytesToRead) ) ) {
+ /* Not enough bytes in it
+ * yet to fill the dst */
+ int code;
- for (end = result + copied; result < end; result++) {
- if (*result == '\r') {
- *result = '\n';
- }
- }
- break;
- }
- case TCL_TRANSLATE_CRLF: {
- char *src, *end, *dst;
- int curByte;
+ moreData:
+ code = GetInput(chanPtr);
+ bufPtr = statePtr->inQueueHead;
- /*
- * If there is a held-back "\r" at EOF, produce it now.
- */
+ assert (bufPtr != NULL);
- if (bytesInBuffer == 0) {
- if ((statePtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
- (INPUT_SAW_CR | CHANNEL_EOF)) {
- result[0] = '\r';
- ResetFlag(statePtr, INPUT_SAW_CR);
- return 1;
+ if (GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)) {
+ /* Further reads cannot do any more */
+ break;
}
- return 0;
- }
- /*
- * Copy the current chunk and replace "\r\n" with "\n" (but not
- * standalone "\r"!).
- */
-
- if (bytesInBuffer < space) {
- space = bytesInBuffer;
- }
- memcpy(result, RemovePoint(bufPtr), (size_t) space);
- bufPtr->nextRemoved += space;
- copied = space;
-
- end = result + copied;
- dst = result;
- for (src = result; src < end; src++) {
- curByte = *src;
- if (curByte == '\n') {
- ResetFlag(statePtr, INPUT_SAW_CR);
- } else if (GotFlag(statePtr, INPUT_SAW_CR)) {
- ResetFlag(statePtr, INPUT_SAW_CR);
- *dst = '\r';
- dst++;
- }
- if (curByte == '\r') {
- SetFlag(statePtr, INPUT_SAW_CR);
- } else {
- *dst = (char) curByte;
- dst++;
+ if (code) {
+ /* Read error */
+ UpdateInterest(chanPtr);
+ TclChannelRelease((Tcl_Channel)chanPtr);
+ return -1;
}
- }
- copied = dst - result;
- break;
- }
- case TCL_TRANSLATE_AUTO: {
- char *src, *end, *dst;
- int curByte;
- if (bytesInBuffer == 0) {
- return 0;
+ assert (IsBufferFull(bufPtr));
}
- /*
- * Loop over the current buffer, converting "\r" and "\r\n" to "\n".
- */
+ assert (bufPtr != NULL);
- if (bytesInBuffer < space) {
- space = bytesInBuffer;
- }
- memcpy(result, RemovePoint(bufPtr), (size_t) space);
- bufPtr->nextRemoved += space;
- copied = space;
+ bytesRead = BytesLeft(bufPtr);
+ bytesWritten = bytesToRead;
- end = result + copied;
- dst = result;
- for (src = result; src < end; src++) {
- curByte = *src;
- if (curByte == '\r') {
- SetFlag(statePtr, INPUT_SAW_CR);
- *dst = '\n';
- dst++;
- } else {
- if ((curByte != '\n') || !GotFlag(statePtr, INPUT_SAW_CR)) {
- *dst = (char) curByte;
- dst++;
- }
- ResetFlag(statePtr, INPUT_SAW_CR);
- }
- }
- copied = dst - result;
- break;
- }
- default:
- Tcl_Panic("unknown eol translation mode");
- }
-
- /*
- * If an in-stream EOF character is set for this channel, check that the
- * input we copied so far does not contain the EOF char. If it does, copy
- * only up to and excluding that character.
- */
+ TranslateInputEOL(statePtr, p, RemovePoint(bufPtr),
+ &bytesWritten, &bytesRead);
+ bufPtr->nextRemoved += bytesRead;
+ p += bytesWritten;
+ bytesToRead -= bytesWritten;
- if (statePtr->inEofChar != 0) {
- for (i = 0; i < copied; i++) {
- if (result[i] == (char) statePtr->inEofChar) {
- /*
- * Set sticky EOF so that no further input is presented to the
- * caller.
- */
+ if (!IsBufferEmpty(bufPtr)) {
+ /*
+ * Buffer is not empty. How can that be?
+ *
+ * 0) We stopped early because we got all the bytes
+ * we were seeking. That's fine.
+ */
- SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
- statePtr->inputEncodingFlags |= TCL_ENCODING_END;
- copied = i;
+ if (bytesToRead == 0) {
break;
}
- }
- }
-
- /*
- * If the current buffer is empty recycle it.
- */
-
- if (IsBufferEmpty(bufPtr)) {
- statePtr->inQueueHead = bufPtr->nextPtr;
- if (statePtr->inQueueHead == NULL) {
- statePtr->inQueueTail = NULL;
- }
- RecycleBuffer(statePtr, bufPtr, 0);
- }
-
- /*
- * Return the number of characters copied into the result buffer. This may
- * be different from the number of bytes consumed, because of EOL
- * translations.
- */
-
- return copied;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CopyBuffer --
- *
- * Copy at most one buffer of input to the result space.
- *
- * Results:
- * Number of bytes stored in the result buffer. May return zero if no
- * input is available.
- *
- * Side effects:
- * Consumes buffered input. May deallocate one buffer.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-CopyBuffer(
- Channel *chanPtr, /* Channel from which to read input. */
- char *result, /* Where to store the copied input. */
- int space) /* How many bytes are available in result to
- * store the copied input? */
-{
- ChannelBuffer *bufPtr; /* The buffer from which to copy bytes. */
- int bytesInBuffer; /* How many bytes are available to be copied
- * in the current input buffer? */
- int copied; /* How many characters were already copied
- * into the destination space? */
-
- /*
- * If there is no input at all, return zero. The invariant is that either
- * there is no buffer in the queue, or if the first buffer is empty, it is
- * also the last buffer (and thus there is no input in the queue). Note
- * also that if the buffer is empty, we don't leave it in the queue, but
- * recycle it.
- */
-
- if (chanPtr->inQueueHead == NULL) {
- return 0;
- }
- bufPtr = chanPtr->inQueueHead;
- bytesInBuffer = BytesLeft(bufPtr);
- copied = 0;
-
- if (bytesInBuffer == 0) {
- RecycleBuffer(chanPtr->state, bufPtr, 0);
- chanPtr->inQueueHead = NULL;
- chanPtr->inQueueTail = NULL;
- return 0;
- }
-
- /*
- * Copy the current chunk into the result buffer.
- */
-
- if (bytesInBuffer < space) {
- space = bytesInBuffer;
- }
-
- memcpy(result, RemovePoint(bufPtr), (size_t) space);
- bufPtr->nextRemoved += space;
- copied = space;
-
- /*
- * We don't care about in-stream EOF characters here as the data read here
- * may still flow through one or more transformations, i.e. is not in its
- * final state yet.
- */
-
- /*
- * If the current buffer is empty recycle it.
- */
-
- if (IsBufferEmpty(bufPtr)) {
- chanPtr->inQueueHead = bufPtr->nextPtr;
- if (chanPtr->inQueueHead == NULL) {
- chanPtr->inQueueTail = NULL;
- }
- RecycleBuffer(chanPtr->state, bufPtr, 0);
- }
+ /*
+ * 1) We're @EOF because we saw eof char.
+ */
- /*
- * Return the number of characters copied into the result buffer.
- */
+ if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
+ break;
+ }
- return copied;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
+ /*
+ * 2) The buffer holds a \r while in CRLF translation,
+ * followed by the end of the buffer.
+ */
-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? */
+ assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF);
+ assert(RemovePoint(bufPtr)[0] == '\r');
+ assert(BytesLeft(bufPtr) == 1);
- /*
- * If we are in network (or windows) translation mode, record the fact
- * that we have not yet sent a CR to the channel.
- */
+ if (bufPtr->nextPtr == NULL) {
+ /* There's no more buffered data.... */
- crsent = 0;
+ if (statePtr->flags & CHANNEL_EOF) {
+ /* ...and there never will be. */
- /*
- * Loop filling buffers and flushing them until all output has been
- * consumed.
- */
+ *p++ = '\r';
+ bytesToRead--;
+ bufPtr->nextRemoved++;
+ } else if (statePtr->flags & CHANNEL_BLOCKED) {
+ /* ...and we cannot get more now. */
+ SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
+ break;
+ } else {
+ /* ... so we need to get some. */
+ goto moreData;
+ }
+ }
- srcCopied = 0;
- totalDestCopied = 0;
+ if (bufPtr->nextPtr) {
+ /* There's a next buffer. Shift orphan \r to it. */
- while (srcLen > 0) {
- /*
- * Make sure there is a current output buffer to accept output.
- */
+ ChannelBuffer *nextPtr = bufPtr->nextPtr;
- if (statePtr->curOutPtr == NULL) {
- statePtr->curOutPtr = AllocChannelBuffer(statePtr->bufSize);
+ nextPtr->nextRemoved -= 1;
+ RemovePoint(nextPtr)[0] = '\r';
+ bufPtr->nextRemoved++;
+ }
}
- outBufPtr = statePtr->curOutPtr;
-
- destCopied = SpaceLeft(outBufPtr);
- if (destCopied > srcLen) {
- destCopied = srcLen;
+ if (IsBufferEmpty(bufPtr)) {
+ statePtr->inQueueHead = bufPtr->nextPtr;
+ if (statePtr->inQueueHead == NULL) {
+ statePtr->inQueueTail = NULL;
+ }
+ RecycleBuffer(statePtr, bufPtr, 0);
+ bufPtr = statePtr->inQueueHead;
}
- 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';
- }
- }
+ if ((GotFlag(statePtr, CHANNEL_NONBLOCKING) || allowShortReads)
+ && GotFlag(statePtr, CHANNEL_BLOCKED)) {
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.
+ * When there's no buffered data to read, and we're at EOF,
+ * escape to the caller.
*/
- 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;
- }
+ if (GotFlag(statePtr, CHANNEL_EOF)
+ && (bufPtr == NULL || IsBufferEmpty(bufPtr))) {
+ break;
}
- } /* Closes "while" */
+ }
+ if (bytesToRead == 0) {
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
+ }
- return totalDestCopied;
+ assert(!GotFlag(statePtr, CHANNEL_EOF)
+ || GotFlag(statePtr, CHANNEL_STICKY_EOF)
+ || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
+ assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
+ == (CHANNEL_EOF|CHANNEL_BLOCKED)) );
+ UpdateInterest(chanPtr);
+ TclChannelRelease((Tcl_Channel)chanPtr);
+ return (int)(p - dst);
}
/*
@@ -10154,12 +9938,16 @@ StopCopy(
CopyState *csPtr) /* State for bg copy to stop . */
{
ChannelState *inStatePtr, *outStatePtr;
+ Tcl_Channel inChan, outChan;
+
int nonBlocking;
if (!csPtr) {
return;
}
+ inChan = (Tcl_Channel) csPtr->readPtr;
+ outChan = (Tcl_Channel) csPtr->writePtr;
inStatePtr = csPtr->readPtr->state;
outStatePtr = csPtr->writePtr->state;
@@ -10184,12 +9972,12 @@ StopCopy(
csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
if (csPtr->cmdPtr) {
- Tcl_DeleteChannelHandler((Tcl_Channel) csPtr->readPtr, CopyEventProc,
- csPtr);
- if (csPtr->readPtr != csPtr->writePtr) {
- Tcl_DeleteChannelHandler((Tcl_Channel) csPtr->writePtr,
- CopyEventProc, csPtr);
+ Tcl_DeleteChannelHandler(inChan, CopyEventProc, csPtr);
+ if (inChan != outChan) {
+ Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr);
}
+ Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr);
+ Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr);
TclDecrRefCount(csPtr->cmdPtr);
}
inStatePtr->csPtrR = NULL;
@@ -10223,12 +10011,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) {
@@ -11331,12 +11122,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;
}
/*
@@ -11362,43 +11152,30 @@ 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) {
/*
+ * TODO: TAINT Flag and dup'd channel values?
* 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;
+ if (objPtr->typePtr != &chanObjType) {
+ Tcl_Channel chan = Tcl_GetChannel(interp, TclGetString(objPtr), NULL);
- /*
- * 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);
- }
-
- chan = Tcl_GetChannel(interp, objPtr->bytes, NULL);
if (chan == NULL) {
return TCL_ERROR;
}
@@ -11408,7 +11185,7 @@ SetChannelFromAny(
Tcl_Preserve(statePtr);
SET_CHANNELSTATE(objPtr, statePtr);
SET_CHANNELINTERP(objPtr, interp);
- objPtr->typePtr = &tclChannelType;
+ objPtr->typePtr = &chanObjType;
}
return TCL_OK;
}
@@ -11416,45 +11193,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.
@@ -11497,20 +11235,14 @@ DumpFlags(
ChanFlag('n', CHANNEL_NONBLOCKING);
ChanFlag('l', CHANNEL_LINEBUFFERED);
ChanFlag('u', CHANNEL_UNBUFFERED);
- ChanFlag('R', BUFFER_READY);
ChanFlag('F', BG_FLUSH_SCHEDULED);
ChanFlag('c', CHANNEL_CLOSED);
ChanFlag('E', CHANNEL_EOF);
ChanFlag('S', CHANNEL_STICKY_EOF);
ChanFlag('B', CHANNEL_BLOCKED);
ChanFlag('/', INPUT_SAW_CR);
- ChanFlag('*', INPUT_NEED_NL);
ChanFlag('D', CHANNEL_DEAD);
ChanFlag('R', CHANNEL_RAW_MODE);
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- ChanFlag('T', CHANNEL_TIMER_FEV);
- ChanFlag('H', CHANNEL_HAS_MORE_DATA);
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
ChanFlag('x', CHANNEL_INCLOSE);
buf[i] ='\0';
diff --git a/generic/tclIO.h b/generic/tclIO.h
index e84f300..b799375 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -36,6 +36,7 @@
*/
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
@@ -111,6 +112,8 @@ typedef struct Channel {
ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */
ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */
+
+ int refCount;
} Channel;
/*
@@ -123,7 +126,7 @@ typedef struct Channel {
*/
typedef struct ChannelState {
- const char *channelName; /* The name of the channel instance in Tcl
+ char *channelName; /* The name of the channel instance in Tcl
* commands. Storage is owned by the generic
* IO code, is dynamically allocated. */
int flags; /* ORed combination of the flags defined
@@ -226,11 +229,6 @@ typedef struct ChannelState {
* flushed after every newline. */
#define CHANNEL_UNBUFFERED (1<<5) /* Output to the channel must always
* be flushed immediately. */
-#define BUFFER_READY (1<<6) /* Current output buffer (the
- * curOutPtr field in the channel
- * structure) should be output as soon
- * as possible even though it may not
- * be full. */
#define BG_FLUSH_SCHEDULED (1<<7) /* A background flush of the queued
* output buffers has been
* scheduled. */
@@ -252,9 +250,6 @@ typedef struct ChannelState {
#define INPUT_SAW_CR (1<<12) /* Channel is in CRLF eol input
* translation mode and the last byte
* seen was a "\r". */
-#define INPUT_NEED_NL (1<<15) /* Saw a '\r' at end of last buffer,
- * and there should be a '\n' at
- * beginning of next buffer. */
#define CHANNEL_DEAD (1<<13) /* The channel has been closed by the
* exit handler (on exit) but not
* deallocated. When any IO operation
@@ -274,29 +269,6 @@ typedef struct ChannelState {
* changes. */
#define CHANNEL_RAW_MODE (1<<16) /* When set, notes that the Raw API is
* being used. */
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-#define CHANNEL_TIMER_FEV (1<<17) /* When set the event we are notified
- * by is a fileevent generated by a
- * timer. We don't know if the driver
- * has more data and should not try to
- * read from it. If the system needs
- * more than is in the buffers out
- * read routines will simulate a short
- * read (0 characters read) */
-#define CHANNEL_HAS_MORE_DATA (1<<18) /* Set by NotifyChannel for a channel
- * if and only if the channel is
- * configured non-blocking, the driver
- * for said channel has no
- * blockmodeproc, and data has arrived
- * for reading at the OS level). A
- * GetInput will pass reading from the
- * driver if the channel is
- * non-blocking, without blockmode
- * proc and the flag has not been set.
- * A read will be performed if the
- * flag is set. This will reset the
- * flag as well. */
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
#define CHANNEL_INCLOSE (1<<19) /* Channel is currently being closed.
* Its structures are still live and
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 1673bce..834f225 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -181,6 +181,7 @@ Tcl_PutsObjCmd(
return TCL_ERROR;
}
+ TclChannelPreserve(chan);
result = Tcl_WriteObj(chan, string);
if (result < 0) {
goto error;
@@ -191,6 +192,7 @@ Tcl_PutsObjCmd(
goto error;
}
}
+ TclChannelRelease(chan);
return TCL_OK;
/*
@@ -205,6 +207,7 @@ Tcl_PutsObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf("error writing \"%s\": %s",
TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
+ TclChannelRelease(chan);
return TCL_ERROR;
}
@@ -252,6 +255,7 @@ Tcl_FlushObjCmd(
return TCL_ERROR;
}
+ TclChannelPreserve(chan);
if (Tcl_Flush(chan) != TCL_OK) {
/*
* TIP #219.
@@ -265,8 +269,10 @@ Tcl_FlushObjCmd(
"error flushing \"%s\": %s",
TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
+ TclChannelRelease(chan);
return TCL_ERROR;
}
+ TclChannelRelease(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;
}
+ TclChannelPreserve(chan);
linePtr = Tcl_NewObj();
lineLen = Tcl_GetsObj(chan, linePtr);
if (lineLen < 0) {
@@ -333,20 +341,24 @@ Tcl_GetsObjCmd(
"error reading \"%s\": %s",
TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
- return TCL_ERROR;
+ code = TCL_ERROR;
+ goto done;
}
lineLen = -1;
}
if (objc == 3) {
if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr,
TCL_LEAVE_ERR_MSG) == NULL) {
- return TCL_ERROR;
+ code = TCL_ERROR;
+ goto done;
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen));
} else {
Tcl_SetObjResult(interp, linePtr);
}
- return TCL_OK;
+ done:
+ TclChannelRelease(chan);
+ return code;
}
/*
@@ -453,6 +465,7 @@ Tcl_ReadObjCmd(
resultPtr = Tcl_NewObj();
Tcl_IncrRefCount(resultPtr);
+ TclChannelPreserve(chan);
charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
if (charactersRead < 0) {
/*
@@ -467,6 +480,7 @@ Tcl_ReadObjCmd(
"error reading \"%s\": %s",
TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
+ TclChannelRelease(chan);
Tcl_DecrRefCount(resultPtr);
return TCL_ERROR;
}
@@ -485,6 +499,7 @@ Tcl_ReadObjCmd(
}
}
Tcl_SetObjResult(interp, resultPtr);
+ TclChannelRelease(chan);
Tcl_DecrRefCount(resultPtr);
return TCL_OK;
}
@@ -544,6 +559,7 @@ Tcl_SeekObjCmd(
mode = modeArray[optionIndex];
}
+ TclChannelPreserve(chan);
result = Tcl_Seek(chan, offset, mode);
if (result == Tcl_LongAsWide(-1)) {
/*
@@ -558,8 +574,10 @@ Tcl_SeekObjCmd(
"error during seek on \"%s\": %s",
TclGetString(objv[1]), Tcl_PosixError(interp)));
}
+ TclChannelRelease(chan);
return TCL_ERROR;
}
+ TclChannelRelease(chan);
return TCL_OK;
}
@@ -590,6 +608,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 +624,7 @@ Tcl_TellObjCmd(
return TCL_ERROR;
}
+ TclChannelPreserve(chan);
newLoc = Tcl_Tell(chan);
/*
@@ -613,7 +633,10 @@ Tcl_TellObjCmd(
* them into the regular interpreter result.
*/
- if (TclChanCaughtErrorBypass(interp, chan)) {
+
+ code = TclChanCaughtErrorBypass(interp, chan);
+ TclChannelRelease(chan);
+ if (code) {
return TCL_ERROR;
}
@@ -896,7 +919,7 @@ Tcl_ExecObjCmd(
if (string[0] != '-') {
break;
}
- if (Tcl_GetIndexFromObj(interp, objv[skip], options, "switch",
+ if (Tcl_GetIndexFromObj(interp, objv[skip], options, "option",
TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
@@ -910,7 +933,7 @@ Tcl_ExecObjCmd(
}
}
if (objc <= skip) {
- Tcl_WrongNumArgs(interp, 1, objv, "?-switch ...? arg ?arg ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "?-option ...? arg ?arg ...?");
return TCL_ERROR;
}
@@ -1673,7 +1696,7 @@ Tcl_FcopyObjCmd(
toRead = -1;
cmdPtr = NULL;
for (i = 3; i < objc; i += 2) {
- if (Tcl_GetIndexFromObj(interp, objv[i], switches, "switch", 0,
+ if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index bfe6a10..7f61def 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -187,6 +187,7 @@ struct TransformChannelData {
Tcl_Channel self; /* Our own Channel handle. */
int readIsFlushed; /* Flag to note whether in.flushProc was
* called or not. */
+ int eofPending; /* Flag: EOF seen down, not raised up */
int flags; /* Currently CHANNEL_ASYNC or zero. */
int watchMask; /* Current watch/event/interest mask. */
int mode; /* Mode of parent channel, OR'ed combination
@@ -210,7 +211,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 +261,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 +269,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,16 +289,17 @@ TclChannelTransform(
dataPtr = ckalloc(sizeof(TransformChannelData));
+ dataPtr->refCount = 1;
Tcl_DStringInit(&ds);
Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
dataPtr->readIsFlushed = 0;
+ dataPtr->eofPending = 0;
dataPtr->flags = 0;
if (ds.string[0] == '0') {
dataPtr->flags |= CHANNEL_ASYNC;
}
Tcl_DStringFree(&ds);
- dataPtr->self = chan;
dataPtr->watchMask = 0;
dataPtr->mode = mode;
dataPtr->timer = NULL;
@@ -286,19 +315,20 @@ 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;
}
+ Tcl_Preserve(dataPtr->self);
/*
* 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 +337,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 +382,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 +396,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 +417,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 +439,26 @@ ExecuteCallback(
break;
case TRANSMIT_DOWN:
- resObj = Tcl_GetObjResult(dataPtr->interp);
+ if (dataPtr->self == NULL) {
+ break;
+ }
+ 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);
+ if (dataPtr->self == NULL) {
+ break;
+ }
+ 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 +468,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 +561,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 +581,15 @@ 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);
+ Tcl_Release(dataPtr->self);
+ dataPtr->self = NULL;
+ ReleaseData(dataPtr);
return TCL_OK;
}
@@ -596,9 +624,9 @@ TransformInputProc(
* Should assert(dataPtr->mode & TCL_READABLE);
*/
- if (toRead == 0) {
+ if (toRead == 0 || dataPtr->self == NULL) {
/*
- * Catch a no-op.
+ * Catch a no-op. TODO: Is this a panic()?
*/
return 0;
}
@@ -606,6 +634,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 +652,7 @@ TransformInputProc(
* break out of the loop and return to the caller.
*/
- return gotBytes;
+ break;
}
/*
@@ -647,7 +676,18 @@ TransformInputProc(
}
} /* else: 'maxRead < 0' == Accept the current value of toRead. */
if (toRead <= 0) {
- return gotBytes;
+ break;
+ }
+ if (dataPtr->eofPending) {
+ /*
+ * Already saw EOF from downChan; don't ask again.
+ * NOTE: Could move this up to avoid the last maxRead
+ * execution. Believe this would still be correct behavior,
+ * but the test suite tests the whole command callback
+ * sequence, so leave it unchanged for now.
+ */
+
+ break;
}
/*
@@ -656,45 +696,35 @@ TransformInputProc(
read = Tcl_ReadRaw(downChan, buf, toRead);
if (read < 0) {
- /*
- * Report errors to caller. EAGAIN is a special situation. If we
- * had some data before we report that instead of the request to
- * re-try.
- */
+ if (Tcl_InputBlocked(downChan) && (gotBytes > 0)) {
+ /*
+ * Zero bytes available from downChan because blocked.
+ * But nonzero bytes already copied, so total is a
+ * valid blocked short read. Return to caller.
+ */
- if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) {
- return gotBytes;
+ break;
}
- *errorCodePtr = Tcl_GetErrno();
- return -1;
- } else if (read == 0) {
/*
- * Check wether we hit on EOF in the underlying channel or not. If
- * not differentiate between blocking and non-blocking modes. In
- * non-blocking mode we ran temporarily out of data. Signal this
- * to the caller via EWOULDBLOCK and error return (-1). In the
- * other cases we simply return what we got and let the caller
- * wait for more. On the other hand, if we got an EOF we have to
- * convert and flush all waiting partial data.
+ * Either downChan is not blocked (there's a real error).
+ * or it is and there are no bytes copied yet. In either
+ * case we want to pass the "error" along to the caller,
+ * either to report an error, or to signal to the caller
+ * that zero bytes are available because blocked.
*/
- if (!Tcl_Eof(downChan)) {
- if ((gotBytes == 0) && (dataPtr->flags & CHANNEL_ASYNC)) {
- *errorCodePtr = EWOULDBLOCK;
- return -1;
- }
- return gotBytes;
- }
-
- if (dataPtr->readIsFlushed) {
- /*
- * Already flushed, nothing to do anymore.
- */
+ *errorCodePtr = Tcl_GetErrno();
+ gotBytes = -1;
+ break;
+ } else if (read == 0) {
- return gotBytes;
- }
+ /*
+ * Zero returned from Tcl_ReadRaw() always indicates EOF
+ * on the down channel.
+ */
+ dataPtr->eofPending = 1;
dataPtr->readIsFlushed = 1;
ExecuteCallback(dataPtr, NULL, A_FLUSH_READ, NULL, 0,
TRANSMIT_IBUF, P_PRESERVE);
@@ -704,7 +734,7 @@ TransformInputProc(
* We had nothing to flush.
*/
- return gotBytes;
+ break;
}
continue; /* at: while (toRead > 0) */
@@ -718,10 +748,15 @@ 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 */
+ if (gotBytes == 0) {
+ dataPtr->eofPending = 0;
+ }
+ ReleaseData(dataPtr);
return gotBytes;
}
@@ -762,11 +797,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 +856,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);
@@ -829,7 +867,9 @@ TransformSeekProc(
P_NO_PRESERVE);
ResultClear(&dataPtr->result);
dataPtr->readIsFlushed = 0;
+ dataPtr->eofPending = 0;
}
+ ReleaseData(dataPtr);
return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, mode,
errorCodePtr);
@@ -890,6 +930,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);
@@ -900,7 +941,9 @@ TransformWideSeekProc(
P_NO_PRESERVE);
ResultClear(&dataPtr->result);
dataPtr->readIsFlushed = 0;
+ dataPtr->eofPending = 0;
}
+ ReleaseData(dataPtr);
/*
* If we have a wide seek capability, we should stick with that.
@@ -1055,6 +1098,9 @@ TransformWatchProc(
* unchanged.
*/
+ if (dataPtr->self == NULL) {
+ return;
+ }
downChan = Tcl_GetStackedChannel(dataPtr->self);
Tcl_GetChannelType(downChan)->watchProc(
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index cb0282a..f476a1a 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,15 +428,15 @@ 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);
static void DeleteReflectedChannelMap(ClientData clientData,
Tcl_Interp *interp);
static int ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj *resObj);
+static void MarkDead(ReflectedChannel *rcPtr);
/*
* Global constant strings (messages). ==================
@@ -467,16 +445,14 @@ 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}";
#ifdef TCL_THREADS
static const char *msg_send_originlost = "{Channel thread lost}";
-static const char *msg_send_dstlost = "{Owner lost}";
#endif /* TCL_THREADS */
+static const char *msg_send_dstlost = "{Owner lost}";
static const char *msg_dstlost = "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}";
/*
@@ -583,10 +559,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 +572,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 +655,11 @@ TclChanCreateObjCmd(
* Everything is fine now.
*/
- rcPtr->methods = methods;
+ chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr,
+ mode);
+ rcPtr->chan = chan;
+ TclChannelPreserve(chan);
+ chanPtr = (Channel *) chan;
if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) {
/*
@@ -744,12 +720,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
@@ -1138,6 +1112,7 @@ ReflectClose(
ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in
* this interp */
Tcl_HashEntry *hPtr; /* Entry in the above map */
+ const Tcl_ChannelType *tctPtr;
if (TclInThreadExit()) {
/*
@@ -1175,18 +1150,11 @@ ReflectClose(
}
#endif
- Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
- return EOK;
- }
-
- /*
- * -- 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) {
+ tctPtr = ((Channel *)rcPtr->chan)->typePtr;
+ if (tctPtr && tctPtr != &tclRChannelType) {
+ ckfree((char *)tctPtr);
+ ((Channel *)rcPtr->chan)->typePtr = NULL;
+ }
Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
return EOK;
}
@@ -1208,14 +1176,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);
}
@@ -1251,12 +1217,14 @@ ReflectClose(
if (hPtr) {
Tcl_DeleteHashEntry(hPtr);
}
-#endif
-
- Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
-#ifdef TCL_THREADS
}
#endif
+ tctPtr = ((Channel *)rcPtr->chan)->typePtr;
+ if (tctPtr && tctPtr != &tclRChannelType) {
+ ckfree((char *)tctPtr);
+ ((Channel *)rcPtr->chan)->typePtr = NULL;
+ }
+ Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
return (result == TCL_OK) ? EOK : EINVAL;
}
@@ -1290,18 +1258,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 +1295,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 +1361,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?
*/
@@ -1450,11 +1394,12 @@ ReflectOutput(
/* ASSERT: rcPtr->mode & TCL_WRITABLE */
Tcl_Preserve(rcPtr);
+ Tcl_Preserve(rcPtr->interp);
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) {
@@ -1466,6 +1411,14 @@ ReflectOutput(
goto invalid;
}
+ if (Tcl_InterpDeleted(rcPtr->interp)) {
+ /*
+ * The interp was destroyed during InvokeTclMethod().
+ */
+
+ SetChannelErrorStr(rcPtr->chan, msg_send_dstlost);
+ goto invalid;
+ }
if (Tcl_GetIntFromObj(rcPtr->interp, resObj, &written) != TCL_OK) {
Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
goto invalid;
@@ -1495,6 +1448,7 @@ ReflectOutput(
stop:
Tcl_DecrRefCount(bufObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ Tcl_Release(rcPtr->interp);
Tcl_Release(rcPtr);
return written;
invalid:
@@ -1568,7 +1522,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 +1593,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.
@@ -1657,8 +1609,6 @@ ReflectWatch(
return;
}
- rcPtr->interest = mask;
-
/*
* Are we in the correct thread?
*/
@@ -1681,9 +1631,10 @@ ReflectWatch(
Tcl_Preserve(rcPtr);
+ rcPtr->interest = mask;
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 +1693,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 +1805,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 +1850,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 +1889,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 +2110,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 +2125,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,45 +2182,21 @@ 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)
{
Channel *chanPtr = (Channel *) rcPtr->chan;
- if (chanPtr->typePtr != &tclRChannelType) {
- /*
- * Delete a cloned ChannelType structure.
- */
-
- ckfree(chanPtr->typePtr);
- chanPtr->typePtr = NULL;
+ TclChannelRelease((Tcl_Channel)chanPtr);
+ if (rcPtr->name) {
+ Tcl_DecrRefCount(rcPtr->name);
+ }
+ if (rcPtr->methods) {
+ Tcl_DecrRefCount(rcPtr->methods);
+ }
+ if (rcPtr->cmd) {
+ Tcl_DecrRefCount(rcPtr->cmd);
}
-
- FreeReflectedChannelArgs(rcPtr);
-
- ckfree(rcPtr->argv);
ckfree(rcPtr);
}
@@ -2340,16 +2227,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 +2259,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 +2277,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 +2289,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 +2318,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 +2331,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).
@@ -2590,6 +2462,28 @@ GetReflectedChannelMap(
*/
static void
+MarkDead(
+ ReflectedChannel *rcPtr)
+{
+ if (rcPtr->dead) {
+ return;
+ }
+ if (rcPtr->name) {
+ Tcl_DecrRefCount(rcPtr->name);
+ rcPtr->name = NULL;
+ }
+ if (rcPtr->methods) {
+ Tcl_DecrRefCount(rcPtr->methods);
+ rcPtr->methods = NULL;
+ }
+ if (rcPtr->cmd) {
+ Tcl_DecrRefCount(rcPtr->cmd);
+ rcPtr->cmd = NULL;
+ }
+ rcPtr->dead = 1;
+}
+
+static void
DeleteReflectedChannelMap(
ClientData clientData, /* The per-interpreter data structure. */
Tcl_Interp *interp) /* The interpreter being deleted. */
@@ -2624,7 +2518,7 @@ DeleteReflectedChannelMap(
chan = Tcl_GetHashValue(hPtr);
rcPtr = Tcl_GetChannelInstanceData(chan);
- rcPtr->dead = 1;
+ MarkDead(rcPtr);
Tcl_DeleteHashEntry(hPtr);
}
Tcl_DeleteHashTable(&rcmPtr->map);
@@ -2657,6 +2551,11 @@ DeleteReflectedChannelMap(
/*
* The receiver for the event exited, before processing the event. We
* detach the result now, wake the originator up and signal failure.
+ *
+ * Attention: Results may have been detached already, by either the
+ * receiver, or this thread, as part of other parts in the thread
+ * teardown. Such results are ignored. See ticket [b47b176adf] for the
+ * identical race condition in Tcl 8.6 IORTrans.
*/
evPtr = resultPtr->evPtr;
@@ -2666,6 +2565,9 @@ DeleteReflectedChannelMap(
continue;
}
paramPtr = evPtr->param;
+ if (!evPtr) {
+ continue;
+ }
evPtr->resultPtr = NULL;
resultPtr->evPtr = NULL;
@@ -2699,8 +2601,7 @@ DeleteReflectedChannelMap(
continue;
}
- rcPtr->dead = 1;
- FreeReflectedChannelArgs(rcPtr);
+ MarkDead(rcPtr);
Tcl_DeleteHashEntry(hPtr);
}
#endif
@@ -2797,6 +2698,11 @@ DeleteThreadReflectedChannelMap(
/*
* The receiver for the event exited, before processing the event. We
* detach the result now, wake the originator up and signal failure.
+ *
+ * Attention: Results may have been detached already, by either the
+ * receiver, or this thread, as part of other parts in the thread
+ * teardown. Such results are ignored. See ticket [b47b176adf] for the
+ * identical race condition in Tcl 8.6 IORTrans.
*/
evPtr = resultPtr->evPtr;
@@ -2806,6 +2712,9 @@ DeleteThreadReflectedChannelMap(
continue;
}
paramPtr = evPtr->param;
+ if (!evPtr) {
+ continue;
+ }
evPtr->resultPtr = NULL;
resultPtr->evPtr = NULL;
@@ -2839,8 +2748,7 @@ DeleteThreadReflectedChannelMap(
Tcl_Channel chan = Tcl_GetHashValue(hPtr);
ReflectedChannel *rcPtr = Tcl_GetChannelInstanceData(chan);
- rcPtr->dead = 1;
- FreeReflectedChannelArgs(rcPtr);
+ MarkDead(rcPtr);
Tcl_DeleteHashEntry(hPtr);
}
ckfree(rcmPtr);
@@ -3018,17 +2926,17 @@ ForwardProc(
* call upon for the driver.
*/
- case ForwardedClose:
+ case ForwardedClose: {
/*
* 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
*
@@ -3046,16 +2954,16 @@ ForwardProc(
hPtr = Tcl_FindHashEntry(&rcmPtr->map,
Tcl_GetChannelName(rcPtr->chan));
Tcl_DeleteHashEntry(hPtr);
-
- FreeReflectedChannelArgs(rcPtr);
+ MarkDead(rcPtr);
break;
+ }
case ForwardedInput: {
Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead);
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 +3003,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 +3046,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 +3082,8 @@ ForwardProc(
/* assert maskObj.refCount == 1 */
Tcl_Preserve(rcPtr);
- (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL);
+ rcPtr->interest = paramPtr->watch.mask;
+ (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL);
Tcl_DecrRefCount(maskObj);
Tcl_Release(rcPtr);
break;
@@ -3185,7 +3094,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 +3110,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 +3129,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 +3145,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/tclIORTrans.c b/generic/tclIORTrans.c
index 1de635f..af86ba5 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -161,6 +161,7 @@ typedef struct {
int mode; /* Mask of R/W mode */
int nonblocking; /* Flag: Channel is blocking or not. */
int readIsDrained; /* Flag: Read buffers are flushed. */
+ int eofPending; /* Flag: EOF seen down, but not raised up */
int dead; /* Boolean signal that some operations
* should no longer be attempted. */
ResultBuffer result;
@@ -457,8 +458,7 @@ static void TimerKill(ReflectedTransform *rtPtr);
static void TimerSetup(ReflectedTransform *rtPtr);
static void TimerRun(ClientData clientData);
static int TransformRead(ReflectedTransform *rtPtr,
- int *errorCodePtr, unsigned char *buf,
- int toRead);
+ int *errorCodePtr, Tcl_Obj *bufObj);
static int TransformWrite(ReflectedTransform *rtPtr,
int *errorCodePtr, unsigned char *buf,
int toWrite);
@@ -943,7 +943,7 @@ ReflectClose(
Tcl_EventuallyFree(rtPtr,
(Tcl_FreeProc *) FreeReflectedTransform);
return errorCode;
- }
+ }
#endif /* TCL_THREADS */
errorCodeSet = 1;
goto cleanup;
@@ -957,7 +957,7 @@ ReflectClose(
Tcl_EventuallyFree(rtPtr,
(Tcl_FreeProc *) FreeReflectedTransform);
return errorCode;
- }
+ }
#endif /* TCL_THREADS */
errorCodeSet = 1;
goto cleanup;
@@ -1063,6 +1063,7 @@ ReflectInput(
{
ReflectedTransform *rtPtr = clientData;
int gotBytes, copied, readBytes;
+ Tcl_Obj *bufObj;
/*
* The following check can be done before thread redirection, because we
@@ -1078,7 +1079,14 @@ ReflectInput(
Tcl_Preserve(rtPtr);
+ /* TODO: Consider a more appropriate buffer size. */
+ bufObj = Tcl_NewByteArrayObj(NULL, toRead);
+ Tcl_IncrRefCount(bufObj);
gotBytes = 0;
+ if (rtPtr->eofPending) {
+ goto stop;
+ }
+ rtPtr->readIsDrained = 0;
while (toRead > 0) {
/*
* Loop until the request is satisfied (or no data available from
@@ -1094,6 +1102,11 @@ ReflectInput(
goto stop;
}
+ if (rtPtr->eofPending) {
+ goto stop;
+ }
+
+
/*
* The buffer is exhausted, but the caller wants even more. We now
* have to go to the underlying channel, get more bytes and then
@@ -1129,55 +1142,41 @@ ReflectInput(
goto stop;
}
- readBytes = Tcl_ReadRaw(rtPtr->parent, buf, toRead);
+
+ readBytes = Tcl_ReadRaw(rtPtr->parent,
+ (char *) Tcl_SetByteArrayLength(bufObj, toRead), toRead);
if (readBytes < 0) {
- /*
- * Report errors to caller. The state of the seek system is
- * unchanged!
- */
+ if (Tcl_InputBlocked(rtPtr->parent) && (gotBytes > 0)) {
- if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) {
/*
- * EAGAIN is a special situation. If we had some data before
- * we report that instead of the request to re-try.
+ * Down channel is blocked and offers zero additional bytes.
+ * The nonzero gotBytes already returned makes the total
+ * operation a valid short read. Return to caller.
*/
goto stop;
}
+ /*
+ * Either the down channel is not blocked (a real error)
+ * or it is and there are gotBytes==0 byte copied so far.
+ * In either case, pass up the error, so we either report
+ * any real error, or do not mistakenly signal EOF by
+ * returning 0 to the caller.
+ */
+
*errorCodePtr = Tcl_GetErrno();
goto error;
}
if (readBytes == 0) {
+
/*
- * Check wether we hit on EOF in 'parent' or not. If not
- * differentiate between blocking and non-blocking modes. In
- * non-blocking mode we ran temporarily out of data. Signal this
- * to the caller via EWOULDBLOCK and error return (-1). In the
- * other cases we simply return what we got and let the caller
- * wait for more. On the other hand, if we got an EOF we have to
- * convert and flush all waiting partial data.
+ * Zero returned from Tcl_ReadRaw() always indicates EOF
+ * on the down channel.
*/
- if (!Tcl_Eof(rtPtr->parent)) {
- /*
- * The state of the seek system is unchanged!
- */
-
- if ((gotBytes == 0) && rtPtr->nonblocking) {
- *errorCodePtr = EWOULDBLOCK;
- goto error;
- }
- goto stop;
- } else {
- /*
- * Eof in parent.
- */
-
- if (rtPtr->readIsDrained) {
- goto stop;
- }
+ rtPtr->eofPending = 1;
/*
* Now this is a bit different. The partial data waiting is
@@ -1198,13 +1197,7 @@ ReflectInput(
goto stop;
}
- /*
- * Reset eof, force caller to drain result buffer.
- */
-
- ((Channel *) rtPtr->parent)->state->flags &= ~CHANNEL_EOF;
continue; /* at: while (toRead > 0) */
- }
} /* readBytes == 0 */
/*
@@ -1213,12 +1206,23 @@ ReflectInput(
* iteration will put it into the result.
*/
- if (!TransformRead(rtPtr, errorCodePtr, UCHARP(buf), readBytes)) {
+ Tcl_SetByteArrayLength(bufObj, readBytes);
+ if (!TransformRead(rtPtr, errorCodePtr, bufObj)) {
goto error;
}
+ if (Tcl_IsShared(bufObj)) {
+ Tcl_DecrRefCount(bufObj);
+ bufObj = Tcl_NewObj();
+ Tcl_IncrRefCount(bufObj);
+ }
+ Tcl_SetByteArrayLength(bufObj, 0);
} /* while toRead > 0 */
stop:
+ if (gotBytes == 0) {
+ rtPtr->eofPending = 0;
+ }
+ Tcl_DecrRefCount(bufObj);
Tcl_Release(rtPtr);
return gotBytes;
@@ -1773,6 +1777,7 @@ NewReflectedTransform(
rtPtr->timer = NULL;
rtPtr->mode = 0;
rtPtr->readIsDrained = 0;
+ rtPtr->eofPending = 0;
rtPtr->nonblocking =
(((Channel *) parentChan)->state->flags & CHANNEL_NONBLOCKING);
rtPtr->dead = 0;
@@ -2010,6 +2015,7 @@ InvokeTclMethod(
sr = Tcl_SaveInterpState(rtPtr->interp, 0 /* Dummy */);
Tcl_Preserve(rtPtr);
+ Tcl_Preserve(rtPtr->interp);
result = Tcl_EvalObjv(rtPtr->interp, cmdc, rtPtr->argv, TCL_EVAL_GLOBAL);
/*
@@ -2054,6 +2060,7 @@ InvokeTclMethod(
Tcl_IncrRefCount(resObj);
}
Tcl_RestoreInterpState(rtPtr->interp, sr);
+ Tcl_Release(rtPtr->interp);
Tcl_Release(rtPtr);
/*
@@ -2230,6 +2237,9 @@ DeleteReflectedTransformMap(
*/
evPtr = resultPtr->evPtr;
+ if (evPtr == NULL) {
+ continue;
+ }
paramPtr = evPtr->param;
evPtr->resultPtr = NULL;
@@ -2355,6 +2365,9 @@ DeleteThreadReflectedTransformMap(
*/
evPtr = resultPtr->evPtr;
+ if (evPtr == NULL) {
+ continue;
+ }
paramPtr = evPtr->param;
evPtr->resultPtr = NULL;
@@ -3065,10 +3078,8 @@ static int
TransformRead(
ReflectedTransform *rtPtr,
int *errorCodePtr,
- unsigned char *buf,
- int toRead)
+ Tcl_Obj *bufObj)
{
- Tcl_Obj *bufObj;
Tcl_Obj *resObj;
int bytec; /* Number of returned bytes */
unsigned char *bytev; /* Array of returned bytes */
@@ -3081,8 +3092,8 @@ TransformRead(
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
- p.transform.buf = (char *) buf;
- p.transform.size = toRead;
+ p.transform.buf = (char *) Tcl_GetByteArrayFromObj(bufObj,
+ &(p.transform.size));
ForwardOpToOwnerThread(rtPtr, ForwardedInput, &p);
@@ -3102,12 +3113,8 @@ TransformRead(
/* ASSERT: rtPtr->method & FLAG(METH_READ) */
/* ASSERT: rtPtr->mode & TCL_READABLE */
- bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toRead);
- Tcl_IncrRefCount(bufObj);
-
if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) {
Tcl_SetChannelError(rtPtr->chan, resObj);
- Tcl_DecrRefCount(bufObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
*errorCodePtr = EINVAL;
return 0;
@@ -3116,7 +3123,6 @@ TransformRead(
bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
ResultAdd(&rtPtr->result, bytev, bytec);
- Tcl_DecrRefCount(bufObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
return 1;
}
@@ -3184,7 +3190,7 @@ TransformWrite(
}
if (res < 0) {
- *errorCodePtr = EINVAL;
+ *errorCodePtr = Tcl_GetErrno();
return 0;
}
@@ -3294,7 +3300,7 @@ TransformFlush(
}
if (res < 0) {
- *errorCodePtr = EINVAL;
+ *errorCodePtr = Tcl_GetErrno();
return 0;
}
@@ -3324,6 +3330,7 @@ TransformClear(
(void) InvokeTclMethod(rtPtr, "clear", NULL, NULL, NULL);
rtPtr->readIsDrained = 0;
+ rtPtr->eofPending = 0;
ResultClear(&rtPtr->result);
}
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index 7d6c462..c5b7d28 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -12,9 +12,26 @@
#include "tclInt.h"
#if defined(_WIN32) && defined(UNICODE)
-/* On Windows, we always need the ASCII version. */
-# undef gai_strerror
-# define gai_strerror gai_strerrorA
+/* On Windows, we need to do proper Unicode->UTF-8 conversion. */
+
+typedef struct ThreadSpecificData {
+ int initialized;
+ Tcl_DString errorMsg; /* UTF-8 encoded error-message */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+#undef gai_strerror
+static const char *gai_strerror(int code) {
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (tsdPtr->initialized) {
+ Tcl_DStringFree(&tsdPtr->errorMsg);
+ } else {
+ tsdPtr->initialized = 1;
+ }
+ Tcl_WinTCharToUtf(gai_strerrorW(code), -1, &tsdPtr->errorMsg);
+ return Tcl_DStringValue(&tsdPtr->errorMsg);
+}
#endif
/*
@@ -139,7 +156,7 @@ int
TclCreateSocketAddress(
Tcl_Interp *interp, /* Interpreter for querying
* the desired socket family */
- void **addrlist, /* Socket address list */
+ struct addrinfo **addrlist, /* Socket address list */
const char *host, /* Host. NULL implies INADDR_ANY */
int port, /* Port number */
int willBind, /* Is this an address to bind() to or
@@ -154,7 +171,7 @@ TclCreateSocketAddress(
char *native = NULL, portbuf[TCL_INTEGER_SPACE], *portstring;
const char *family = NULL;
Tcl_DString ds;
- int result, i;
+ int result;
if (host != NULL) {
native = Tcl_UtfToExternalDString(NULL, host, -1, &ds);
@@ -170,11 +187,11 @@ TclCreateSocketAddress(
TclFormatInt(portbuf, port);
portstring = portbuf;
}
-
+
(void) memset(&hints, 0, sizeof(hints));
hints.ai_family = AF_UNSPEC;
- /*
+ /*
* Magic variable to enforce a certain address family - to be superseded
* by a TIP that adds explicit switches to [socket]
*/
@@ -211,9 +228,9 @@ TclCreateSocketAddress(
if (willBind) {
hints.ai_flags |= AI_PASSIVE;
- }
+ }
- result = getaddrinfo(native, portstring, &hints, (struct addrinfo **) addrlist);
+ result = getaddrinfo(native, portstring, &hints, addrlist);
if (host != NULL) {
Tcl_DStringFree(&ds);
@@ -262,11 +279,6 @@ TclCreateSocketAddress(
*addrlist = v4head;
}
}
- i = 0;
- for (p = *addrlist; p != NULL; p = p->ai_next) {
- i++;
- }
-
return 1;
}
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 6259216..1330c02 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -19,11 +19,17 @@
*/
#include "tclInt.h"
-#ifdef __WIN32__
+#ifdef _WIN32
# include "tclWinInt.h"
#endif
#include "tclFileSystem.h"
+#ifdef TCL_TEMPLOAD_NO_UNLINK
+#ifndef NO_FSTATFS
+#include <sys/statfs.h>
+#endif
+#endif
+
/*
* struct FilesystemRecord --
*
@@ -53,12 +59,12 @@ typedef struct FilesystemRecord {
typedef struct ThreadSpecificData {
int initialized;
- int cwdPathEpoch;
- int filesystemEpoch;
+ size_t cwdPathEpoch;
+ size_t filesystemEpoch;
Tcl_Obj *cwdPathPtr;
ClientData cwdClientData;
FilesystemRecord *filesystemList;
- int claims;
+ size_t claims;
} ThreadSpecificData;
/*
@@ -209,7 +215,7 @@ static FilesystemRecord nativeFilesystemRecord = {
* trigger cache cleanup in all threads.
*/
-static int theFilesystemEpoch = 1;
+static size_t theFilesystemEpoch = 1;
/*
* Stores the linked list of filesystems. A 1:1 copy of this list is also
@@ -225,7 +231,7 @@ TCL_DECLARE_MUTEX(filesystemMutex)
*/
static Tcl_Obj *cwdPathPtr = NULL;
-static int cwdPathEpoch = 0;
+static size_t cwdPathEpoch = 0;
static ClientData cwdClientData = NULL;
TCL_DECLARE_MUTEX(cwdMutex)
@@ -639,7 +645,7 @@ FsGetFirstFilesystem(void)
int
TclFSEpochOk(
- int filesystemEpoch)
+ size_t filesystemEpoch)
{
return (filesystemEpoch == 0 || filesystemEpoch == theFilesystemEpoch);
}
@@ -660,7 +666,7 @@ Disclaim(void)
tsdPtr->claims--;
}
-int
+size_t
TclFSEpoch(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
@@ -707,7 +713,9 @@ FsUpdateCwd(
cwdClientData = TclNativeDupInternalRep(clientData);
}
- cwdPathEpoch++;
+ if (++cwdPathEpoch == 0) {
+ ++cwdPathEpoch;
+ }
tsdPtr->cwdPathEpoch = cwdPathEpoch;
Tcl_MutexUnlock(&cwdMutex);
@@ -784,7 +792,9 @@ TclFinalizeFilesystem(void)
}
fsRecPtr = tmpFsRecPtr;
}
- theFilesystemEpoch++;
+ if (++theFilesystemEpoch == 0) {
+ ++theFilesystemEpoch;
+ }
filesystemList = NULL;
/*
@@ -792,7 +802,7 @@ TclFinalizeFilesystem(void)
* filesystem is likely to fail.
*/
-#ifdef __WIN32__
+#ifdef _WIN32
TclWinEncodingsCleanup();
#endif
}
@@ -817,9 +827,11 @@ void
TclResetFilesystem(void)
{
filesystemList = &nativeFilesystemRecord;
- theFilesystemEpoch++;
+ if (++theFilesystemEpoch == 0) {
+ ++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.
@@ -902,7 +914,9 @@ Tcl_FSRegister(
* conceivably now belong to different filesystems.
*/
- theFilesystemEpoch++;
+ if (++theFilesystemEpoch == 0) {
+ ++theFilesystemEpoch;
+ }
Tcl_MutexUnlock(&filesystemMutex);
return TCL_OK;
@@ -967,7 +981,9 @@ Tcl_FSUnregister(
* (which would of course lead to memory exceptions).
*/
- theFilesystemEpoch++;
+ if (++theFilesystemEpoch == 0) {
+ ++theFilesystemEpoch;
+ }
ckfree(fsRecPtr);
@@ -1298,7 +1314,9 @@ Tcl_FSMountsChanged(
*/
Tcl_MutexLock(&filesystemMutex);
- theFilesystemEpoch++;
+ if (++theFilesystemEpoch == 0) {
+ ++theFilesystemEpoch;
+ }
Tcl_MutexUnlock(&filesystemMutex);
}
@@ -2884,9 +2902,13 @@ int
Tcl_FSChdir(
Tcl_Obj *pathPtr)
{
- const Tcl_Filesystem *fsPtr;
+ const Tcl_Filesystem *fsPtr, *oldFsPtr = NULL;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
int retVal = -1;
+ if (tsdPtr->cwdPathPtr != NULL) {
+ oldFsPtr = Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr);
+ }
if (Tcl_FSGetNormalizedPath(NULL, pathPtr) == NULL) {
Tcl_SetErrno(ENOENT);
return retVal;
@@ -2986,7 +3008,6 @@ Tcl_FSChdir(
* instead. This should be examined by someone on Unix.
*/
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
ClientData cd;
ClientData oldcd = tsdPtr->cwdClientData;
@@ -3003,6 +3024,14 @@ Tcl_FSChdir(
} else {
FsUpdateCwd(normDirName, NULL);
}
+
+ /*
+ * If the filesystem changed between old and new cwd
+ * force filesystem refresh on path objects.
+ */
+ if (oldFsPtr != NULL && fsPtr != oldFsPtr) {
+ Tcl_FSMountsChanged(NULL);
+ }
}
return retVal;
@@ -3110,6 +3139,82 @@ Tcl_FSLoadFile(
*----------------------------------------------------------------------
*/
+/*
+ * Workaround for issue with modern HPUX which do allow the unlink (no ETXTBSY
+ * error) yet somehow trash some internal data structures which prevents the
+ * second and further shared libraries from getting properly loaded. Only the
+ * first is ok. We try to get around the issue by not unlinking,
+ * i.e. emulating the behaviour of the older HPUX which denied removal.
+ *
+ * Doing the unlink is also an issue within docker containers, whose AUFS
+ * bungles this as well, see
+ * https://github.com/dotcloud/docker/issues/1911
+ *
+ * For these situations the change below makes the execution of the unlink
+ * semi-controllable at runtime.
+ *
+ * An AUFS filesystem (if it can be detected) will force avoidance of
+ * unlink. The env variable TCL_TEMPLOAD_NO_UNLINK allows detection of a
+ * users general request (unlink and not.
+ *
+ * By default the unlink is done (if not in AUFS). However if the variable is
+ * present and set to true (any integer > 0) then the unlink is skipped.
+ */
+
+int
+TclSkipUnlink (Tcl_Obj* shlibFile)
+{
+ /* Order of testing:
+ * 1. On hpux we generally want to skip unlink in general
+ *
+ * Outside of hpux then:
+ * 2. For a general user request (TCL_TEMPLOAD_NO_UNLINK present, non-empty, => int)
+ * 3. For general AUFS environment (statfs, if available).
+ *
+ * Ad 2: This variable can disable/override the AUFS detection, i.e. for
+ * testing if a newer AUFS does not have the bug any more.
+ *
+ * Ad 3: This is conditionally compiled in. Condition currently must be set manually.
+ * This part needs proper tests in the configure(.in).
+ */
+
+#ifdef hpux
+ return 1;
+#else
+ char* skipstr;
+
+ skipstr = getenv ("TCL_TEMPLOAD_NO_UNLINK");
+ if (skipstr && (skipstr[0] != '\0')) {
+ return atoi(skipstr);
+ }
+
+#ifdef TCL_TEMPLOAD_NO_UNLINK
+#ifndef NO_FSTATFS
+ {
+ struct statfs fs;
+ /* Have fstatfs. May not have the AUFS super magic ... Indeed our build
+ * box is too old to have it directly in the headers. Define taken from
+ * http://mooon.googlecode.com/svn/trunk/linux_include/linux/aufs_type.h
+ * http://aufs.sourceforge.net/
+ * Better reference will be gladly taken.
+ */
+#ifndef AUFS_SUPER_MAGIC
+#define AUFS_SUPER_MAGIC ('a' << 24 | 'u' << 16 | 'f' << 8 | 's')
+#endif /* AUFS_SUPER_MAGIC */
+ if ((statfs(Tcl_GetString (shlibFile), &fs) == 0) &&
+ (fs.f_type == AUFS_SUPER_MAGIC)) {
+ return 1;
+ }
+ }
+#endif /* ... NO_FSTATFS */
+#endif /* ... TCL_TEMPLOAD_NO_UNLINK */
+
+ /* Fallback: !hpux, no EV override, no AUFS (detection, nor detected):
+ * Don't skip */
+ return 0;
+#endif /* hpux */
+}
+
int
Tcl_LoadFile(
Tcl_Interp *interp, /* Used for error reporting. */
@@ -3149,7 +3254,9 @@ Tcl_LoadFile(
if (*handlePtr == NULL) {
return TCL_ERROR;
}
- Tcl_ResetResult(interp);
+ if (interp) {
+ Tcl_ResetResult(interp);
+ }
goto resolveSymbols;
}
if (Tcl_GetErrno() != EXDEV) {
@@ -3165,9 +3272,11 @@ Tcl_LoadFile(
*/
if (Tcl_FSAccess(pathPtr, R_OK) != 0) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't load library \"%s\": %s",
- Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't load library \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
+ }
return TCL_ERROR;
}
@@ -3216,7 +3325,9 @@ Tcl_LoadFile(
}
mustCopyToTempAnyway:
- Tcl_ResetResult(interp);
+ if (interp) {
+ Tcl_ResetResult(interp);
+ }
#endif /* TCL_LOAD_FROM_MEMORY */
/*
@@ -3240,8 +3351,10 @@ Tcl_LoadFile(
Tcl_FSDeleteFile(copyToPtr);
Tcl_DecrRefCount(copyToPtr);
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "couldn't load from current filesystem", -1));
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "couldn't load from current filesystem", -1));
+ }
return TCL_ERROR;
}
@@ -3255,7 +3368,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
@@ -3281,7 +3394,9 @@ Tcl_LoadFile(
* have stored the number of bytes in the result.
*/
- Tcl_ResetResult(interp);
+ if (interp) {
+ Tcl_ResetResult(interp);
+ }
retVal = Tcl_LoadFile(interp, copyToPtr, symbols, flags, procPtrs,
&newLoadHandle);
@@ -3300,7 +3415,9 @@ Tcl_LoadFile(
* avoids any worries about leaving the copy laying around on exit.
*/
- if (Tcl_FSDeleteFile(copyToPtr) == TCL_OK) {
+ if (
+ !TclSkipUnlink (copyToPtr) &&
+ (Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) {
Tcl_DecrRefCount(copyToPtr);
/*
@@ -3311,7 +3428,9 @@ Tcl_LoadFile(
*/
*handlePtr = newLoadHandle;
- Tcl_ResetResult(interp);
+ if (interp) {
+ Tcl_ResetResult(interp);
+ }
return TCL_OK;
}
@@ -3372,11 +3491,13 @@ Tcl_LoadFile(
divertedLoadHandle->unloadFileProcPtr = DivertUnloadFile;
*handlePtr = divertedLoadHandle;
- Tcl_ResetResult(interp);
+ if (interp) {
+ Tcl_ResetResult(interp);
+ }
return retVal;
resolveSymbols:
- /*
+ /*
* At this point, *handlePtr is already set up to the handle for the
* loaded library. We now try to resolve the symbols.
*/
@@ -3385,7 +3506,7 @@ Tcl_LoadFile(
for (i=0 ; symbols[i] != NULL; i++) {
procPtrs[i] = Tcl_FindSymbol(interp, *handlePtr, symbols[i]);
if (procPtrs[i] == NULL) {
- /*
+ /*
* At least one symbol in the list was not found. Unload the
* file, and report the problem back to the caller.
* (Tcl_FindSymbol should already have left an appropriate
@@ -3405,7 +3526,7 @@ Tcl_LoadFile(
*----------------------------------------------------------------------
*
* DivertFindSymbol --
- *
+ *
* Find a symbol in a shared library loaded by copy-from-VFS.
*
*----------------------------------------------------------------------
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index f0e907f..4e7e422 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -2,9 +2,8 @@
#
# This file contains the declarations for all unsupported
# functions that are exported by the Tcl library. This file
-# is used to generate the tclIntDecls.h, tclIntPlatDecls.h,
-# tclIntStub.c, tclPlatStub.c, tclCompileDecls.h and tclCompileStub.c
-# files
+# is used to generate the tclIntDecls.h, tclIntPlatDecls.h
+# and tclStubInit.c files
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
@@ -1006,6 +1005,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 6056119..7ea37bb 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -48,7 +48,8 @@
#else
#include <string.h>
#endif
-#ifdef STDC_HEADERS
+#if defined(STDC_HEADERS) || defined(__STDC__) || defined(__C99__FUNC__) \
+ || defined(__cplusplus) || defined(_MSC_VER)
#include <stddef.h>
#else
typedef int ptrdiff_t;
@@ -1177,25 +1178,25 @@ typedef struct CmdFrame {
*
* Field TEBC EvalEx
* ======= ==== ======
- * level yes yes
+ * level yes yes
* type BC/PREBC SRC/EVAL
- * line0 yes yes
- * framePtr yes yes
+ * line0 yes yes
+ * framePtr yes yes
* ======= ==== ======
*
* ======= ==== ========= union data
- * line1 - yes
- * line3 - yes
- * path - yes
+ * line1 - yes
+ * line3 - yes
+ * path - yes
* ------- ---- ------
- * codePtr yes -
- * pc yes -
+ * codePtr yes -
+ * pc yes -
* ======= ==== ======
*
* ======= ==== ========= union cmd
- * str.cmd yes yes
- * str.len yes yes
- * ------- ---- ------
+ * str.cmd yes yes
+ * str.len yes yes
+ * ------- ---- ------
*/
union {
@@ -1686,6 +1687,7 @@ typedef struct Command {
#define CMD_TRACE_ACTIVE 0x2
#define CMD_HAS_EXEC_TRACES 0x4
#define CMD_COMPILES_EXPANDED 0x8
+#define CMD_REDEF_IN_PROGRESS 0x10
/*
*----------------------------------------------------------------
@@ -1740,7 +1742,7 @@ enum PkgPreferOptions {
* definition there.
* Some macros require knowledge of some fields in the struct in order to
* avoid hitting the TSD unnecessarily. In order to facilitate this, a pointer
- * to the relevant fields is kept in the objCache field in struct Interp.
+ * to the relevant fields is kept in the allocCache field in struct Interp.
*----------------------------------------------------------------
*/
@@ -1809,7 +1811,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
@@ -2201,6 +2210,7 @@ typedef struct Interp {
#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:
@@ -2444,6 +2454,30 @@ typedef struct List {
#endif
/*
+ * Macro used to save a function call for common uses of
+ * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is:
+ *
+ * MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ * Tcl_WideInt *wideIntPtr);
+ */
+
+#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 /* !TCL_WIDE_INT_IS_LONG */
+#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
+ (((objPtr)->typePtr == &tclWideIntType) \
+ ? (*(wideIntPtr) = (objPtr)->internalRep.wideValue, TCL_OK) : \
+ ((objPtr)->typePtr == &tclIntType) \
+ ? (*(wideIntPtr) = (Tcl_WideInt) \
+ ((objPtr)->internalRep.longValue), TCL_OK) : \
+ Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
+#endif /* TCL_WIDE_INT_IS_LONG */
+
+/*
* Flag values for TclTraceDictPath().
*
* DICT_PATH_READ indicates that all entries on the path must exist but no
@@ -2631,6 +2665,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.
@@ -2725,6 +2761,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);
@@ -2828,6 +2865,8 @@ MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string,
int strLen, const unsigned char *pattern,
int ptnLen, int flags);
MODULE_SCOPE double TclCeil(const mp_int *a);
+MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan);
+MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan);
MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp,
const char *value);
MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
@@ -2845,6 +2884,10 @@ MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr,
MODULE_SCOPE int TclConvertElement(const char *src, int length,
char *dst, int flags);
MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr);
+MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp,
+ const char *dict, int dictLength,
+ const char **elementPtr, const char **nextPtr,
+ int *sizePtr, int *literalPtr);
/* TIP #280 - Modified token based evulation, with line information. */
MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script,
int numBytes, int flags, int line,
@@ -2884,7 +2927,8 @@ MODULE_SCOPE void TclFinalizeObjects(void);
MODULE_SCOPE void TclFinalizePreserve(void);
MODULE_SCOPE void TclFinalizeSynchronization(void);
MODULE_SCOPE void TclFinalizeThreadAlloc(void);
-MODULE_SCOPE void TclFinalizeThreadData(void);
+MODULE_SCOPE void TclFinalizeThreadAllocThread(void);
+MODULE_SCOPE void TclFinalizeThreadData(int quick);
MODULE_SCOPE void TclFinalizeThreadObjects(void);
MODULE_SCOPE double TclFloor(const mp_int *a);
MODULE_SCOPE void TclFormatNaN(double value, char *buffer);
@@ -2909,6 +2953,8 @@ MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp,
MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr);
MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc,
Tcl_Obj *const objv[]);
+MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr,
+ unsigned int *sizePtr);
MODULE_SCOPE int TclGlob(Tcl_Interp *interp, char *pattern,
Tcl_Obj *unquotedPrefix, int globFlags,
Tcl_GlobTypeData *types);
@@ -2940,8 +2986,8 @@ MODULE_SCOPE void TclInitNotifier(void);
MODULE_SCOPE void TclInitObjSubsystem(void);
MODULE_SCOPE void TclInitSubsystems(void);
MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp);
-MODULE_SCOPE int TclIsLocalScalar(const char *src, int len);
MODULE_SCOPE int TclIsSpaceProc(char byte);
+MODULE_SCOPE int TclIsBareword(char byte);
MODULE_SCOPE Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[]);
MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int *result);
MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp);
@@ -2999,8 +3045,9 @@ MODULE_SCOPE void TclpFinalizeMutex(Tcl_Mutex *mutexPtr);
MODULE_SCOPE void TclpFinalizePipes(void);
MODULE_SCOPE void TclpFinalizeSockets(void);
MODULE_SCOPE int TclCreateSocketAddress(Tcl_Interp *interp,
- void **addrlist, const char *host, int port,
- int willBind, const char **errorMsgPtr);
+ struct addrinfo **addrlist,
+ const char *host, int port, int willBind,
+ const char **errorMsgPtr);
MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr,
Tcl_ThreadCreateProc *proc, ClientData clientData,
int stackSize, int flags);
@@ -3049,7 +3096,8 @@ MODULE_SCOPE void TclRememberJoinableThread(Tcl_ThreadId id);
MODULE_SCOPE void TclRememberMutex(Tcl_Mutex *mutex);
MODULE_SCOPE void TclRemoveScriptLimitCallbacks(Tcl_Interp *interp);
MODULE_SCOPE int TclReToGlob(Tcl_Interp *interp, const char *reStr,
- int reStrLen, Tcl_DString *dsPtr, int *flagsPtr);
+ int reStrLen, Tcl_DString *dsPtr, int *flagsPtr,
+ int *quantifiersFoundPtr);
MODULE_SCOPE int TclScanElement(const char *string, int length,
int *flagPtr);
MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp,
@@ -3105,7 +3153,6 @@ MODULE_SCOPE void TclFinalizeThreadStorage(void);
MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks);
#endif
-MODULE_SCOPE Tcl_Obj * TclDisassembleByteCodeObj(Tcl_Obj *objPtr);
MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp);
MODULE_SCOPE void * TclpThreadCreateKey(void);
MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr);
@@ -3183,15 +3230,15 @@ MODULE_SCOPE Tcl_Obj * TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr,
MODULE_SCOPE int Tcl_DisassembleObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-
-/* Assemble command function */
+
+/* Assemble command function */
MODULE_SCOPE int Tcl_AssembleObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int TclNRAssembleObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
-
+ Tcl_Obj *const objv[]);
+
MODULE_SCOPE int Tcl_EncodingObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -3432,6 +3479,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);
@@ -3531,6 +3581,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);
@@ -3555,6 +3608,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);
@@ -3570,6 +3626,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);
@@ -3585,6 +3647,9 @@ MODULE_SCOPE int TclCompileReturnCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileSetCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileStringCatCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileStringCmpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3597,6 +3662,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);
@@ -3612,6 +3680,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);
@@ -3642,6 +3731,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);
@@ -3817,7 +3909,7 @@ MODULE_SCOPE int TclStreqOpCmd(ClientData clientData,
MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
-
+
MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3855,6 +3947,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.
@@ -3945,7 +4039,7 @@ typedef const char *TclDTraceStr;
*/
# define TclDecrRefCount(objPtr) \
- if (--(objPtr)->refCount > 0) ; else { \
+ if ((objPtr)->refCount-- > 1) ; else { \
if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \
TCL_DTRACE_OBJ_FREE(objPtr); \
if ((objPtr)->bytes \
@@ -4022,7 +4116,8 @@ MODULE_SCOPE void TclpFreeAllocCache(void *);
AllocCache *cachePtr; \
if (((interp) == NULL) || \
((cachePtr = ((Interp *)(interp))->allocCache), \
- (cachePtr->numObjects >= ALLOC_NOBJHIGH))) { \
+ ((cachePtr->numObjects == 0) || \
+ (cachePtr->numObjects >= ALLOC_NOBJHIGH)))) { \
TclThreadFreeObj(objPtr); \
} else { \
(objPtr)->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr; \
@@ -4340,17 +4435,12 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
/*
*----------------------------------------------------------------------
*
- * Core procedures added to libtommath for bignum manipulation.
+ * Core procedure added to libtommath for bignum manipulation.
*
*----------------------------------------------------------------------
*/
MODULE_SCOPE Tcl_PackageInitProc TclTommath_Init;
-MODULE_SCOPE void TclBNInitBignumFromLong(mp_int *bignum, long initVal);
-MODULE_SCOPE void TclBNInitBignumFromWideInt(mp_int *bignum,
- Tcl_WideInt initVal);
-MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum,
- Tcl_WideUInt initVal);
/*
*----------------------------------------------------------------------
@@ -4584,7 +4674,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
*/
#define TclCleanupCommandMacro(cmdPtr) \
- if (--(cmdPtr)->refCount <= 0) { \
+ if ((cmdPtr)->refCount-- <= 1) { \
ckfree((char *) (cmdPtr));\
}
@@ -4701,7 +4791,9 @@ void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn));
*/
#define NRE_USE_SMALL_ALLOC 1 /* Only turn off for debugging purposes. */
-#define NRE_ENABLE_ASSERTS 1
+#ifndef NRE_ENABLE_ASSERTS
+#define NRE_ENABLE_ASSERTS 0
+#endif
/*
* This is the main data struct for representing NR commands. It is designed
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 533d6f4..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:
*/
@@ -610,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;
@@ -866,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
@@ -1297,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) */
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index 3181d4e..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 \
@@ -548,9 +550,15 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#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 1a4297b..cd0dc18 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -279,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;
+
/*
*----------------------------------------------------------------------
@@ -481,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;
@@ -590,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[] = {
@@ -706,7 +723,7 @@ Tcl_InterpObjCmd(
}
endOfForLoop:
- if ((i + 2) < objc) {
+ if (i < objc - 2) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-unwind? ?--? ?path? ?result?");
return TCL_ERROR;
@@ -1865,7 +1882,6 @@ AliasObjCmd(
cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
}
- prefv = &aliasPtr->objPtr;
memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));
@@ -2372,8 +2388,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);
@@ -2462,6 +2478,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[] = {
@@ -3052,7 +3078,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;
@@ -3071,6 +3101,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/tclListObj.c b/generic/tclListObj.c
index bd2dbc4..14b8a14 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -137,7 +137,7 @@ NewListIntRep(
* Creates a list internal rep with space for objc elements. objc
* must be > 0. If objv!=NULL, initializes with the first objc values
* in that array. If objv==NULL, initalize list internal rep to have
- * 0 elements, with space to add objc more.
+ * 0 elements, with space to add objc more.
*
* Results:
* A new List struct with refCount 0 is returned. If some failure
@@ -857,7 +857,7 @@ Tcl_ListObjReplace(
{
List *listRepPtr;
register Tcl_Obj **elemPtrs;
- int numElems, numRequired, numAfterLast, start, i, j, isShared;
+ int needGrow, numElems, numRequired, numAfterLast, start, i, j, isShared;
if (Tcl_IsShared(listPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
@@ -906,14 +906,46 @@ Tcl_ListObjReplace(
count = numElems - first;
}
+ if (objc > LIST_MAX - (numElems - count)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "max length of a Tcl list (%d elements) exceeded", LIST_MAX));
+ return TCL_ERROR;
+ }
isShared = (listRepPtr->refCount > 1);
- numRequired = numElems - count + objc;
+ numRequired = numElems - count + objc; /* Known <= LIST_MAX */
+ needGrow = numRequired > listRepPtr->maxElemCount;
for (i = 0; i < objc; i++) {
Tcl_IncrRefCount(objv[i]);
}
- if ((numRequired <= listRepPtr->maxElemCount) && !isShared) {
+ if (needGrow && !isShared) {
+ /* Try to use realloc */
+ List *newPtr = NULL;
+ int attempt = 2 * numRequired;
+ if (attempt <= LIST_MAX) {
+ newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
+ }
+ if (newPtr == NULL) {
+ attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH;
+ if (attempt > LIST_MAX) {
+ attempt = LIST_MAX;
+ }
+ newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
+ }
+ if (newPtr == NULL) {
+ attempt = numRequired;
+ newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
+ }
+ if (newPtr) {
+ listRepPtr = newPtr;
+ listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
+ elemPtrs = &listRepPtr->elements;
+ listRepPtr->maxElemCount = attempt;
+ needGrow = numRequired > listRepPtr->maxElemCount;
+ }
+ }
+ if (!needGrow && !isShared) {
int shift;
/*
@@ -950,7 +982,7 @@ Tcl_ListObjReplace(
Tcl_Obj **oldPtrs = elemPtrs;
int newMax;
- if (numRequired > listRepPtr->maxElemCount){
+ if (needGrow){
newMax = 2 * numRequired;
} else {
newMax = listRepPtr->maxElemCount;
@@ -1726,7 +1758,7 @@ FreeListInternalRep(
{
List *listRepPtr = ListRepPtr(listPtr);
- if (--listRepPtr->refCount <= 0) {
+ if (listRepPtr->refCount-- <= 1) {
Tcl_Obj **elemPtrs = &listRepPtr->elements;
int i, numElems = listRepPtr->elemCount;
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index 11da6f8..03200ca 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -358,7 +358,7 @@ TclFetchLiteral(
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
@@ -372,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;
@@ -425,7 +426,7 @@ TclRegisterLiteral(
} else {
nsPtr = NULL;
}
-
+
/*
* Is it in the interpreter's global literal table? If not, create it.
*/
@@ -716,16 +717,22 @@ ExpandLocalLiteralArray(
LiteralEntry *currArrayPtr = envPtr->literalArrayPtr;
LiteralEntry *newArrayPtr;
int i;
+ unsigned int newSize = (currBytes <= UINT_MAX / 2) ? 2*currBytes : UINT_MAX;
+
+ if (currBytes == newSize) {
+ Tcl_Panic("max size of Tcl literal array (%d literals) exceeded",
+ currElems);
+ }
if (envPtr->mallocedLiteralArray) {
- newArrayPtr = ckrealloc(currArrayPtr, 2 * currBytes);
+ newArrayPtr = ckrealloc(currArrayPtr, newSize);
} else {
/*
* envPtr->literalArrayPtr isn't a ckalloc'd pointer, so we must
* code a ckrealloc equivalent for ourselves.
*/
- newArrayPtr = ckalloc(2 * currBytes);
+ newArrayPtr = ckalloc(newSize);
memcpy(newArrayPtr, currArrayPtr, currBytes);
envPtr->mallocedLiteralArray = 1;
}
@@ -750,7 +757,7 @@ ExpandLocalLiteralArray(
}
envPtr->literalArrayPtr = newArrayPtr;
- envPtr->literalArrayEnd = (2 * currElems);
+ envPtr->literalArrayEnd = newSize / sizeof(LiteralEntry);
}
/*
@@ -931,7 +938,8 @@ RebuildLiteralTable(
register LiteralEntry *entryPtr;
LiteralEntry **bucketPtr;
const char *bytes;
- int oldSize, count, index, length;
+ unsigned int oldSize;
+ int count, index, length;
oldSize = tablePtr->numBuckets;
oldBuckets = tablePtr->buckets;
@@ -941,6 +949,16 @@ RebuildLiteralTable(
* constants for new array size.
*/
+ if (oldSize > UINT_MAX/(4 * sizeof(LiteralEntry *))) {
+ /*
+ * Memory allocator limitations will not let us create the
+ * next larger table size. Best option is to limp along
+ * with what we have.
+ */
+
+ return;
+ }
+
tablePtr->numBuckets *= 4;
tablePtr->buckets = ckalloc(tablePtr->numBuckets * sizeof(LiteralEntry*));
for (count=tablePtr->numBuckets, newChainPtr=tablePtr->buckets;
@@ -990,7 +1008,7 @@ RebuildLiteralTable(
* Results:
* None.
*
- * Side effects:
+ * Side effects:
* Resets the internal representation of the CmdName Tcl_Obj
* using TclFreeIntRep().
*
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 c22c4c4..6af5c4f 100644
--- a/generic/tclLoadNone.c
+++ b/generic/tclLoadNone.c
@@ -45,9 +45,11 @@ TclpDlopen(
* file. */
int flags)
{
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "dynamic loading is not currently available on this system",
- -1));
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "dynamic loading is not currently available on this system",
+ -1));
+ }
return TCL_ERROR;
}
@@ -104,11 +106,15 @@ TclpLoadMemory(
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)
+ Tcl_FSUnloadFileProc **unloadProcPtr,
+ /* Dummy: unused by this implementation */
+ int flags)
/* Dummy: unused by this implementation */
{
- Tcl_SetObjResult(interp, Tcl_NewStringObj("dynamic loading from memory "
- "is not available on this system", -1));
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("dynamic loading from memory "
+ "is not available on this system", -1));
+ }
return TCL_ERROR;
}
diff --git a/generic/tclMain.c b/generic/tclMain.c
index faea75a..927de7e 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
@@ -80,7 +80,10 @@ NewNativeObj(
* source directory to make their own modified versions).
*/
+#if defined _MSC_VER && _MSC_VER < 1900
+/* isatty is always defined on MSVC 14.0, but not necessarily as CRTIMPORT. */
extern CRTIMPORT int isatty(int fd);
+#endif
/*
* The thread-local variables for this file's functions.
@@ -616,7 +619,7 @@ Tcl_MainEx(
if (!Tcl_InterpDeleted(interp) && !Tcl_LimitExceeded(interp)) {
Tcl_Obj *cmd = Tcl_ObjPrintf("exit %d", exitCode);
-
+
Tcl_IncrRefCount(cmd);
Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(cmd);
@@ -729,7 +732,7 @@ TclFullFinalizationRequested(void)
const char *fin;
Tcl_DString ds;
int finalize = 0;
-
+
fin = TclGetEnv("TCL_FINALIZE_ON_EXIT", &ds);
finalize = ((fin != NULL) && strcmp(fin, "0"));
if (fin != NULL) {
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index aed623a..58a86d9 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},
@@ -343,7 +343,7 @@ Tcl_PushCallFrame(
framePtr->clientData = NULL;
framePtr->localCachePtr = NULL;
framePtr->tailcallPtr = NULL;
-
+
/*
* Push the new call frame onto the interpreter's stack of procedure call
* frames making it the current frame.
@@ -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,49 +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, TCL_CREATE_NS_IF_UNKNOWN,
- &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;
}
/*
@@ -736,6 +769,7 @@ Tcl_CreateNamespace(
* of namespaces created.
*/
+ doCreate:
nsPtr = ckalloc(sizeof(Namespace));
nameLen = strlen(simpleName) + 1;
nsPtr->name = ckalloc(nameLen);
@@ -831,6 +865,7 @@ Tcl_CreateNamespace(
Tcl_DStringFree(&buffer1);
Tcl_DStringFree(&buffer2);
+ Tcl_DStringFree(&tmpBuffer);
/*
* If compilation of commands originating from the parent NS is
@@ -1070,8 +1105,6 @@ TclTeardownNamespace(
Interp *iPtr = (Interp *) nsPtr->interp;
register Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
- Tcl_Namespace *childNsPtr;
- Tcl_Command cmd;
int i;
/*
@@ -1086,16 +1119,31 @@ TclTeardownNamespace(
/*
* Delete all commands in this namespace. Be careful when traversing the
* hash table: when each command is deleted, it removes itself from the
- * command table.
- *
- * Don't optimize to Tcl_NextHashEntry() because of traces.
+ * command table. Because of traces (and the desire to avoid the quadratic
+ * problems of just using Tcl_FirstHashEntry over and over, [Bug
+ * f97d4ee020]) we copy to a temporary array and then delete all those
+ * commands.
*/
- for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
- entryPtr != NULL;
- entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search)) {
- cmd = Tcl_GetHashValue(entryPtr);
- Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, cmd);
+ while (nsPtr->cmdTable.numEntries > 0) {
+ int length = nsPtr->cmdTable.numEntries;
+ Command **cmds = TclStackAlloc((Tcl_Interp *) iPtr,
+ sizeof(Command *) * length);
+
+ i = 0;
+ for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
+ entryPtr != NULL;
+ entryPtr = Tcl_NextHashEntry(&search)) {
+ cmds[i] = Tcl_GetHashValue(entryPtr);
+ cmds[i]->refCount++;
+ i++;
+ }
+ for (i = 0 ; i < length ; i++) {
+ Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
+ (Tcl_Command) cmds[i]);
+ TclCleanupCommandMacro(cmds[i]);
+ }
+ TclStackFree((Tcl_Interp *) iPtr, cmds);
}
Tcl_DeleteHashTable(&nsPtr->cmdTable);
Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
@@ -1140,25 +1188,54 @@ TclTeardownNamespace(
*
* BE CAREFUL: When each child is deleted, it will divorce itself from its
* parent. You can't traverse a hash table properly if its elements are
- * being deleted. We use only the Tcl_FirstHashEntry function to be safe.
+ * being deleted. Because of traces (and the desire to avoid the
+ * quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug
+ * f97d4ee020]) we copy to a temporary array and then delete all those
+ * namespaces.
*
- * Don't optimize to Tcl_NextHashEntry() because of traces.
+ * Important: leave the hash table itself still live.
*/
#ifndef BREAK_NAMESPACE_COMPAT
- for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
- entryPtr != NULL;
- entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {
- childNsPtr = Tcl_GetHashValue(entryPtr);
- Tcl_DeleteNamespace(childNsPtr);
+ while (nsPtr->childTable.numEntries > 0) {
+ int length = nsPtr->childTable.numEntries;
+ Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
+ sizeof(Namespace *) * length);
+
+ i = 0;
+ for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
+ entryPtr != NULL;
+ entryPtr = Tcl_NextHashEntry(&search)) {
+ children[i] = Tcl_GetHashValue(entryPtr);
+ children[i]->refCount++;
+ i++;
+ }
+ for (i = 0 ; i < length ; i++) {
+ Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
+ TclNsDecrRefCount(children[i]);
+ }
+ TclStackFree((Tcl_Interp *) iPtr, children);
}
#else
if (nsPtr->childTablePtr != NULL) {
- for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
- entryPtr != NULL;
- entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr,&search)) {
- childNsPtr = Tcl_GetHashValue(entryPtr);
- Tcl_DeleteNamespace(childNsPtr);
+ while (nsPtr->childTablePtr->numEntries > 0) {
+ int length = nsPtr->childTablePtr->numEntries;
+ Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
+ sizeof(Namespace *) * length);
+
+ i = 0;
+ for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
+ entryPtr != NULL;
+ entryPtr = Tcl_NextHashEntry(&search)) {
+ children[i] = Tcl_GetHashValue(entryPtr);
+ children[i]->refCount++;
+ i++;
+ }
+ for (i = 0 ; i < length ; i++) {
+ Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
+ TclNsDecrRefCount(children[i]);
+ }
+ TclStackFree((Tcl_Interp *) iPtr, children);
}
}
#endif
@@ -1942,7 +2019,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
@@ -3021,7 +3098,7 @@ NamespaceCodeCmd(
*/
arg = TclGetStringFromObj(objv[1], &length);
- if (*arg==':' && length > 20
+ if (*arg==':' && length > 20
&& strncmp(arg, "::namespace inscope ", 20) == 0) {
Tcl_SetObjResult(interp, objv[1]);
return TCL_OK;
@@ -3274,11 +3351,8 @@ NRNamespaceEvalCmd(
/* This is needed to satisfy GCC 3.3's strict aliasing rules */
framePtrPtr = &framePtr;
- result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+ (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
namespacePtr, /*isProcCallFrame*/ 0);
- if (result != TCL_OK) {
- return TCL_ERROR;
- }
if (iPtr->ensembleRewrite.sourceObjs == NULL) {
framePtr->objc = objc;
@@ -3695,7 +3769,7 @@ NRNamespaceInscopeCmd(
Tcl_Namespace *namespacePtr;
CallFrame *framePtr, **framePtrPtr;
register Interp *iPtr = (Interp *) interp;
- int i, result;
+ int i;
Tcl_Obj *cmdObjPtr;
if (objc < 3) {
@@ -3717,11 +3791,8 @@ NRNamespaceInscopeCmd(
framePtrPtr = &framePtr; /* This is needed to satisfy GCC's
* strict aliasing rules. */
- result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+ (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
namespacePtr, /*isProcCallFrame*/ 0);
- if (result != TCL_OK) {
- return result;
- }
if (iPtr->ensembleRewrite.sourceObjs == NULL) {
framePtr->objc = objc;
@@ -4894,7 +4965,7 @@ TclLogCommandInfo(
if (Tcl_IsShared(iPtr->errorStack)) {
Tcl_Obj *newObj;
-
+
newObj = Tcl_DuplicateObj(iPtr->errorStack);
Tcl_DecrRefCount(iPtr->errorStack);
Tcl_IncrRefCount(newObj);
@@ -4926,7 +4997,7 @@ TclLogCommandInfo(
Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
Tcl_NewStringObj(command, length));
}
- }
+ }
if (!iPtr->framePtr->objc) {
/*
@@ -4979,7 +5050,7 @@ TclErrorStackResetIf(
if (Tcl_IsShared(iPtr->errorStack)) {
Tcl_Obj *newObj;
-
+
newObj = Tcl_DuplicateObj(iPtr->errorStack);
Tcl_DecrRefCount(iPtr->errorStack);
Tcl_IncrRefCount(newObj);
@@ -4999,7 +5070,7 @@ TclErrorStackResetIf(
Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral);
Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
Tcl_NewStringObj(msg, length));
- }
+ }
}
/*
diff --git a/generic/tclNotify.c b/generic/tclNotify.c